[giv] Added cfitsio to source tree.
- From: Dov Grobgeld <dov src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [giv] Added cfitsio to source tree.
- Date: Sat, 29 Dec 2012 18:42:26 +0000 (UTC)
commit b16c3d0a6572289d18c6e1167ff1b2e4653844c2
Author: Dov Grobgeld <dov grobgeld gmail com>
Date: Sun Nov 18 23:24:58 2012 +0200
Added cfitsio to source tree.
README | 22 +-
SConstruct | 51 +
configure.in | 2 +-
giv.wine.nsi.in | 74 +-
notes.org | 23 +
src/SConscript | 5 +-
src/giv-win.gob | 5 +-
src/giv.nsi.in | 72 -
src/gtkimageviewer/gtk-image-viewer.gob | 10 +-
src/plugins/SConscript | 17 +-
src/plugins/cfitsio/README | 2 +
src/plugins/cfitsio/adler32.c | 167 +
src/plugins/cfitsio/buffers.c | 1371 +++
src/plugins/cfitsio/cfileio.c | 6859 +++++++++++++++
src/plugins/cfitsio/cfortran.h | 2515 ++++++
src/plugins/cfitsio/checksum.c | 508 ++
src/plugins/cfitsio/crc32.c | 440 +
src/plugins/cfitsio/crc32.h | 441 +
src/plugins/cfitsio/deflate.c | 1832 ++++
src/plugins/cfitsio/deflate.h | 340 +
src/plugins/cfitsio/drvrfile.c | 900 ++
src/plugins/cfitsio/drvrgsiftp.c | 522 ++
src/plugins/cfitsio/drvrgsiftp.h | 21 +
src/plugins/cfitsio/drvrmem.c | 1184 +++
src/plugins/cfitsio/drvrnet.c | 2741 ++++++
src/plugins/cfitsio/drvrsmem.c | 973 ++
src/plugins/cfitsio/drvrsmem.h | 179 +
src/plugins/cfitsio/editcol.c | 2474 ++++++
src/plugins/cfitsio/edithdu.c | 883 ++
src/plugins/cfitsio/eval_defs.h | 163 +
src/plugins/cfitsio/eval_f.c | 2823 ++++++
src/plugins/cfitsio/eval_l.c | 2252 +++++
src/plugins/cfitsio/eval_tab.h | 42 +
src/plugins/cfitsio/eval_y.c | 7333 ++++++++++++++++
src/plugins/cfitsio/f77_wrap.h | 288 +
src/plugins/cfitsio/f77_wrap1.c | 345 +
src/plugins/cfitsio/f77_wrap2.c | 711 ++
src/plugins/cfitsio/f77_wrap3.c | 853 ++
src/plugins/cfitsio/f77_wrap4.c | 572 ++
src/plugins/cfitsio/fits_hcompress.c | 1858 ++++
src/plugins/cfitsio/fits_hdecompress.c | 2618 ++++++
src/plugins/cfitsio/fitscore.c | 9242 +++++++++++++++++++
src/plugins/cfitsio/fitsio.h | 1930 ++++
src/plugins/cfitsio/fitsio2.h | 1205 +++
src/plugins/cfitsio/fpack.h | 164 +
src/plugins/cfitsio/fpackutil.c | 2381 +++++
src/plugins/cfitsio/getcol.c | 1055 +++
src/plugins/cfitsio/getcolb.c | 2001 +++++
src/plugins/cfitsio/getcold.c | 1676 ++++
src/plugins/cfitsio/getcole.c | 1679 ++++
src/plugins/cfitsio/getcoli.c | 1901 ++++
src/plugins/cfitsio/getcolj.c | 3726 ++++++++
src/plugins/cfitsio/getcolk.c | 1894 ++++
src/plugins/cfitsio/getcoll.c | 614 ++
src/plugins/cfitsio/getcols.c | 835 ++
src/plugins/cfitsio/getcolsb.c | 1991 +++++
src/plugins/cfitsio/getcolui.c | 1907 ++++
src/plugins/cfitsio/getcoluj.c | 1901 ++++
src/plugins/cfitsio/getcoluk.c | 1916 ++++
src/plugins/cfitsio/getkey.c | 3241 +++++++
src/plugins/cfitsio/group.c | 6463 ++++++++++++++
src/plugins/cfitsio/group.h | 65 +
src/plugins/cfitsio/grparser.c | 1379 +++
src/plugins/cfitsio/grparser.h | 185 +
src/plugins/cfitsio/histo.c | 2221 +++++
src/plugins/cfitsio/imcompress.c | 9247 ++++++++++++++++++++
src/plugins/cfitsio/infback.c | 632 ++
src/plugins/cfitsio/inffast.c | 340 +
src/plugins/cfitsio/inffast.h | 11 +
src/plugins/cfitsio/inffixed.h | 94 +
src/plugins/cfitsio/inflate.c | 1480 ++++
src/plugins/cfitsio/inflate.h | 122 +
src/plugins/cfitsio/inftrees.c | 330 +
src/plugins/cfitsio/inftrees.h | 62 +
src/plugins/cfitsio/iraffits.c | 2073 +++++
src/plugins/cfitsio/iter_a.c | 147 +
src/plugins/cfitsio/iter_b.c | 114 +
src/plugins/cfitsio/iter_c.c | 171 +
src/plugins/cfitsio/iter_image.c | 93 +
src/plugins/cfitsio/iter_var.c | 100 +
src/plugins/cfitsio/longnam.h | 592 ++
src/plugins/cfitsio/modkey.c | 1706 ++++
src/plugins/cfitsio/pliocomp.c | 331 +
src/plugins/cfitsio/putcol.c | 1929 ++++
src/plugins/cfitsio/putcolb.c | 1012 +++
src/plugins/cfitsio/putcold.c | 1059 +++
src/plugins/cfitsio/putcole.c | 1073 +++
src/plugins/cfitsio/putcoli.c | 985 +++
src/plugins/cfitsio/putcolj.c | 1990 +++++
src/plugins/cfitsio/putcolk.c | 1012 +++
src/plugins/cfitsio/putcoll.c | 369 +
src/plugins/cfitsio/putcols.c | 303 +
src/plugins/cfitsio/putcolsb.c | 974 ++
src/plugins/cfitsio/putcolu.c | 629 ++
src/plugins/cfitsio/putcolui.c | 969 ++
src/plugins/cfitsio/putcoluj.c | 977 +++
src/plugins/cfitsio/putcoluk.c | 993 +++
src/plugins/cfitsio/putkey.c | 3085 +++++++
src/plugins/cfitsio/quantize.c | 3888 ++++++++
src/plugins/cfitsio/region.c | 1747 ++++
src/plugins/cfitsio/region.h | 82 +
src/plugins/cfitsio/ricecomp.c | 1382 +++
src/plugins/cfitsio/scalnull.c | 229 +
src/plugins/cfitsio/swapproc.c | 247 +
src/plugins/cfitsio/trees.c | 1242 +++
src/plugins/cfitsio/trees.h | 128 +
src/plugins/cfitsio/uncompr.c | 57 +
src/plugins/cfitsio/wcssub.c | 1043 +++
src/plugins/cfitsio/wcsutil.c | 502 ++
src/plugins/cfitsio/zcompress.c | 504 ++
src/plugins/cfitsio/zconf.h | 426 +
src/plugins/cfitsio/zlib.h | 1613 ++++
src/plugins/cfitsio/zuncompress.c | 603 ++
src/plugins/cfitsio/zutil.c | 316 +
src/plugins/cfitsio/zutil.h | 272 +
.../dcmtk/config/include/dcmtk/config/cfwin32.h | 2 +-
116 files changed, 145200 insertions(+), 150 deletions(-)
---
diff --git a/README b/README
index 4628f70..a201518 100644
--- a/README
+++ b/README
@@ -1,21 +1,5 @@
-Release notes for version 0.9.23
-Sunday 2012-06-10
+Release notes for version 0.9.24beta1
+Thursday 2012-06-21
-This is a major bug fix version that contain the following fixes:
+This is a test version of giv compiled for Windows64
-* If auto-contrast is off, leave 8-bit file contrast untouched on load.
-* In the marks viewer replaced full path filename with basename of the file.
-* Solved sync between menus and functionality for balloons, toggles, etc.
-* Added default options for auto-contrast, sub-pixel, and auto-fill.
-* Fixed display in the marker tree view which did not always reflect what marks were visible.
-* Made mark view properly update when opened when navigating between files.
-* Removed redundant redraws on autofit.
-* Fixed major memory leak. (Marks where not released when going to next file).
-* Added display of multi-line strings.
-* Made giv honor no auto-resive for giv files without images.
-* Changed mousewheel zooming so that it zooms around mouse pointer.
-* Added different strength zooming by control and shift mouse wheel.
-* Fixed broken measure tool text on Windows.
-* Made click zoom disabled when clicking in the window when giv is not the focused window.
-* Cleaned up menus so that top menu and right click menu show the same entries.
-* Documentation updates.
diff --git a/SConstruct b/SConstruct
index 317013d..7d99d0e 100644
--- a/SConstruct
+++ b/SConstruct
@@ -50,6 +50,8 @@ def template_fill(env, target, source):
inp.close()
if ARGUMENTS.get('mingw', 0):
+ env['HOST']='w32'
+ env['LOCAL_DIR']='mingw32'
env['CC']='i686-w64-mingw32-gcc'
env['CXX']='i686-w64-mingw32-g++'
env['AR']='i686-w64-mingw32-ar'
@@ -64,9 +66,11 @@ if ARGUMENTS.get('mingw', 0):
env['ROOT'] = ""
env['DLLWRAP'] = "i686-w64-mingw32-dllwrap"
env['DLLTOOL'] = "i686-w64-mingw32-dlltool"
+ env['WINDRES'] = "i686-w64-mingw32-windres"
env['DLLWRAP_FLAGS'] = "--mno-cygwin --as=${AS} --export-all --driver-name ${CXX} --dll-tool-name ${DLLTOOL} -s"
env.Append(CPPFLAGS= ['-mms-bitfields'])
+ env['SYSROOT'] = r"\usr\i686-w64-mingw32\sys-root"
env.Command("giv.wine.nsi",
["giv.wine.nsi.in",
"SConstruct",
@@ -93,6 +97,53 @@ if ARGUMENTS.get('mingw', 0):
env['PACKAGE_DOC_DIR'] = '../doc'
env['PACKAGE_PLUGIN_DIR'] = '../plugins'
env['arch']='mingw32'
+elif ARGUMENTS.get('mingw64', 0):
+ env['HOST']='w64'
+ env['LOCAL_DIR']='mingw64'
+ env['SYSROOT'] = r"\usr\x86_64-w64-mingw32\sys-root"
+ env['CC']='x86_64-w64-mingw32-gcc'
+ env['CXX']='x86_64-w64-mingw32-g++'
+ env['AR']='x86_64-w64-mingw32-ar'
+ env['RANLIB']='x86_64-w64-mingw32-ranlib'
+ env['PKGCONFIG'] = "env PKG_CONFIG_PATH=/usr/x86_64-w64-mingw32/sys-root/mingw/lib/pkgconfig:/usr/local/${LOCAL_DIR}/lib/pkgconfig pkg-config"
+ env['OBJSUFFIX']=".obj"
+ env['PROGSUFFIX'] = ".exe"
+ env['SHOBJSUFFIX']=".obj"
+ env['SHLIBSUFFIX'] = ".dll"
+ env['SHLIBPREFIX'] = ""
+ env['PREFIX'] = "/usr/x86_64-w64-mingw32/sys-root"
+ env['ROOT'] = ""
+ env['DLLWRAP'] = "x86_64-w64-mingw32-dllwrap"
+ env['DLLTOOL'] = "x86_64-w64-mingw32-dlltool"
+ env['WINDRES'] = "x86_64-w64-mingw32-windres"
+ env['DLLWRAP_FLAGS'] = "--mno-cygwin --as=${AS} --export-all --driver-name ${CXX} --dll-tool-name ${DLLTOOL} -s"
+ env.Append(CPPFLAGS= ['-mms-bitfields'])
+
+ env.Command("giv.wine.nsi",
+ ["giv.wine.nsi.in",
+ "SConstruct",
+ "configure.in"
+ ],
+ template_fill
+ )
+ env.Command("COPYING.dos",
+ "COPYING",
+ ["unix2dos < COPYING > COPYING.dos"])
+
+ env.Command("InstallGiv" + env['VER'] + "-w64.exe",
+ ["src/giv.exe",
+ "giv.wine.nsi",
+ "src/plugins/tiff.dll",
+ "src/plugins/dicom.dll",
+ "src/plugins/npy.dll",
+ ],
+ ["makensis giv.wine.nsi"])
+ env.Append(LINKFLAGS=['-mwindows'])
+
+ # TBD - make this installation dependent
+ env['PACKAGE_DOC_DIR'] = '../doc'
+ env['PACKAGE_PLUGIN_DIR'] = '../plugins'
+ env['arch']='mingw64'
else:
# Posix by default
env['PKGCONFIG'] = "pkg-config"
diff --git a/configure.in b/configure.in
index 490255e..d39f26b 100644
--- a/configure.in
+++ b/configure.in
@@ -5,7 +5,7 @@ AM_CONFIG_HEADER(config.h)
PACKAGE=givwidget
GIVWIDGET_API_VERSION=2.0
-AM_INIT_AUTOMAKE(giv, 0.9.23)
+AM_INIT_AUTOMAKE(giv, 0.9.24beta2)
dnl Use libtool to get shared libraries
LT_PREREQ
diff --git a/giv.wine.nsi.in b/giv.wine.nsi.in
index fd0c180..f10e56b 100644
--- a/giv.wine.nsi.in
+++ b/giv.wine.nsi.in
@@ -1,5 +1,5 @@
Name "Giv"
-OutFile "InstallGiv- VER@.exe"
+OutFile "InstallGiv- VER@- HOST@.exe"
Icon "giv-logo.ico"
UninstallIcon "giv-logo-install.ico"
@@ -35,41 +35,41 @@ File /r examples
SetOutPath $INSTDIR\bin
File src\Giv.exe
File src\giv-image.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libgcc_s_sjlj-1.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libexpat-1.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libstdc++-6.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\iconv.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libpcre-1.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libintl-8.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libffi-6.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libgdk-win32*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libgdk_pixbuf*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libgtk-win32*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libgio*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libcairo*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libjasper-1.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\zlib*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libglib*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libatk*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libgobject*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libgmodule*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libgthread*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libpango*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libpng*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libtiff*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libjpeg*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libpixman-1-0.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libfontconfig*.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\libfreetype*.dll
-File \usr\local\mingw32\bin\libjson-glib-1.0-0.dll
-File \usr\i686-w64-mingw32\sys-root\mingw\bin\gdk-pixbuf-query-loaders.exe
+File @SYSROOT \mingw\bin\libgcc_s_sjlj-1 dll
+File @SYSROOT \mingw\bin\libexpat-1 dll
+File @SYSROOT \mingw\bin\libstdc++-6 dll
+File @SYSROOT \mingw\bin\iconv dll
+File @SYSROOT \mingw\bin\libpcre-1 dll
+File @SYSROOT \mingw\bin\libintl-8 dll
+File @SYSROOT \mingw\bin\libffi-6 dll
+File @SYSROOT \mingw\bin\libgdk-win32* dll
+File @SYSROOT \mingw\bin\libgdk_pixbuf* dll
+File @SYSROOT \mingw\bin\libgtk-win32* dll
+File @SYSROOT \mingw\bin\libgio* dll
+File @SYSROOT \mingw\bin\libcairo* dll
+File @SYSROOT \mingw\bin\libjasper-1 dll
+File @SYSROOT \mingw\bin\zlib* dll
+File @SYSROOT \mingw\bin\libglib* dll
+File @SYSROOT \mingw\bin\libatk* dll
+File @SYSROOT \mingw\bin\libgobject* dll
+File @SYSROOT \mingw\bin\libgmodule* dll
+File @SYSROOT \mingw\bin\libgthread* dll
+File @SYSROOT \mingw\bin\libpango* dll
+File @SYSROOT \mingw\bin\libpng* dll
+File @SYSROOT \mingw\bin\libtiff* dll
+File @SYSROOT \mingw\bin\libjpeg* dll
+File @SYSROOT \mingw\bin\libpixman-1-0 dll
+File @SYSROOT \mingw\bin\libfontconfig* dll
+File @SYSROOT \mingw\bin\libfreetype* dll
+#File \usr\local\mingw32\bin\libjson-glib-1.0-0.dll
+File @SYSROOT \mingw\bin\gdk-pixbuf-query-loaders exe
SetOutPath $INSTDIR\etc
-File /r \usr\i686-w64-mingw32\sys-root\mingw\etc\gtk-2.0
-File /r \usr\i686-w64-mingw32\sys-root\mingw\etc\fonts
-File /r \usr\i686-w64-mingw32\sys-root\mingw\etc\pango
+File /r @SYSROOT \mingw\etc\gtk-2 0
+File /r @SYSROOT \mingw\etc\fonts
+File /r @SYSROOT \mingw\etc\pango
SetOutPath $INSTDIR\etc\gtk-2.0
-File \usr\i686-w64-mingw32\sys-root\mingw\share\themes\MS-Windows\gtk-2.0\gtkrc
+File @SYSROOT \mingw\share\themes\MS-Windows\gtk-2 0\gtkrc
# Plugins
SetOutPath $INSTDIR\plugins
@@ -77,15 +77,15 @@ File src\plugins\*.dll
# pango
SetOutPath $INSTDIR\lib
-File /r \usr\i686-w64-mingw32\sys-root\mingw\lib\pango
+File /r @SYSROOT \mingw\lib\pango
# pixbuf etc
SetOutPath $INSTDIR\lib\gdk-pixbuf-2.0\2.10.0
-File /r \usr\i686-w64-mingw32\sys-root\mingw\lib\gdk-pixbuf-2.0\2.10.0\loaders*
+File /r @SYSROOT \mingw\lib\gdk-pixbuf-2 0\2 10 0\loaders*
SetOutPath $INSTDIR\lib\gtk-2.0\2.10.0\engines
-File \usr\i686-w64-mingw32\sys-root\mingw\lib\gtk-2.0\2.10.0\engines\*
+File @SYSROOT \mingw\lib\gtk-2 0\2 10 0\engines\*
SetOutPath $INSTDIR\share\themes
-File /r \usr\i686-w64-mingw32\sys-root\mingw\share\themes\*
+File /r @SYSROOT \mingw\share\themes\*
# Build the gdk-pixbuf.loaders file automatically
#ExpandEnvStrings $0 %COMSPEC%
diff --git a/notes.org b/notes.org
index 695a5cd..31959e6 100644
--- a/notes.org
+++ b/notes.org
@@ -35,3 +35,26 @@
** Done/Todo
- [X] Recursively turn on and off child nodes when toggling the display of a parent in the model viewer.
- [X] Why is initial scaling different from the scaling received with "fill"? Due to the sticky autoscale setting. Fixed by forcing fill on initial load of dataset.
+* <2012-06-21 Thu>
+** Windows 64 bit compilation
+ - Need to compile the following libraries as they are not provided by federa:
+ - [ ] cfitsio
+ - [ ] json-glib
+ - [ ] Fix dcm library
+*** cfitsio compilation
+ - Got sources from http://heasarc.gsfc.nasa.gov/fitsio/
+ - Commands:
+ #+begin_src sh
+ cd ~/src
+ tar -xf /tmp/cfitsio3300.tar.gz
+ cd cfitsio
+ env CC=x86_64-w64-mingw32-gcc ./configure --host=x86_64-w64-mingw32 --prefix=/usr/local/mingw64
+ make -j 4
+ make install
+ #+end_src
+ - Even though compilation of cfitsio succeeded linking failed. Need to figure out why. Meanwhile removed fitsio plugin from installation.
+ - Get errors like the following:
+ #+begin_example
+ /usr/lib/gcc/x86_64-w64-mingw32/4.7.0/../../../../x86_64-w64-mingw32/bin/ld: skipping incompatible /usr/local/mingw64/lib/libcfitsio.a when searching for -lcfitsio
+ #+end_example
+ - Solved fitsio problem by literal inclusion of sources.
diff --git a/src/SConscript b/src/SConscript
index bbd2671..6ac34e6 100644
--- a/src/SConscript
+++ b/src/SConscript
@@ -37,14 +37,13 @@ src_giv_exe = ["giv.cc",
"dovtk-lasso.c",
]
-if ARGUMENTS.get('mingw', 0):
+if ARGUMENTS.get('mingw', 0) or ARGUMENTS.get('mingw64',0):
res = env.Command("giv.res.obj",
["giv.rc",
"giv-logo.ico"
],
- ["i686-w64-mingw32-windres giv.rc giv.res.obj"],
+ ["${WINDRES} giv.rc giv.res.obj"],
chdir=1)
- print "res = ", res
src_giv_exe = src_giv_exe + res
#env.Program("giv",
diff --git a/src/giv-win.gob b/src/giv-win.gob
index 15c003f..86832f0 100644
--- a/src/giv-win.gob
+++ b/src/giv-win.gob
@@ -1893,6 +1893,7 @@ cb_key_press_event (GtkWidget * widget,
selfp->current_slice = 0;
// Redraw the image
+ giv_image_ref(selfp->img_org);
giv_win_set_image(GIV_WIN(self),
selfp->img_org);
giv_win_set_image_info(GIV_WIN(self));
@@ -3298,9 +3299,6 @@ apply_color_map(GivWin *self)
return;
}
- if (selfp->img_display)
- g_object_unref(selfp->img_display);
-
const guint8 *tmap = NULL;
if (selfp->colormap == PSEUDO_COLOR_OFF
// || !selfp->img_is_mono
@@ -4331,4 +4329,3 @@ static void create_remote_commands(GivWin *self)
}
%}
-
diff --git a/src/gtkimageviewer/gtk-image-viewer.gob b/src/gtkimageviewer/gtk-image-viewer.gob
index b0a8d9a..6f763a4 100644
--- a/src/gtkimageviewer/gtk-image-viewer.gob
+++ b/src/gtkimageviewer/gtk-image-viewer.gob
@@ -1159,7 +1159,7 @@ class Gtk:Image:Viewer from Gtk:Widget
0xff505050,
0xffa0a0a0
);
- gdk_pixbuf_unref(img_scaled);
+ g_object_unref(img_scaled);
img_scaled = img_comp;
}
if (!selfp->frozen)
@@ -1173,7 +1173,7 @@ class Gtk:Image:Viewer from Gtk:Widget
selfp->current_x0,
selfp->current_y0);
- gdk_pixbuf_unref(img_scaled);
+ g_object_unref(img_scaled);
// If we have just drawn the whole buffer, then copy the result
// to the cache.
@@ -1520,12 +1520,12 @@ class Gtk:Image:Viewer from Gtk:Widget
gboolean do_need_fill = (selfp->scroll_min_x == selfp->scroll_max_x)
|| (size_is_different && selfp->do_fill_on_resize);
if (selfp->image)
- gdk_pixbuf_unref(selfp->image);
+ g_object_unref(selfp->image);
selfp->image = image;
if (image)
{
- gdk_pixbuf_ref(image);
+ g_object_ref(image);
selfp->scroll_min_x = 0;
selfp->scroll_min_y = 0;
selfp->scroll_width = gdk_pixbuf_get_width(image);
@@ -1544,7 +1544,7 @@ class Gtk:Image:Viewer from Gtk:Widget
get_image(self)
{
if (selfp->image)
- gdk_pixbuf_ref(selfp->image);
+ g_object_ref(selfp->image);
return selfp->image;
}
diff --git a/src/plugins/SConscript b/src/plugins/SConscript
index 52a2982..b6c9a0b 100644
--- a/src/plugins/SConscript
+++ b/src/plugins/SConscript
@@ -11,11 +11,11 @@ for p in [#'pgm.c',
# Change this to Maemo
if not env['SBOX']:
- env.ParseConfig('${PKGCONFIG} --cflags --libs cfitsio')
env.SharedLibrary('fits',
['fits.c'],
- LIBPATH=['..','../gtkimageviewer','../agg','../pcre','../plis']+env['LIBPATH'],
+ LIBPATH=['..','../gtkimageviewer','../agg','../pcre','../plis','#/src/plugins/cfitsio/${arch}/${VARIANT}']+env['LIBPATH'],
LIBS=['cfitsio','giv-image']+env['LIBS'],
+ CPPPATH=['cfitsio']+env['CPPPATH']
)
env.SharedLibrary('dicom',
@@ -37,11 +37,12 @@ if not env['SBOX']:
png_lib = ['png15']
else:
png_lib = []
- env.SharedLibrary('png',
- ['png.c'],
- LIBPATH=['..','../gtkimageviewer','../agg','../pcre','../plis'] + env['LIBPATH'],
- LIBS=['giv-image']+png_lib+env['LIBS'],
- )
+# env.SharedLibrary('png',
+# ['png.c'],
+# LIBPATH=['..','../gtkimageviewer','../agg','../pcre','../plis'] + env['LIBPATH'],
+# LIBS=['giv-image']+png_lib+env['LIBS'],
+# )
- SConscript('dcmtk/SConscript',
+ SConscript(['dcmtk/SConscript',
+ 'cfitsio/SConscript'],
exports='env')
diff --git a/src/plugins/cfitsio/README b/src/plugins/cfitsio/README
new file mode 100644
index 0000000..03c103b
--- /dev/null
+++ b/src/plugins/cfitsio/README
@@ -0,0 +1,2 @@
+This directory contains all c and h files from the cfitsio3300.tar.gz file
+(except those containing main() function).
\ No newline at end of file
diff --git a/src/plugins/cfitsio/adler32.c b/src/plugins/cfitsio/adler32.c
new file mode 100644
index 0000000..172de60
--- /dev/null
+++ b/src/plugins/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);
+}
diff --git a/src/plugins/cfitsio/buffers.c b/src/plugins/cfitsio/buffers.c
new file mode 100644
index 0000000..8d80f46
--- /dev/null
+++ b/src/plugins/cfitsio/buffers.c
@@ -0,0 +1,1371 @@
+/* This file, buffers.c, contains the core set of FITSIO routines */
+/* that use or manage the internal set of IO buffers. */
+
+/* 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 ffmbyt(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG bytepos, /* I - byte position in file to move to */
+ int err_mode, /* I - 1=ignore error, 0 = return error */
+ int *status) /* IO - error status */
+{
+/*
+ Move to the input byte location in the file. When writing to a file, a move
+ may sometimes be made to a position beyond the current EOF. The err_mode
+ parameter determines whether such conditions should be returned as an error
+ or simply ignored.
+*/
+ long record;
+
+ if (*status > 0)
+ return(*status);
+
+ if (bytepos < 0)
+ return(*status = NEG_FILE_POS);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ record = (long) (bytepos / IOBUFLEN); /* zero-indexed record number */
+
+ /* if this is not the current record, then load it */
+ if ( ((fptr->Fptr)->curbuf < 0) ||
+ (record != (fptr->Fptr)->bufrecnum[(fptr->Fptr)->curbuf]))
+ ffldrc(fptr, record, err_mode, status);
+
+ if (*status <= 0)
+ (fptr->Fptr)->bytepos = bytepos; /* save new file position */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpbyt(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG nbytes, /* I - number of bytes to write */
+ void *buffer, /* I - buffer containing the bytes to write */
+ int *status) /* IO - error status */
+/*
+ put (write) the buffer of bytes to the output FITS file, starting at
+ the current file position. Write large blocks of data directly to disk;
+ write smaller segments to intermediate IO buffers to improve efficiency.
+*/
+{
+ int ii, nbuff;
+ LONGLONG filepos;
+ long recstart, recend;
+ long ntodo, bufpos, nspace, nwrite;
+ char *cptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ cptr = (char *)buffer;
+ ntodo = (long) nbytes;
+
+ if ((fptr->Fptr)->curbuf < 0) /* no current data buffer for this file */
+ { /* so reload the last one that was used */
+ ffldrc(fptr, (long) (((fptr->Fptr)->bytepos) / IOBUFLEN), REPORT_EOF, status);
+ }
+
+ if (nbytes >= MINDIRECT)
+ {
+ /* write large blocks of data directly to disk instead of via buffers */
+ /* first, fill up the current IO buffer before flushing it to disk */
+
+ nbuff = (fptr->Fptr)->curbuf; /* current IO buffer number */
+ filepos = (fptr->Fptr)->bytepos; /* save the write starting position */
+ recstart = (fptr->Fptr)->bufrecnum[nbuff]; /* starting record */
+ recend = (long) ((filepos + nbytes - 1) / IOBUFLEN); /* ending record */
+
+ /* bufpos is the starting position within the IO buffer */
+ bufpos = (long) (filepos - ((LONGLONG)recstart * IOBUFLEN));
+ nspace = IOBUFLEN - bufpos; /* amount of space left in the buffer */
+
+ if (nspace)
+ { /* fill up the IO buffer */
+ memcpy((fptr->Fptr)->iobuffer + (nbuff * IOBUFLEN) + bufpos, cptr, nspace);
+ ntodo -= nspace; /* decrement remaining number of bytes */
+ cptr += nspace; /* increment user buffer pointer */
+ filepos += nspace; /* increment file position pointer */
+ (fptr->Fptr)->dirty[nbuff] = TRUE; /* mark record as having been modified */
+ }
+
+ for (ii = 0; ii < NIOBUF; ii++) /* flush any affected buffers to disk */
+ {
+ if ((fptr->Fptr)->bufrecnum[ii] >= recstart
+ && (fptr->Fptr)->bufrecnum[ii] <= recend )
+ {
+ if ((fptr->Fptr)->dirty[ii]) /* flush modified buffer to disk */
+ ffbfwt(fptr->Fptr, ii, status);
+
+ (fptr->Fptr)->bufrecnum[ii] = -1; /* disassociate buffer from the file */
+ }
+ }
+
+ /* move to the correct write position */
+ if ((fptr->Fptr)->io_pos != filepos)
+ ffseek(fptr->Fptr, filepos);
+
+ nwrite = ((ntodo - 1) / IOBUFLEN) * IOBUFLEN; /* don't write last buff */
+
+ ffwrite(fptr->Fptr, nwrite, cptr, status); /* write the data */
+ ntodo -= nwrite; /* decrement remaining number of bytes */
+ cptr += nwrite; /* increment user buffer pointer */
+ (fptr->Fptr)->io_pos = filepos + nwrite; /* update the file position */
+
+ if ((fptr->Fptr)->io_pos >= (fptr->Fptr)->filesize) /* at the EOF? */
+ {
+ (fptr->Fptr)->filesize = (fptr->Fptr)->io_pos; /* increment file size */
+
+ /* initialize the current buffer with the correct fill value */
+ if ((fptr->Fptr)->hdutype == ASCII_TBL)
+ memset((fptr->Fptr)->iobuffer + (nbuff * IOBUFLEN), 32, IOBUFLEN); /* blank fill */
+ else
+ memset((fptr->Fptr)->iobuffer + (nbuff * IOBUFLEN), 0, IOBUFLEN); /* zero fill */
+ }
+ else
+ {
+ /* read next record */
+ ffread(fptr->Fptr, IOBUFLEN, (fptr->Fptr)->iobuffer + (nbuff * IOBUFLEN), status);
+ (fptr->Fptr)->io_pos += IOBUFLEN;
+ }
+
+ /* copy remaining bytes from user buffer into current IO buffer */
+ memcpy((fptr->Fptr)->iobuffer + (nbuff * IOBUFLEN), cptr, ntodo);
+ (fptr->Fptr)->dirty[nbuff] = TRUE; /* mark record as having been modified */
+ (fptr->Fptr)->bufrecnum[nbuff] = recend; /* record number */
+
+ (fptr->Fptr)->logfilesize = maxvalue((fptr->Fptr)->logfilesize,
+ (LONGLONG)(recend + 1) * IOBUFLEN);
+ (fptr->Fptr)->bytepos = filepos + nwrite + ntodo;
+ }
+ else
+ {
+ /* bufpos is the starting position in IO buffer */
+ bufpos = (long) ((fptr->Fptr)->bytepos - ((LONGLONG)(fptr->Fptr)->bufrecnum[(fptr->Fptr)->curbuf] *
+ IOBUFLEN));
+ nspace = IOBUFLEN - bufpos; /* amount of space left in the buffer */
+
+ while (ntodo)
+ {
+ nwrite = minvalue(ntodo, nspace);
+
+ /* copy bytes from user's buffer to the IO buffer */
+ memcpy((fptr->Fptr)->iobuffer + ((fptr->Fptr)->curbuf * IOBUFLEN) + bufpos, cptr, nwrite);
+ ntodo -= nwrite; /* decrement remaining number of bytes */
+ cptr += nwrite;
+ (fptr->Fptr)->bytepos += nwrite; /* increment file position pointer */
+ (fptr->Fptr)->dirty[(fptr->Fptr)->curbuf] = TRUE; /* mark record as modified */
+
+ if (ntodo) /* load next record into a buffer */
+ {
+ ffldrc(fptr, (long) ((fptr->Fptr)->bytepos / IOBUFLEN), IGNORE_EOF, status);
+ bufpos = 0;
+ nspace = IOBUFLEN;
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpbytoff(fitsfile *fptr, /* I - FITS file pointer */
+ long gsize, /* I - size of each group of bytes */
+ long ngroups, /* I - number of groups to write */
+ long offset, /* I - size of gap between groups */
+ void *buffer, /* I - buffer to be written */
+ int *status) /* IO - error status */
+/*
+ put (write) the buffer of bytes to the output FITS file, with an offset
+ between each group of bytes. This function combines ffmbyt and ffpbyt
+ for increased efficiency.
+*/
+{
+ int bcurrent;
+ long ii, bufpos, nspace, nwrite, record;
+ char *cptr, *ioptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if ((fptr->Fptr)->curbuf < 0) /* no current data buffer for this file */
+ { /* so reload the last one that was used */
+ ffldrc(fptr, (long) (((fptr->Fptr)->bytepos) / IOBUFLEN), REPORT_EOF, status);
+ }
+
+ cptr = (char *)buffer;
+ bcurrent = (fptr->Fptr)->curbuf; /* number of the current IO buffer */
+ record = (fptr->Fptr)->bufrecnum[bcurrent]; /* zero-indexed record number */
+ bufpos = (long) ((fptr->Fptr)->bytepos - ((LONGLONG)record * IOBUFLEN)); /* start pos */
+ nspace = IOBUFLEN - bufpos; /* amount of space left in buffer */
+ ioptr = (fptr->Fptr)->iobuffer + (bcurrent * IOBUFLEN) + bufpos;
+
+ for (ii = 1; ii < ngroups; ii++) /* write all but the last group */
+ {
+ /* copy bytes from user's buffer to the IO buffer */
+ nwrite = minvalue(gsize, nspace);
+ memcpy(ioptr, cptr, nwrite);
+ cptr += nwrite; /* increment buffer pointer */
+
+ if (nwrite < gsize) /* entire group did not fit */
+ {
+ (fptr->Fptr)->dirty[bcurrent] = TRUE; /* mark record as having been modified */
+ record++;
+ ffldrc(fptr, record, IGNORE_EOF, status); /* load next record */
+ bcurrent = (fptr->Fptr)->curbuf;
+ ioptr = (fptr->Fptr)->iobuffer + (bcurrent * IOBUFLEN);
+
+ nwrite = gsize - nwrite;
+ memcpy(ioptr, cptr, nwrite);
+ cptr += nwrite; /* increment buffer pointer */
+ ioptr += (offset + nwrite); /* increment IO buffer pointer */
+ nspace = IOBUFLEN - offset - nwrite; /* amount of space left */
+ }
+ else
+ {
+ ioptr += (offset + nwrite); /* increment IO bufer pointer */
+ nspace -= (offset + nwrite);
+ }
+
+ if (nspace <= 0) /* beyond current record? */
+ {
+ (fptr->Fptr)->dirty[bcurrent] = TRUE;
+ record += ((IOBUFLEN - nspace) / IOBUFLEN); /* new record number */
+ ffldrc(fptr, record, IGNORE_EOF, status);
+ bcurrent = (fptr->Fptr)->curbuf;
+
+ bufpos = (-nspace) % IOBUFLEN; /* starting buffer pos */
+ nspace = IOBUFLEN - bufpos;
+ ioptr = (fptr->Fptr)->iobuffer + (bcurrent * IOBUFLEN) + bufpos;
+ }
+ }
+
+ /* now write the last group */
+ nwrite = minvalue(gsize, nspace);
+ memcpy(ioptr, cptr, nwrite);
+ cptr += nwrite; /* increment buffer pointer */
+
+ if (nwrite < gsize) /* entire group did not fit */
+ {
+ (fptr->Fptr)->dirty[bcurrent] = TRUE; /* mark record as having been modified */
+ record++;
+ ffldrc(fptr, record, IGNORE_EOF, status); /* load next record */
+ bcurrent = (fptr->Fptr)->curbuf;
+ ioptr = (fptr->Fptr)->iobuffer + (bcurrent * IOBUFLEN);
+
+ nwrite = gsize - nwrite;
+ memcpy(ioptr, cptr, nwrite);
+ }
+
+ (fptr->Fptr)->dirty[bcurrent] = TRUE; /* mark record as having been modified */
+ (fptr->Fptr)->bytepos = (fptr->Fptr)->bytepos + (ngroups * gsize)
+ + (ngroups - 1) * offset;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgbyt(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG nbytes, /* I - number of bytes to read */
+ void *buffer, /* O - buffer to read into */
+ int *status) /* IO - error status */
+/*
+ get (read) the requested number of bytes from the file, starting at
+ the current file position. Read large blocks of data directly from disk;
+ read smaller segments via intermediate IO buffers to improve efficiency.
+*/
+{
+ int ii;
+ LONGLONG filepos;
+ long recstart, recend, ntodo, bufpos, nspace, nread;
+ char *cptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ cptr = (char *)buffer;
+
+ if (nbytes >= MINDIRECT)
+ {
+ /* read large blocks of data directly from disk instead of via buffers */
+ filepos = (fptr->Fptr)->bytepos; /* save the read starting position */
+
+/* note that in this case, ffmbyt has not been called, and so */
+/* bufrecnum[(fptr->Fptr)->curbuf] does not point to the intended */
+/* output buffer */
+
+ recstart = (long) (filepos / IOBUFLEN); /* starting record */
+ recend = (long) ((filepos + nbytes - 1) / IOBUFLEN); /* ending record */
+
+ for (ii = 0; ii < NIOBUF; ii++) /* flush any affected buffers to disk */
+ {
+ if ((fptr->Fptr)->dirty[ii] &&
+ (fptr->Fptr)->bufrecnum[ii] >= recstart && (fptr->Fptr)->bufrecnum[ii] <= recend)
+ {
+ ffbfwt(fptr->Fptr, ii, status); /* flush modified buffer to disk */
+ }
+ }
+
+ /* move to the correct read position */
+ if ((fptr->Fptr)->io_pos != filepos)
+ ffseek(fptr->Fptr, filepos);
+
+ ffread(fptr->Fptr, (long) nbytes, cptr, status); /* read the data */
+ (fptr->Fptr)->io_pos = filepos + nbytes; /* update the file position */
+ }
+ else
+ {
+ /* read small chucks of data using the IO buffers for efficiency */
+
+ if ((fptr->Fptr)->curbuf < 0) /* no current data buffer for this file */
+ { /* so reload the last one that was used */
+ ffldrc(fptr, (long) (((fptr->Fptr)->bytepos) / IOBUFLEN), REPORT_EOF, status);
+ }
+
+ /* bufpos is the starting position in IO buffer */
+ bufpos = (long) ((fptr->Fptr)->bytepos - ((LONGLONG)(fptr->Fptr)->bufrecnum[(fptr->Fptr)->curbuf] *
+ IOBUFLEN));
+ nspace = IOBUFLEN - bufpos; /* amount of space left in the buffer */
+
+ ntodo = (long) nbytes;
+ while (ntodo)
+ {
+ nread = minvalue(ntodo, nspace);
+
+ /* copy bytes from IO buffer to user's buffer */
+ memcpy(cptr, (fptr->Fptr)->iobuffer + ((fptr->Fptr)->curbuf * IOBUFLEN) + bufpos, nread);
+ ntodo -= nread; /* decrement remaining number of bytes */
+ cptr += nread;
+ (fptr->Fptr)->bytepos += nread; /* increment file position pointer */
+
+ if (ntodo) /* load next record into a buffer */
+ {
+ ffldrc(fptr, (long) ((fptr->Fptr)->bytepos / IOBUFLEN), REPORT_EOF, status);
+ bufpos = 0;
+ nspace = IOBUFLEN;
+ }
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgbytoff(fitsfile *fptr, /* I - FITS file pointer */
+ long gsize, /* I - size of each group of bytes */
+ long ngroups, /* I - number of groups to read */
+ long offset, /* I - size of gap between groups (may be < 0) */
+ void *buffer, /* I - buffer to be filled */
+ int *status) /* IO - error status */
+/*
+ get (read) the requested number of bytes from the file, starting at
+ the current file position. This function combines ffmbyt and ffgbyt
+ for increased efficiency.
+*/
+{
+ int bcurrent;
+ long ii, bufpos, nspace, nread, record;
+ char *cptr, *ioptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if ((fptr->Fptr)->curbuf < 0) /* no current data buffer for this file */
+ { /* so reload the last one that was used */
+ ffldrc(fptr, (long) (((fptr->Fptr)->bytepos) / IOBUFLEN), REPORT_EOF, status);
+ }
+
+ cptr = (char *)buffer;
+ bcurrent = (fptr->Fptr)->curbuf; /* number of the current IO buffer */
+ record = (fptr->Fptr)->bufrecnum[bcurrent]; /* zero-indexed record number */
+ bufpos = (long) ((fptr->Fptr)->bytepos - ((LONGLONG)record * IOBUFLEN)); /* start pos */
+ nspace = IOBUFLEN - bufpos; /* amount of space left in buffer */
+ ioptr = (fptr->Fptr)->iobuffer + (bcurrent * IOBUFLEN) + bufpos;
+
+ for (ii = 1; ii < ngroups; ii++) /* read all but the last group */
+ {
+ /* copy bytes from IO buffer to the user's buffer */
+ nread = minvalue(gsize, nspace);
+ memcpy(cptr, ioptr, nread);
+ cptr += nread; /* increment buffer pointer */
+
+ if (nread < gsize) /* entire group did not fit */
+ {
+ record++;
+ ffldrc(fptr, record, REPORT_EOF, status); /* load next record */
+ bcurrent = (fptr->Fptr)->curbuf;
+ ioptr = (fptr->Fptr)->iobuffer + (bcurrent * IOBUFLEN);
+
+ nread = gsize - nread;
+ memcpy(cptr, ioptr, nread);
+ cptr += nread; /* increment buffer pointer */
+ ioptr += (offset + nread); /* increment IO buffer pointer */
+ nspace = IOBUFLEN - offset - nread; /* amount of space left */
+ }
+ else
+ {
+ ioptr += (offset + nread); /* increment IO bufer pointer */
+ nspace -= (offset + nread);
+ }
+
+ if (nspace <= 0 || nspace > IOBUFLEN) /* beyond current record? */
+ {
+ if (nspace <= 0)
+ {
+ record += ((IOBUFLEN - nspace) / IOBUFLEN); /* new record number */
+ bufpos = (-nspace) % IOBUFLEN; /* starting buffer pos */
+ }
+ else
+ {
+ record -= ((nspace - 1 ) / IOBUFLEN); /* new record number */
+ bufpos = IOBUFLEN - (nspace % IOBUFLEN); /* starting buffer pos */
+ }
+
+ ffldrc(fptr, record, REPORT_EOF, status);
+ bcurrent = (fptr->Fptr)->curbuf;
+
+ nspace = IOBUFLEN - bufpos;
+ ioptr = (fptr->Fptr)->iobuffer + (bcurrent * IOBUFLEN) + bufpos;
+ }
+ }
+
+ /* now read the last group */
+ nread = minvalue(gsize, nspace);
+ memcpy(cptr, ioptr, nread);
+ cptr += nread; /* increment buffer pointer */
+
+ if (nread < gsize) /* entire group did not fit */
+ {
+ record++;
+ ffldrc(fptr, record, REPORT_EOF, status); /* load next record */
+ bcurrent = (fptr->Fptr)->curbuf;
+ ioptr = (fptr->Fptr)->iobuffer + (bcurrent * IOBUFLEN);
+
+ nread = gsize - nread;
+ memcpy(cptr, ioptr, nread);
+ }
+
+ (fptr->Fptr)->bytepos = (fptr->Fptr)->bytepos + (ngroups * gsize)
+ + (ngroups - 1) * offset;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffldrc(fitsfile *fptr, /* I - FITS file pointer */
+ long record, /* I - record number to be loaded */
+ int err_mode, /* I - 1=ignore EOF, 0 = return EOF error */
+ int *status) /* IO - error status */
+{
+/*
+ low-level routine to load a specified record from a file into
+ a physical buffer, if it is not already loaded. Reset all
+ pointers to make this the new current record for that file.
+ Update ages of all the physical buffers.
+*/
+ int ibuff, nbuff;
+ LONGLONG rstart;
+
+ /* check if record is already loaded in one of the buffers */
+ /* search from youngest to oldest buffer for efficiency */
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ for (ibuff = NIOBUF - 1; ibuff >= 0; ibuff--)
+ {
+ nbuff = (fptr->Fptr)->ageindex[ibuff];
+ if (record == (fptr->Fptr)->bufrecnum[nbuff]) {
+ goto updatebuf; /* use 'goto' for efficiency */
+ }
+ }
+
+ /* record is not already loaded */
+ rstart = (LONGLONG)record * IOBUFLEN;
+
+ if ( !err_mode && (rstart >= (fptr->Fptr)->logfilesize) ) /* EOF? */
+ return(*status = END_OF_FILE);
+
+ if (ffwhbf(fptr, &nbuff) < 0) /* which buffer should we reuse? */
+ return(*status = TOO_MANY_FILES);
+
+ if ((fptr->Fptr)->dirty[nbuff])
+ ffbfwt(fptr->Fptr, nbuff, status); /* write dirty buffer to disk */
+
+ if (rstart >= (fptr->Fptr)->filesize) /* EOF? */
+ {
+ /* initialize an empty buffer with the correct fill value */
+ if ((fptr->Fptr)->hdutype == ASCII_TBL)
+ memset((fptr->Fptr)->iobuffer + (nbuff * IOBUFLEN), 32, IOBUFLEN); /* blank fill */
+ else
+ memset((fptr->Fptr)->iobuffer + (nbuff * IOBUFLEN), 0, IOBUFLEN); /* zero fill */
+
+ (fptr->Fptr)->logfilesize = maxvalue((fptr->Fptr)->logfilesize,
+ rstart + IOBUFLEN);
+
+ (fptr->Fptr)->dirty[nbuff] = TRUE; /* mark record as having been modified */
+ }
+ else /* not EOF, so read record from disk */
+ {
+ if ((fptr->Fptr)->io_pos != rstart)
+ ffseek(fptr->Fptr, rstart);
+
+ ffread(fptr->Fptr, IOBUFLEN, (fptr->Fptr)->iobuffer + (nbuff * IOBUFLEN), status);
+ (fptr->Fptr)->io_pos = rstart + IOBUFLEN; /* set new IO position */
+ }
+
+ (fptr->Fptr)->bufrecnum[nbuff] = record; /* record number contained in buffer */
+
+updatebuf:
+
+ (fptr->Fptr)->curbuf = nbuff; /* this is the current buffer for this file */
+
+ if (ibuff < 0)
+ {
+ /* find the current position of the buffer in the age index */
+ for (ibuff = 0; ibuff < NIOBUF; ibuff++)
+ if ((fptr->Fptr)->ageindex[ibuff] == nbuff)
+ break;
+ }
+
+ /* increment the age of all the buffers that were younger than it */
+ for (ibuff++; ibuff < NIOBUF; ibuff++)
+ (fptr->Fptr)->ageindex[ibuff - 1] = (fptr->Fptr)->ageindex[ibuff];
+
+ (fptr->Fptr)->ageindex[NIOBUF - 1] = nbuff; /* this is now the youngest buffer */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffwhbf(fitsfile *fptr, /* I - FITS file pointer */
+ int *nbuff) /* O - which buffer to use */
+{
+/*
+ decide which buffer to (re)use to hold a new file record
+*/
+ return(*nbuff = (fptr->Fptr)->ageindex[0]); /* return oldest buffer */
+}
+/*--------------------------------------------------------------------------*/
+int ffflus(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ Flush all the data in the current FITS file to disk. This ensures that if
+ the program subsequently dies, the disk FITS file will be closed correctly.
+*/
+{
+ int hdunum, hdutype;
+
+ if (*status > 0)
+ return(*status);
+
+ ffghdn(fptr, &hdunum); /* get the current HDU number */
+
+ if (ffchdu(fptr,status) > 0) /* close out the current HDU */
+ ffpmsg("ffflus could not close the current HDU.");
+
+ ffflsh(fptr, FALSE, status); /* flush any modified IO buffers to disk */
+
+ if (ffgext(fptr, hdunum - 1, &hdutype, status) > 0) /* reopen HDU */
+ ffpmsg("ffflus could not reopen the current HDU.");
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffflsh(fitsfile *fptr, /* I - FITS file pointer */
+ int clearbuf, /* I - also clear buffer contents? */
+ int *status) /* IO - error status */
+{
+/*
+ flush all dirty IO buffers associated with the file to disk
+*/
+ int ii;
+
+/*
+ no need to move to a different HDU
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+*/
+ for (ii = 0; ii < NIOBUF; ii++)
+ {
+ /* flush modified buffer to disk */
+ if ((fptr->Fptr)->bufrecnum[ii] >= 0 &&(fptr->Fptr)->dirty[ii])
+ ffbfwt(fptr->Fptr, ii, status);
+
+ if (clearbuf)
+ (fptr->Fptr)->bufrecnum[ii] = -1; /* set contents of buffer as undefined */
+ }
+
+ if (*status != READONLY_FILE)
+ ffflushx(fptr->Fptr); /* flush system buffers to disk */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffbfeof(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+{
+/*
+ clear any buffers beyond the end of file
+*/
+ int ii;
+
+ for (ii = 0; ii < NIOBUF; ii++)
+ {
+ if ( (LONGLONG) (fptr->Fptr)->bufrecnum[ii] * IOBUFLEN >= fptr->Fptr->filesize)
+ {
+ (fptr->Fptr)->bufrecnum[ii] = -1; /* set contents of buffer as undefined */
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffbfwt(FITSfile *Fptr, /* I - FITS file pointer */
+ int nbuff, /* I - which buffer to write */
+ int *status) /* IO - error status */
+{
+/*
+ write contents of buffer to file; If the position of the buffer
+ is beyond the current EOF, then the file may need to be extended
+ with fill values, and/or with the contents of some of the other
+ i/o buffers.
+*/
+ int ii,ibuff;
+ long jj, irec, minrec, nloop;
+ LONGLONG filepos;
+
+ static char zeros[IOBUFLEN]; /* initialized to zero by default */
+
+ if (!(Fptr->writemode) )
+ {
+ ffpmsg("Error: trying to write to READONLY file.");
+ if (Fptr->driver == 8) { /* gzip compressed file */
+ ffpmsg("Cannot write to a GZIP or COMPRESS compressed file.");
+ }
+ Fptr->dirty[nbuff] = FALSE; /* reset buffer status to prevent later probs */
+ *status = READONLY_FILE;
+ return(*status);
+ }
+
+ filepos = (LONGLONG)Fptr->bufrecnum[nbuff] * IOBUFLEN;
+
+ if (filepos <= Fptr->filesize)
+ {
+ /* record is located within current file, so just write it */
+
+ /* move to the correct write position */
+ if (Fptr->io_pos != filepos)
+ ffseek(Fptr, filepos);
+
+ ffwrite(Fptr, IOBUFLEN, Fptr->iobuffer + (nbuff * IOBUFLEN), status);
+ Fptr->io_pos = filepos + IOBUFLEN;
+
+ if (filepos == Fptr->filesize) /* appended new record? */
+ Fptr->filesize += IOBUFLEN; /* increment the file size */
+
+ Fptr->dirty[nbuff] = FALSE;
+ }
+
+ else /* if record is beyond the EOF, append any other records */
+ /* and/or insert fill values if necessary */
+ {
+ /* move to EOF */
+ if (Fptr->io_pos != Fptr->filesize)
+ ffseek(Fptr, Fptr->filesize);
+
+ ibuff = NIOBUF; /* initialize to impossible value */
+ while(ibuff != nbuff) /* repeat until requested buffer is written */
+ {
+ minrec = (long) (Fptr->filesize / IOBUFLEN);
+
+ /* write lowest record beyond the EOF first */
+
+ irec = Fptr->bufrecnum[nbuff]; /* initially point to the requested buffer */
+ ibuff = nbuff;
+
+ for (ii = 0; ii < NIOBUF; ii++)
+ {
+ if (Fptr->bufrecnum[ii] >= minrec &&
+ Fptr->bufrecnum[ii] < irec)
+ {
+ irec = Fptr->bufrecnum[ii]; /* found a lower record */
+ ibuff = ii;
+ }
+ }
+
+ filepos = (LONGLONG)irec * IOBUFLEN; /* byte offset of record in file */
+
+ /* append 1 or more fill records if necessary */
+ if (filepos > Fptr->filesize)
+ {
+ nloop = (long) ((filepos - (Fptr->filesize)) / IOBUFLEN);
+ for (jj = 0; jj < nloop && !(*status); jj++)
+ ffwrite(Fptr, IOBUFLEN, zeros, status);
+
+/*
+ffseek(Fptr, filepos);
+*/
+ Fptr->filesize = filepos; /* increment the file size */
+ }
+
+ /* write the buffer itself */
+ ffwrite(Fptr, IOBUFLEN, Fptr->iobuffer + (ibuff * IOBUFLEN), status);
+ Fptr->dirty[ibuff] = FALSE;
+
+ Fptr->filesize += IOBUFLEN; /* increment the file size */
+ } /* loop back if more buffers need to be written */
+
+ Fptr->io_pos = Fptr->filesize; /* currently positioned at EOF */
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgrsz( fitsfile *fptr, /* I - FITS file pionter */
+ long *ndata, /* O - optimal amount of data to access */
+ int *status) /* IO - error status */
+/*
+ Returns an optimal value for the number of rows in a binary table
+ or the number of pixels in an image that should be read or written
+ at one time for maximum efficiency. Accessing more data than this
+ may cause excessive flushing and rereading of buffers to/from disk.
+*/
+{
+ int typecode, bytesperpixel;
+
+ /* There are NIOBUF internal buffers available each IOBUFLEN bytes long. */
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header to get hdu struct */
+ return(*status);
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU ) /* calc pixels per buffer size */
+ {
+ /* image pixels are in column 2 of the 'table' */
+ ffgtcl(fptr, 2, &typecode, NULL, NULL, status);
+ bytesperpixel = typecode / 10;
+ *ndata = ((NIOBUF - 1) * IOBUFLEN) / bytesperpixel;
+ }
+ else /* calc number of rows that fit in buffers */
+ {
+ *ndata = (long) (((NIOBUF - 1) * IOBUFLEN) / maxvalue(1,
+ (fptr->Fptr)->rowlength));
+ *ndata = maxvalue(1, *ndata);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtbb(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG firstrow, /* I - starting row (1 = first row) */
+ LONGLONG firstchar, /* I - starting byte in row (1=first) */
+ LONGLONG nchars, /* I - number of bytes to read */
+ unsigned char *values, /* I - array of bytes to read */
+ int *status) /* IO - error status */
+/*
+ read a consecutive string of bytes from an ascii or binary table.
+ This will span multiple rows of the table if nchars + firstchar is
+ greater than the length of a row.
+*/
+{
+ LONGLONG bytepos, endrow;
+
+ if (*status > 0 || nchars <= 0)
+ return(*status);
+
+ else if (firstrow < 1)
+ return(*status=BAD_ROW_NUM);
+
+ else if (firstchar < 1)
+ return(*status=BAD_ELEM_NUM);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ /* check that we do not exceed number of rows in the table */
+ endrow = ((firstchar + nchars - 2) / (fptr->Fptr)->rowlength) + firstrow;
+ if (endrow > (fptr->Fptr)->numrows)
+ {
+ ffpmsg("attempt to read past end of table (ffgtbb)");
+ return(*status=BAD_ROW_NUM);
+ }
+
+ /* move the i/o pointer to the start of the sequence of characters */
+ bytepos = (fptr->Fptr)->datastart +
+ ((fptr->Fptr)->rowlength * (firstrow - 1)) +
+ firstchar - 1;
+
+ ffmbyt(fptr, bytepos, REPORT_EOF, status);
+ ffgbyt(fptr, nchars, values, status); /* read the bytes */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgi1b(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG byteloc, /* I - position within file to start reading */
+ long nvals, /* I - number of pixels to read */
+ long incre, /* I - byte increment between pixels */
+ unsigned char *values, /* O - returned array of values */
+ int *status) /* IO - error status */
+/*
+ get (read) the array of values from the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+ LONGLONG postemp;
+
+ if (incre == 1) /* read all the values at once (contiguous bytes) */
+ {
+ if (nvals < MINDIRECT) /* read normally via IO buffers */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbyt(fptr, nvals, values, status);
+ }
+ else /* read directly from disk, bypassing IO buffers */
+ {
+ postemp = (fptr->Fptr)->bytepos; /* store current file position */
+ (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */
+ ffgbyt(fptr, nvals, values, status);
+ (fptr->Fptr)->bytepos = postemp; /* reset to original position */
+ }
+ }
+ else /* have to read each value individually (not contiguous ) */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbytoff(fptr, 1, nvals, incre - 1, values, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgi2b(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG byteloc, /* I - position within file to start reading */
+ long nvals, /* I - number of pixels to read */
+ long incre, /* I - byte increment between pixels */
+ short *values, /* O - returned array of values */
+ int *status) /* IO - error status */
+/*
+ get (read) the array of values from the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+ LONGLONG postemp;
+
+ if (incre == 2) /* read all the values at once (contiguous bytes) */
+ {
+ if (nvals * 2 < MINDIRECT) /* read normally via IO buffers */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbyt(fptr, nvals * 2, values, status);
+ }
+ else /* read directly from disk, bypassing IO buffers */
+ {
+ postemp = (fptr->Fptr)->bytepos; /* store current file position */
+ (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */
+ ffgbyt(fptr, nvals * 2, values, status);
+ (fptr->Fptr)->bytepos = postemp; /* reset to original position */
+ }
+ }
+ else /* have to read each value individually (not contiguous ) */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbytoff(fptr, 2, nvals, incre - 2, values, status);
+ }
+
+#if BYTESWAPPED
+ ffswap2(values, nvals); /* reverse order of bytes in each value */
+#endif
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgi4b(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG byteloc, /* I - position within file to start reading */
+ long nvals, /* I - number of pixels to read */
+ long incre, /* I - byte increment between pixels */
+ INT32BIT *values, /* O - returned array of values */
+ int *status) /* IO - error status */
+/*
+ get (read) the array of values from the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+ LONGLONG postemp;
+
+ if (incre == 4) /* read all the values at once (contiguous bytes) */
+ {
+ if (nvals * 4 < MINDIRECT) /* read normally via IO buffers */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbyt(fptr, nvals * 4, values, status);
+ }
+ else /* read directly from disk, bypassing IO buffers */
+ {
+ postemp = (fptr->Fptr)->bytepos; /* store current file position */
+ (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */
+ ffgbyt(fptr, nvals * 4, values, status);
+ (fptr->Fptr)->bytepos = postemp; /* reset to original position */
+ }
+ }
+ else /* have to read each value individually (not contiguous ) */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbytoff(fptr, 4, nvals, incre - 4, values, status);
+ }
+
+#if BYTESWAPPED
+ ffswap4(values, nvals); /* reverse order of bytes in each value */
+#endif
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgi8b(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG byteloc, /* I - position within file to start reading */
+ long nvals, /* I - number of pixels to read */
+ long incre, /* I - byte increment between pixels */
+ long *values, /* O - returned array of values */
+ int *status) /* IO - error status */
+/*
+ get (read) the array of values from the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ This routine reads 'nvals' 8-byte integers into 'values'.
+ This works both on platforms that have sizeof(long) = 64, and 32,
+ as long as 'values' has been allocated to large enough to hold
+ 8 * nvals bytes of data.
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+*/
+{
+ LONGLONG postemp;
+
+ if (incre == 8) /* read all the values at once (contiguous bytes) */
+ {
+ if (nvals * 8 < MINDIRECT) /* read normally via IO buffers */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbyt(fptr, nvals * 8, values, status);
+ }
+ else /* read directly from disk, bypassing IO buffers */
+ {
+ postemp = (fptr->Fptr)->bytepos; /* store current file position */
+ (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */
+ ffgbyt(fptr, nvals * 8, values, status);
+ (fptr->Fptr)->bytepos = postemp; /* reset to original position */
+ }
+ }
+ else /* have to read each value individually (not contiguous ) */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbytoff(fptr, 8, nvals, incre - 8, values, status);
+ }
+
+#if BYTESWAPPED
+ ffswap8((double *) values, nvals); /* reverse bytes in each value */
+#endif
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgr4b(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG byteloc, /* I - position within file to start reading */
+ long nvals, /* I - number of pixels to read */
+ long incre, /* I - byte increment between pixels */
+ float *values, /* O - returned array of values */
+ int *status) /* IO - error status */
+/*
+ get (read) the array of values from the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+ LONGLONG postemp;
+
+#if MACHINE == VAXVMS
+ long ii;
+
+#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT)
+ short *sptr;
+ long ii;
+
+#endif
+
+
+ if (incre == 4) /* read all the values at once (contiguous bytes) */
+ {
+ if (nvals * 4 < MINDIRECT) /* read normally via IO buffers */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbyt(fptr, nvals * 4, values, status);
+ }
+ else /* read directly from disk, bypassing IO buffers */
+ {
+ postemp = (fptr->Fptr)->bytepos; /* store current file position */
+ (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */
+ ffgbyt(fptr, nvals * 4, values, status);
+ (fptr->Fptr)->bytepos = postemp; /* reset to original position */
+ }
+ }
+ else /* have to read each value individually (not contiguous ) */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbytoff(fptr, 4, nvals, incre - 4, values, status);
+ }
+
+
+#if MACHINE == VAXVMS
+
+ ii = nvals; /* call VAX macro routine to convert */
+ ieevur(values, values, &ii); /* from IEEE float -> F float */
+
+#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT)
+
+ ffswap2( (short *) values, nvals * 2); /* swap pairs of bytes */
+
+ /* convert from IEEE float format to VMS GFLOAT float format */
+ sptr = (short *) values;
+ for (ii = 0; ii < nvals; ii++, sptr += 2)
+ {
+ if (!fnan(*sptr) ) /* test for NaN or underflow */
+ values[ii] *= 4.0;
+ }
+
+#elif BYTESWAPPED
+ ffswap4((INT32BIT *)values, nvals); /* reverse order of bytes in values */
+#endif
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgr8b(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG byteloc, /* I - position within file to start reading */
+ long nvals, /* I - number of pixels to read */
+ long incre, /* I - byte increment between pixels */
+ double *values, /* O - returned array of values */
+ int *status) /* IO - error status */
+/*
+ get (read) the array of values from the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+ LONGLONG postemp;
+
+#if MACHINE == VAXVMS
+ long ii;
+
+#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT)
+ short *sptr;
+ long ii;
+
+#endif
+
+ if (incre == 8) /* read all the values at once (contiguous bytes) */
+ {
+ if (nvals * 8 < MINDIRECT) /* read normally via IO buffers */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbyt(fptr, nvals * 8, values, status);
+ }
+ else /* read directly from disk, bypassing IO buffers */
+ {
+ postemp = (fptr->Fptr)->bytepos; /* store current file position */
+ (fptr->Fptr)->bytepos = byteloc; /* set to the desired position */
+ ffgbyt(fptr, nvals * 8, values, status);
+ (fptr->Fptr)->bytepos = postemp; /* reset to original position */
+ }
+ }
+ else /* have to read each value individually (not contiguous ) */
+ {
+ ffmbyt(fptr, byteloc, REPORT_EOF, status);
+ ffgbytoff(fptr, 8, nvals, incre - 8, values, status);
+ }
+
+#if MACHINE == VAXVMS
+ ii = nvals; /* call VAX macro routine to convert */
+ ieevud(values, values, &ii); /* from IEEE float -> D float */
+
+#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT)
+ ffswap2( (short *) values, nvals * 4); /* swap pairs of bytes */
+
+ /* convert from IEEE float format to VMS GFLOAT float format */
+ sptr = (short *) values;
+ for (ii = 0; ii < nvals; ii++, sptr += 4)
+ {
+ if (!dnan(*sptr) ) /* test for NaN or underflow */
+ values[ii] *= 4.0;
+ }
+
+#elif BYTESWAPPED
+ ffswap8(values, nvals); /* reverse order of bytes in each value */
+#endif
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffptbb(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG firstrow, /* I - starting row (1 = first row) */
+ LONGLONG firstchar, /* I - starting byte in row (1=first) */
+ LONGLONG nchars, /* I - number of bytes to write */
+ unsigned char *values, /* I - array of bytes to write */
+ int *status) /* IO - error status */
+/*
+ write a consecutive string of bytes to an ascii or binary table.
+ This will span multiple rows of the table if nchars + firstchar is
+ greater than the length of a row.
+*/
+{
+ LONGLONG bytepos, endrow, nrows;
+ char message[81];
+
+ if (*status > 0 || nchars <= 0)
+ return(*status);
+
+ else if (firstrow < 1)
+ return(*status=BAD_ROW_NUM);
+
+ else if (firstchar < 1)
+ return(*status=BAD_ELEM_NUM);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart < 0) /* rescan header if data undefined */
+ ffrdef(fptr, status);
+
+ endrow = ((firstchar + nchars - 2) / (fptr->Fptr)->rowlength) + firstrow;
+
+ /* check if we are writing beyond the current end of table */
+ if (endrow > (fptr->Fptr)->numrows)
+ {
+ /* if there are more HDUs following the current one, or */
+ /* if there is a data heap, then we must insert space */
+ /* for the new rows. */
+ if ( !((fptr->Fptr)->lasthdu) || (fptr->Fptr)->heapsize > 0)
+ {
+ nrows = endrow - ((fptr->Fptr)->numrows);
+
+ /* ffirow also updates the heap address and numrows */
+ if (ffirow(fptr, (fptr->Fptr)->numrows, nrows, status) > 0)
+ {
+ sprintf(message,
+ "ffptbb failed to add space for %.0f new rows in table.",
+ (double) nrows);
+ ffpmsg(message);
+ return(*status);
+ }
+ }
+ else
+ {
+ /* manally update heap starting address */
+ (fptr->Fptr)->heapstart +=
+ ((LONGLONG)(endrow - (fptr->Fptr)->numrows) *
+ (fptr->Fptr)->rowlength );
+
+ (fptr->Fptr)->numrows = endrow; /* update number of rows */
+ }
+ }
+
+ /* move the i/o pointer to the start of the sequence of characters */
+ bytepos = (fptr->Fptr)->datastart +
+ ((fptr->Fptr)->rowlength * (firstrow - 1)) +
+ firstchar - 1;
+
+ ffmbyt(fptr, bytepos, IGNORE_EOF, status);
+ ffpbyt(fptr, nchars, values, status); /* write the bytes */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpi1b(fitsfile *fptr, /* I - FITS file pointer */
+ long nvals, /* I - number of pixels in the values array */
+ long incre, /* I - byte increment between pixels */
+ unsigned char *values, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ put (write) the array of values to the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+ if (incre == 1) /* write all the values at once (contiguous bytes) */
+
+ ffpbyt(fptr, nvals, values, status);
+
+ else /* have to write each value individually (not contiguous ) */
+
+ ffpbytoff(fptr, 1, nvals, incre - 1, values, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpi2b(fitsfile *fptr, /* I - FITS file pointer */
+ long nvals, /* I - number of pixels in the values array */
+ long incre, /* I - byte increment between pixels */
+ short *values, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ put (write) the array of values to the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+#if BYTESWAPPED
+ ffswap2(values, nvals); /* reverse order of bytes in each value */
+#endif
+
+ if (incre == 2) /* write all the values at once (contiguous bytes) */
+
+ ffpbyt(fptr, nvals * 2, values, status);
+
+ else /* have to write each value individually (not contiguous ) */
+
+ ffpbytoff(fptr, 2, nvals, incre - 2, values, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpi4b(fitsfile *fptr, /* I - FITS file pointer */
+ long nvals, /* I - number of pixels in the values array */
+ long incre, /* I - byte increment between pixels */
+ INT32BIT *values, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ put (write) the array of values to the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+#if BYTESWAPPED
+ ffswap4(values, nvals); /* reverse order of bytes in each value */
+#endif
+
+ if (incre == 4) /* write all the values at once (contiguous bytes) */
+
+ ffpbyt(fptr, nvals * 4, values, status);
+
+ else /* have to write each value individually (not contiguous ) */
+
+ ffpbytoff(fptr, 4, nvals, incre - 4, values, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpi8b(fitsfile *fptr, /* I - FITS file pointer */
+ long nvals, /* I - number of pixels in the values array */
+ long incre, /* I - byte increment between pixels */
+ long *values, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ put (write) the array of values to the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ This routine writes 'nvals' 8-byte integers from 'values'.
+ This works both on platforms that have sizeof(long) = 64, and 32,
+ as long as 'values' has been allocated to large enough to hold
+ 8 * nvals bytes of data.
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+*/
+{
+#if BYTESWAPPED
+ ffswap8((double *) values, nvals); /* reverse bytes in each value */
+#endif
+
+ if (incre == 8) /* write all the values at once (contiguous bytes) */
+
+ ffpbyt(fptr, nvals * 8, values, status);
+
+ else /* have to write each value individually (not contiguous ) */
+
+ ffpbytoff(fptr, 8, nvals, incre - 8, values, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpr4b(fitsfile *fptr, /* I - FITS file pointer */
+ long nvals, /* I - number of pixels in the values array */
+ long incre, /* I - byte increment between pixels */
+ float *values, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ put (write) the array of values to the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+#if MACHINE == VAXVMS
+ long ii;
+
+ ii = nvals; /* call VAX macro routine to convert */
+ ieevpr(values, values, &ii); /* from F float -> IEEE float */
+
+#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT)
+ long ii;
+
+ /* convert from VMS FFLOAT float format to IEEE float format */
+ for (ii = 0; ii < nvals; ii++)
+ values[ii] *= 0.25;
+
+ ffswap2( (short *) values, nvals * 2); /* swap pairs of bytes */
+
+#elif BYTESWAPPED
+ ffswap4((INT32BIT *) values, nvals); /* reverse order of bytes in values */
+#endif
+
+ if (incre == 4) /* write all the values at once (contiguous bytes) */
+
+ ffpbyt(fptr, nvals * 4, values, status);
+
+ else /* have to write each value individually (not contiguous ) */
+
+ ffpbytoff(fptr, 4, nvals, incre - 4, values, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpr8b(fitsfile *fptr, /* I - FITS file pointer */
+ long nvals, /* I - number of pixels in the values array */
+ long incre, /* I - byte increment between pixels */
+ double *values, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ put (write) the array of values to the FITS file, doing machine dependent
+ format conversion (e.g. byte-swapping) if necessary.
+*/
+{
+#if MACHINE == VAXVMS
+ long ii;
+
+ ii = nvals; /* call VAX macro routine to convert */
+ ieevpd(values, values, &ii); /* from D float -> IEEE float */
+
+#elif (MACHINE == ALPHAVMS) && (FLOATTYPE == GFLOAT)
+ long ii;
+
+ /* convert from VMS GFLOAT float format to IEEE float format */
+ for (ii = 0; ii < nvals; ii++)
+ values[ii] *= 0.25;
+
+ ffswap2( (short *) values, nvals * 4); /* swap pairs of bytes */
+
+#elif BYTESWAPPED
+ ffswap8(values, nvals); /* reverse order of bytes in each value */
+#endif
+
+ if (incre == 8) /* write all the values at once (contiguous bytes) */
+
+ ffpbyt(fptr, nvals * 8, values, status);
+
+ else /* have to write each value individually (not contiguous ) */
+
+ ffpbytoff(fptr, 8, nvals, incre - 8, values, status);
+
+ return(*status);
+}
+
diff --git a/src/plugins/cfitsio/cfileio.c b/src/plugins/cfitsio/cfileio.c
new file mode 100644
index 0000000..ca081a0
--- /dev/null
+++ b/src/plugins/cfitsio/cfileio.c
@@ -0,0 +1,6859 @@
+/* This file, cfileio.c, contains the low-level file access routines. */
+
+/* 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 <math.h>
+#include <ctype.h>
+#include <errno.h>
+#include <stddef.h> /* apparently needed to define size_t */
+#include "fitsio2.h"
+#include "group.h"
+
+#define MAX_PREFIX_LEN 20 /* max length of file type prefix (e.g. 'http://') */
+#define MAX_DRIVERS 24 /* max number of file I/O drivers */
+
+typedef struct /* structure containing pointers to I/O driver functions */
+{ char prefix[MAX_PREFIX_LEN];
+ int (*init)(void);
+ int (*shutdown)(void);
+ int (*setoptions)(int option);
+ int (*getoptions)(int *options);
+ int (*getversion)(int *version);
+ int (*checkfile)(char *urltype, char *infile, char *outfile);
+ int (*open)(char *filename, int rwmode, int *driverhandle);
+ int (*create)(char *filename, int *drivehandle);
+ int (*truncate)(int drivehandle, LONGLONG size);
+ int (*close)(int drivehandle);
+ int (*remove)(char *filename);
+ int (*size)(int drivehandle, LONGLONG *size);
+ int (*flush)(int drivehandle);
+ int (*seek)(int drivehandle, LONGLONG offset);
+ int (*read)(int drivehandle, void *buffer, long nbytes);
+ int (*write)(int drivehandle, void *buffer, long nbytes);
+} fitsdriver;
+
+fitsdriver driverTable[MAX_DRIVERS]; /* allocate driver tables */
+
+FITSfile *FptrTable[NMAXFILES]; /* this table of Fptr pointers is */
+ /* used by fits_already_open */
+
+int need_to_initialize = 1; /* true if CFITSIO has not been initialized */
+int no_of_drivers = 0; /* number of currently defined I/O drivers */
+
+static int pixel_filter_helper(fitsfile **fptr, char *outfile,
+ char *expr, int *status);
+
+
+#ifdef _REENTRANT
+
+pthread_mutex_t Fitsio_InitLock = PTHREAD_MUTEX_INITIALIZER;
+
+#endif
+
+/*--------------------------------------------------------------------------*/
+int fitsio_init_lock(void)
+{
+ static int need_to_init = 1;
+
+#ifdef _REENTRANT
+
+ pthread_mutexattr_t mutex_init;
+
+ FFLOCK1(Fitsio_InitLock);
+
+ if (need_to_init) {
+
+ /* Init the main fitsio lock here since we need a a recursive lock */
+
+ assert(!pthread_mutexattr_init(&mutex_init));
+#ifdef linux
+ assert(!pthread_mutexattr_settype(&mutex_init,
+ PTHREAD_MUTEX_RECURSIVE_NP));
+#else
+ assert(!pthread_mutexattr_settype(&mutex_init,
+ PTHREAD_MUTEX_RECURSIVE));
+#endif
+
+ assert(!pthread_mutex_init(&Fitsio_Lock,&mutex_init));
+ need_to_init = 0;
+ }
+
+ FFUNLOCK1(Fitsio_InitLock);
+
+#endif
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int ffomem(fitsfile **fptr, /* O - FITS file pointer */
+ const char *name, /* I - name of file to open */
+ int mode, /* I - 0 = open readonly; 1 = read/write */
+ void **buffptr, /* I - address of memory pointer */
+ size_t *buffsize, /* I - size of buffer, in bytes */
+ size_t deltasize, /* I - increment for future realloc's */
+ void *(*mem_realloc)(void *p, size_t newsize), /* function */
+ int *status) /* IO - error status */
+/*
+ Open an existing FITS file in core memory. This is a specialized version
+ of ffopen.
+*/
+{
+ int ii, driver, handle, hdutyp, slen, movetotype, extvers, extnum;
+ char extname[FLEN_VALUE];
+ LONGLONG filesize;
+ char urltype[MAX_PREFIX_LEN], infile[FLEN_FILENAME], outfile[FLEN_FILENAME];
+ char extspec[FLEN_FILENAME], rowfilter[FLEN_FILENAME];
+ char binspec[FLEN_FILENAME], colspec[FLEN_FILENAME];
+ char imagecolname[FLEN_VALUE], rowexpress[FLEN_FILENAME];
+ char *url, errmsg[FLEN_ERRMSG];
+ char *hdtype[3] = {"IMAGE", "TABLE", "BINTABLE"};
+
+ if (*status > 0)
+ return(*status);
+
+ *fptr = 0; /* initialize null file pointer */
+
+ if (need_to_initialize) /* this is called only once */
+ {
+ *status = fits_init_cfitsio();
+
+ if (*status > 0)
+ return(*status);
+ }
+
+ url = (char *) name;
+ while (*url == ' ') /* ignore leading spaces in the file spec */
+ url++;
+
+ /* parse the input file specification */
+ fits_parse_input_url(url, urltype, infile, outfile, extspec,
+ rowfilter, binspec, colspec, status);
+
+ strcpy(urltype, "memkeep://"); /* URL type for pre-existing memory file */
+
+ *status = urltype2driver(urltype, &driver);
+
+ if (*status > 0)
+ {
+ ffpmsg("could not find driver for pre-existing memory file: (ffomem)");
+ return(*status);
+ }
+
+ /* call driver routine to open the memory file */
+ FFLOCK; /* lock this while searching for vacant handle */
+ *status = mem_openmem( buffptr, buffsize,deltasize,
+ mem_realloc, &handle);
+ FFUNLOCK;
+
+ if (*status > 0)
+ {
+ ffpmsg("failed to open pre-existing memory file: (ffomem)");
+ return(*status);
+ }
+
+ /* get initial file size */
+ *status = (*driverTable[driver].size)(handle, &filesize);
+
+ if (*status > 0)
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed get the size of the memory file: (ffomem)");
+ return(*status);
+ }
+
+ /* allocate fitsfile structure and initialize = 0 */
+ *fptr = (fitsfile *) calloc(1, sizeof(fitsfile));
+
+ if (!(*fptr))
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate structure for following file: (ffomem)");
+ ffpmsg(url);
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* allocate FITSfile structure and initialize = 0 */
+ (*fptr)->Fptr = (FITSfile *) calloc(1, sizeof(FITSfile));
+
+ if (!((*fptr)->Fptr))
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate structure for following file: (ffomem)");
+ ffpmsg(url);
+ free(*fptr);
+ *fptr = 0;
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ slen = strlen(url) + 1;
+ slen = maxvalue(slen, 32); /* reserve at least 32 chars */
+ ((*fptr)->Fptr)->filename = (char *) malloc(slen); /* mem for file name */
+
+ if ( !(((*fptr)->Fptr)->filename) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for filename: (ffomem)");
+ ffpmsg(url);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* mem for headstart array */
+ ((*fptr)->Fptr)->headstart = (LONGLONG *) calloc(1001, sizeof(LONGLONG));
+
+ if ( !(((*fptr)->Fptr)->headstart) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for headstart array: (ffomem)");
+ ffpmsg(url);
+ free( ((*fptr)->Fptr)->filename);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* mem for file I/O buffers */
+ ((*fptr)->Fptr)->iobuffer = (char *) calloc(NIOBUF, IOBUFLEN);
+
+ if ( !(((*fptr)->Fptr)->iobuffer) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for iobuffer array: (ffomem)");
+ ffpmsg(url);
+ free( ((*fptr)->Fptr)->headstart); /* free memory for headstart array */
+ free( ((*fptr)->Fptr)->filename);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* initialize the ageindex array (relative age of the I/O buffers) */
+ /* and initialize the bufrecnum array as being empty */
+ for (ii = 0; ii < NIOBUF; ii++) {
+ ((*fptr)->Fptr)->ageindex[ii] = ii;
+ ((*fptr)->Fptr)->bufrecnum[ii] = -1;
+ }
+
+ /* store the parameters describing the file */
+ ((*fptr)->Fptr)->MAXHDU = 1000; /* initial size of headstart */
+ ((*fptr)->Fptr)->filehandle = handle; /* file handle */
+ ((*fptr)->Fptr)->driver = driver; /* driver number */
+ strcpy(((*fptr)->Fptr)->filename, url); /* full input filename */
+ ((*fptr)->Fptr)->filesize = filesize; /* physical file size */
+ ((*fptr)->Fptr)->logfilesize = filesize; /* logical file size */
+ ((*fptr)->Fptr)->writemode = mode; /* read-write mode */
+ ((*fptr)->Fptr)->datastart = DATA_UNDEFINED; /* unknown start of data */
+ ((*fptr)->Fptr)->curbuf = -1; /* undefined current IO buffer */
+ ((*fptr)->Fptr)->open_count = 1; /* structure is currently used once */
+ ((*fptr)->Fptr)->validcode = VALIDSTRUC; /* flag denoting valid structure */
+
+ ffldrc(*fptr, 0, REPORT_EOF, status); /* load first record */
+
+ fits_store_Fptr( (*fptr)->Fptr, status); /* store Fptr address */
+
+ if (ffrhdu(*fptr, &hdutyp, status) > 0) /* determine HDU structure */
+ {
+ ffpmsg(
+ "ffomem could not interpret primary array header of file: (ffomem)");
+ ffpmsg(url);
+
+ if (*status == UNKNOWN_REC)
+ ffpmsg("This does not look like a FITS file.");
+
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ }
+
+ /* ---------------------------------------------------------- */
+ /* move to desired extension, if specified as part of the URL */
+ /* ---------------------------------------------------------- */
+
+ imagecolname[0] = '\0';
+ rowexpress[0] = '\0';
+
+ if (*extspec)
+ {
+ /* parse the extension specifier into individual parameters */
+ ffexts(extspec, &extnum,
+ extname, &extvers, &movetotype, imagecolname, rowexpress, status);
+
+
+ if (*status > 0)
+ return(*status);
+
+ if (extnum)
+ {
+ ffmahd(*fptr, extnum + 1, &hdutyp, status);
+ }
+ else if (*extname) /* move to named extension, if specified */
+ {
+ ffmnhd(*fptr, movetotype, extname, extvers, status);
+ }
+
+ if (*status > 0)
+ {
+ ffpmsg("ffomem could not move to the specified extension:");
+ if (extnum > 0)
+ {
+ sprintf(errmsg,
+ " extension number %d doesn't exist or couldn't be opened.",extnum);
+ ffpmsg(errmsg);
+ }
+ else
+ {
+ sprintf(errmsg,
+ " extension with EXTNAME = %s,", extname);
+ ffpmsg(errmsg);
+
+ if (extvers)
+ {
+ sprintf(errmsg,
+ " and with EXTVERS = %d,", extvers);
+ ffpmsg(errmsg);
+ }
+
+ if (movetotype != ANY_HDU)
+ {
+ sprintf(errmsg,
+ " and with XTENSION = %s,", hdtype[movetotype]);
+ ffpmsg(errmsg);
+ }
+
+ ffpmsg(" doesn't exist or couldn't be opened.");
+ }
+ return(*status);
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdkopn(fitsfile **fptr, /* O - FITS file pointer */
+ const char *name, /* I - full name of file to open */
+ int mode, /* I - 0 = open readonly; 1 = read/write */
+ int *status) /* IO - error status */
+/*
+ Open an existing FITS file on magnetic disk with either readonly or
+ read/write access. The routine does not support CFITSIO's extended
+ filename syntax and simply uses the entire input 'name' string as
+ the name of the file.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ *status = OPEN_DISK_FILE;
+
+ ffopen(fptr, name, mode, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdopn(fitsfile **fptr, /* O - FITS file pointer */
+ const char *name, /* I - full name of file to open */
+ int mode, /* I - 0 = open readonly; 1 = read/write */
+ int *status) /* IO - error status */
+/*
+ Open an existing FITS file with either readonly or read/write access. and
+ move to the first HDU that contains 'interesting' data, if the primary
+ array contains a null image (i.e., NAXIS = 0).
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ *status = SKIP_NULL_PRIMARY;
+
+ ffopen(fptr, name, mode, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fftopn(fitsfile **fptr, /* O - FITS file pointer */
+ const char *name, /* I - full name of file to open */
+ int mode, /* I - 0 = open readonly; 1 = read/write */
+ int *status) /* IO - error status */
+/*
+ Open an existing FITS file with either readonly or read/write access. and
+ move to the first HDU that contains 'interesting' table (not an image).
+*/
+{
+ int hdutype;
+
+ if (*status > 0)
+ return(*status);
+
+ *status = SKIP_IMAGE;
+
+ ffopen(fptr, name, mode, status);
+
+ if (ffghdt(*fptr, &hdutype, status) <= 0) {
+ if (hdutype == IMAGE_HDU)
+ *status = NOT_TABLE;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffiopn(fitsfile **fptr, /* O - FITS file pointer */
+ const char *name, /* I - full name of file to open */
+ int mode, /* I - 0 = open readonly; 1 = read/write */
+ int *status) /* IO - error status */
+/*
+ Open an existing FITS file with either readonly or read/write access. and
+ move to the first HDU that contains 'interesting' image (not an table).
+*/
+{
+ int hdutype;
+
+ if (*status > 0)
+ return(*status);
+
+ *status = SKIP_TABLE;
+
+ ffopen(fptr, name, mode, status);
+
+ if (ffghdt(*fptr, &hdutype, status) <= 0) {
+ if (hdutype != IMAGE_HDU)
+ *status = NOT_IMAGE;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffopentest(double version, /* I - CFITSIO version number, from the */
+ /* application program (fitsio.h file) */
+ fitsfile **fptr, /* O - FITS file pointer */
+ const char *name, /* I - full name of file to open */
+ int mode, /* I - 0 = open readonly; 1 = read/write */
+ int *status) /* IO - error status */
+/*
+ Open an existing FITS file with either readonly or read/write access.
+ First test that the version of fitsio.h used to build the CFITSIO library
+ is the same as the version used in building the application program that
+ links to the library.
+*/
+{
+ if (version != CFITSIO_VERSION)
+ {
+ printf("ERROR: Mismatch in the version of the fitsio.h include file used to build\n");
+ printf("the CFITSIO library, and the version included by the application program:\n");
+ printf(" Version used to build the CFITSIO library = %f\n",CFITSIO_VERSION);
+ printf(" Version included by the application program = %f\n",version);
+
+ *status = FILE_NOT_OPENED;
+ return(*status);
+ }
+
+ /* now call the normal file open routine */
+ ffopen(fptr, name, mode, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffopen(fitsfile **fptr, /* O - FITS file pointer */
+ const char *name, /* I - full name of file to open */
+ int mode, /* I - 0 = open readonly; 1 = read/write */
+ int *status) /* IO - error status */
+/*
+ Open an existing FITS file with either readonly or read/write access.
+*/
+{
+ fitsfile *newptr;
+ int ii, driver, hdutyp, hdunum, slen, writecopy, isopen;
+ LONGLONG filesize;
+ long rownum, nrows, goodrows;
+ int extnum, extvers, handle, movetotype, tstatus = 0, only_one = 0;
+ char urltype[MAX_PREFIX_LEN], infile[FLEN_FILENAME], outfile[FLEN_FILENAME];
+ char origurltype[MAX_PREFIX_LEN], extspec[FLEN_FILENAME];
+ char extname[FLEN_VALUE], rowfilter[FLEN_FILENAME], tblname[FLEN_VALUE];
+ char imagecolname[FLEN_VALUE], rowexpress[FLEN_FILENAME];
+ char binspec[FLEN_FILENAME], colspec[FLEN_FILENAME], pixfilter[FLEN_FILENAME];
+ char histfilename[FLEN_FILENAME];
+ char filtfilename[FLEN_FILENAME];
+ char wtcol[FLEN_VALUE];
+ char minname[4][FLEN_VALUE], maxname[4][FLEN_VALUE];
+ char binname[4][FLEN_VALUE];
+
+ char *url;
+ double minin[4], maxin[4], binsizein[4], weight;
+ int imagetype, naxis = 1, haxis, recip;
+ int skip_null = 0, skip_image = 0, skip_table = 0, open_disk_file = 0;
+ char colname[4][FLEN_VALUE];
+ char errmsg[FLEN_ERRMSG];
+ char *hdtype[3] = {"IMAGE", "TABLE", "BINTABLE"};
+ char *rowselect = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ if (*status == SKIP_NULL_PRIMARY)
+ {
+ /* this special status value is used as a flag by ffdopn to tell */
+ /* ffopen to skip over a null primary array when opening the file. */
+
+ skip_null = 1;
+ *status = 0;
+ }
+ else if (*status == SKIP_IMAGE)
+ {
+ /* this special status value is used as a flag by fftopn to tell */
+ /* ffopen to move to 1st significant table when opening the file. */
+
+ skip_image = 1;
+ *status = 0;
+ }
+ else if (*status == SKIP_TABLE)
+ {
+ /* this special status value is used as a flag by ffiopn to tell */
+ /* ffopen to move to 1st significant image when opening the file. */
+
+ skip_table = 1;
+ *status = 0;
+ }
+ else if (*status == OPEN_DISK_FILE)
+ {
+ /* this special status value is used as a flag by ffdkopn to tell */
+ /* ffopen to not interpret the input filename using CFITSIO's */
+ /* extended filename syntax, and simply open the specified disk file */
+
+ open_disk_file = 1;
+ *status = 0;
+ }
+
+ *fptr = 0; /* initialize null file pointer */
+ writecopy = 0; /* have we made a write-able copy of the input file? */
+
+ if (need_to_initialize) { /* this is called only once */
+ *status = fits_init_cfitsio();
+ }
+
+ if (*status > 0)
+ return(*status);
+
+ url = (char *) name;
+ while (*url == ' ') /* ignore leading spaces in the filename */
+ url++;
+
+ if (*url == '\0')
+ {
+ ffpmsg("Name of file to open is blank. (ffopen)");
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ if (open_disk_file)
+ {
+ /* treat the input URL literally as the name of the file to open */
+ /* and don't try to parse the URL using the extended filename syntax */
+
+ if (strlen(url) > FLEN_FILENAME - 1) {
+ ffpmsg("Name of file to open is too long. (ffopen)");
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ strcpy(infile,url);
+ strcpy(urltype, "file://");
+ outfile[0] = '\0';
+ extspec[0] = '\0';
+ binspec[0] = '\0';
+ colspec[0] = '\0';
+ rowfilter[0] = '\0';
+ pixfilter[0] = '\0';
+ }
+ else
+ {
+ /* parse the input file specification */
+
+ /* NOTE: This routine tests that all the strings do not */
+ /* overflow the standard buffer sizes (FLEN_FILENAME, etc.) */
+ /* therefore in general we do not have to worry about buffer */
+ /* overflow of any of the returned strings. */
+
+ fits_parse_input_filename(url, urltype, infile, outfile, extspec,
+ rowfilter, binspec, colspec, pixfilter, status);
+ }
+
+ if (*status > 0)
+ {
+ ffpmsg("could not parse the input filename: (ffopen)");
+ ffpmsg(url);
+ return(*status);
+ }
+
+ imagecolname[0] = '\0';
+ rowexpress[0] = '\0';
+
+ if (*extspec)
+ {
+ slen = strlen(extspec);
+ if (extspec[slen - 1] == '#') { /* special symbol to mean only copy this extension */
+ extspec[slen - 1] = '\0';
+ only_one = 1;
+ }
+
+ /* parse the extension specifier into individual parameters */
+ ffexts(extspec, &extnum,
+ extname, &extvers, &movetotype, imagecolname, rowexpress, status);
+
+ if (*status > 0)
+ return(*status);
+ }
+
+ /*-------------------------------------------------------------------*/
+ /* special cases: */
+ /*-------------------------------------------------------------------*/
+
+ histfilename[0] = '\0';
+ filtfilename[0] = '\0';
+ if (*outfile && (*binspec || *imagecolname || *pixfilter))
+ {
+ /* if binspec or imagecolumn are specified, then the */
+ /* output file name is intended for the final image, */
+ /* and not a copy of the input file. */
+
+ strcpy(histfilename, outfile);
+ outfile[0] = '\0';
+ }
+ else if (*outfile && (*rowfilter || *colspec))
+ {
+ /* if rowfilter or colspece are specified, then the */
+ /* output file name is intended for the filtered file */
+ /* and not a copy of the input file. */
+
+ strcpy(filtfilename, outfile);
+ outfile[0] = '\0';
+ }
+
+ /*-------------------------------------------------------------------*/
+ /* check if this same file is already open, and if so, attach to it */
+ /*-------------------------------------------------------------------*/
+
+ FFLOCK;
+ if (fits_already_open(fptr, url, urltype, infile, extspec, rowfilter,
+ binspec, colspec, mode, &isopen, status) > 0)
+ {
+ FFUNLOCK;
+ return(*status);
+ }
+ FFUNLOCK;
+
+ if (isopen) {
+ goto move2hdu;
+ }
+
+ /* get the driver number corresponding to this urltype */
+ *status = urltype2driver(urltype, &driver);
+
+ if (*status > 0)
+ {
+ ffpmsg("could not find driver for this file: (ffopen)");
+ ffpmsg(urltype);
+ ffpmsg(url);
+ return(*status);
+ }
+
+ /*-------------------------------------------------------------------
+ deal with all those messy special cases which may require that
+ a different driver be used:
+ - is disk file compressed?
+ - are ftp:, gsiftp:, or http: files compressed?
+ - has user requested that a local copy be made of
+ the ftp or http file?
+ -------------------------------------------------------------------*/
+
+ if (driverTable[driver].checkfile)
+ {
+ strcpy(origurltype,urltype); /* Save the urltype */
+
+ /* 'checkfile' may modify the urltype, infile and outfile strings */
+ *status = (*driverTable[driver].checkfile)(urltype, infile, outfile);
+
+ if (*status)
+ {
+ ffpmsg("checkfile failed for this file: (ffopen)");
+ ffpmsg(url);
+ return(*status);
+ }
+
+ if (strcmp(origurltype, urltype)) /* did driver changed on us? */
+ {
+ *status = urltype2driver(urltype, &driver);
+ if (*status > 0)
+ {
+ ffpmsg("could not change driver for this file: (ffopen)");
+ ffpmsg(url);
+ ffpmsg(urltype);
+ return(*status);
+ }
+ }
+ }
+
+ /* call appropriate driver to open the file */
+ if (driverTable[driver].open)
+ {
+ FFLOCK; /* lock this while searching for vacant handle */
+ *status = (*driverTable[driver].open)(infile, mode, &handle);
+ FFUNLOCK;
+ if (*status > 0)
+ {
+ ffpmsg("failed to find or open the following file: (ffopen)");
+ ffpmsg(url);
+ return(*status);
+ }
+ }
+ else
+ {
+ ffpmsg("cannot open an existing file of this type: (ffopen)");
+ ffpmsg(url);
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ /* get initial file size */
+ *status = (*driverTable[driver].size)(handle, &filesize);
+ if (*status > 0)
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed get the size of the following file: (ffopen)");
+ ffpmsg(url);
+ return(*status);
+ }
+
+ /* allocate fitsfile structure and initialize = 0 */
+ *fptr = (fitsfile *) calloc(1, sizeof(fitsfile));
+
+ if (!(*fptr))
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate structure for following file: (ffopen)");
+ ffpmsg(url);
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* allocate FITSfile structure and initialize = 0 */
+ (*fptr)->Fptr = (FITSfile *) calloc(1, sizeof(FITSfile));
+
+ if (!((*fptr)->Fptr))
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate structure for following file: (ffopen)");
+ ffpmsg(url);
+ free(*fptr);
+ *fptr = 0;
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ slen = strlen(url) + 1;
+ slen = maxvalue(slen, 32); /* reserve at least 32 chars */
+ ((*fptr)->Fptr)->filename = (char *) malloc(slen); /* mem for file name */
+
+ if ( !(((*fptr)->Fptr)->filename) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for filename: (ffopen)");
+ ffpmsg(url);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* mem for headstart array */
+ ((*fptr)->Fptr)->headstart = (LONGLONG *) calloc(1001, sizeof(LONGLONG));
+
+ if ( !(((*fptr)->Fptr)->headstart) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for headstart array: (ffopen)");
+ ffpmsg(url);
+ free( ((*fptr)->Fptr)->filename);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* mem for file I/O buffers */
+ ((*fptr)->Fptr)->iobuffer = (char *) calloc(NIOBUF, IOBUFLEN);
+
+ if ( !(((*fptr)->Fptr)->iobuffer) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for iobuffer array: (ffopen)");
+ ffpmsg(url);
+ free( ((*fptr)->Fptr)->headstart); /* free memory for headstart array */
+ free( ((*fptr)->Fptr)->filename);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* initialize the ageindex array (relative age of the I/O buffers) */
+ /* and initialize the bufrecnum array as being empty */
+ for (ii = 0; ii < NIOBUF; ii++) {
+ ((*fptr)->Fptr)->ageindex[ii] = ii;
+ ((*fptr)->Fptr)->bufrecnum[ii] = -1;
+ }
+
+ /* store the parameters describing the file */
+ ((*fptr)->Fptr)->MAXHDU = 1000; /* initial size of headstart */
+ ((*fptr)->Fptr)->filehandle = handle; /* file handle */
+ ((*fptr)->Fptr)->driver = driver; /* driver number */
+ strcpy(((*fptr)->Fptr)->filename, url); /* full input filename */
+ ((*fptr)->Fptr)->filesize = filesize; /* physical file size */
+ ((*fptr)->Fptr)->logfilesize = filesize; /* logical file size */
+ ((*fptr)->Fptr)->writemode = mode; /* read-write mode */
+ ((*fptr)->Fptr)->datastart = DATA_UNDEFINED; /* unknown start of data */
+ ((*fptr)->Fptr)->curbuf = -1; /* undefined current IO buffer */
+ ((*fptr)->Fptr)->open_count = 1; /* structure is currently used once */
+ ((*fptr)->Fptr)->validcode = VALIDSTRUC; /* flag denoting valid structure */
+ ((*fptr)->Fptr)->only_one = only_one; /* flag denoting only copy single extension */
+
+ ffldrc(*fptr, 0, REPORT_EOF, status); /* load first record */
+
+ fits_store_Fptr( (*fptr)->Fptr, status); /* store Fptr address */
+
+ if (ffrhdu(*fptr, &hdutyp, status) > 0) /* determine HDU structure */
+ {
+ ffpmsg(
+ "ffopen could not interpret primary array header of file: ");
+ ffpmsg(url);
+
+ if (*status == UNKNOWN_REC)
+ ffpmsg("This does not look like a FITS file.");
+
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+
+ /* ------------------------------------------------------------- */
+ /* At this point, the input file has been opened. If outfile was */
+ /* specified, then we have opened a copy of the file, not the */
+ /* original file so it is safe to modify it if necessary */
+ /* ------------------------------------------------------------- */
+
+ if (*outfile)
+ writecopy = 1;
+
+move2hdu:
+
+ /* ---------------------------------------------------------- */
+ /* move to desired extension, if specified as part of the URL */
+ /* ---------------------------------------------------------- */
+
+ if (*extspec)
+ {
+ if (extnum) /* extension number was specified */
+ {
+ ffmahd(*fptr, extnum + 1, &hdutyp, status);
+ }
+ else if (*extname) /* move to named extension, if specified */
+ {
+ ffmnhd(*fptr, movetotype, extname, extvers, status);
+ }
+
+ if (*status > 0) /* clean up after error */
+ {
+ ffpmsg("ffopen could not move to the specified extension:");
+ if (extnum > 0)
+ {
+ sprintf(errmsg,
+ " extension number %d doesn't exist or couldn't be opened.",extnum);
+ ffpmsg(errmsg);
+ }
+ else
+ {
+ sprintf(errmsg,
+ " extension with EXTNAME = %s,", extname);
+ ffpmsg(errmsg);
+
+ if (extvers)
+ {
+ sprintf(errmsg,
+ " and with EXTVERS = %d,", extvers);
+ ffpmsg(errmsg);
+ }
+
+ if (movetotype != ANY_HDU)
+ {
+ sprintf(errmsg,
+ " and with XTENSION = %s,", hdtype[movetotype]);
+ ffpmsg(errmsg);
+ }
+
+ ffpmsg(" doesn't exist or couldn't be opened.");
+ }
+
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+ }
+ else if (skip_null || skip_image || skip_table ||
+ (*imagecolname || *colspec || *rowfilter || *binspec))
+ {
+ /* ------------------------------------------------------------------
+
+ If no explicit extension specifier is given as part of the file
+ name, and, if a) skip_null is true (set if ffopen is called by
+ ffdopn) or b) skip_image or skip_table is true (set if ffopen is
+ called by fftopn or ffdopn) or c) other file filters are
+ specified, then CFITSIO will attempt to move to the first
+ 'interesting' HDU after opening an existing FITS file (or to
+ first interesting table HDU if skip_image is true);
+
+ An 'interesting' HDU is defined to be either an image with NAXIS
+ > 0 (i.e., not a null array) or a table which has an EXTNAME
+ value which does not contain any of the following strings:
+ 'GTI' - Good Time Interval extension
+ 'OBSTABLE' - used in Beppo SAX data files
+
+ The main purpose for this is to allow CFITSIO to skip over a null
+ primary and other non-interesting HDUs when opening an existing
+ file, and move directly to the first extension that contains
+ significant data.
+ ------------------------------------------------------------------ */
+
+ fits_get_hdu_num(*fptr, &hdunum);
+ if (hdunum == 1) {
+
+ fits_get_img_dim(*fptr, &naxis, status);
+
+ if (naxis == 0 || skip_image) /* skip primary array */
+ {
+ while(1)
+ {
+ /* see if the next HDU is 'interesting' */
+ if (fits_movrel_hdu(*fptr, 1, &hdutyp, status))
+ {
+ if (*status == END_OF_FILE)
+ *status = 0; /* reset expected error */
+
+ /* didn't find an interesting HDU so move back to beginning */
+ fits_movabs_hdu(*fptr, 1, &hdutyp, status);
+ break;
+ }
+
+ if (hdutyp == IMAGE_HDU && skip_image) {
+
+ continue; /* skip images */
+
+ } else if (hdutyp != IMAGE_HDU && skip_table) {
+
+ continue; /* skip tables */
+
+ } else if (hdutyp == IMAGE_HDU) {
+
+ fits_get_img_dim(*fptr, &naxis, status);
+ if (naxis > 0)
+ break; /* found a non-null image */
+
+ } else {
+
+ tstatus = 0;
+ tblname[0] = '\0';
+ fits_read_key(*fptr, TSTRING, "EXTNAME", tblname, NULL,&tstatus);
+
+ if ( (!strstr(tblname, "GTI") && !strstr(tblname, "gti")) &&
+ strncasecmp(tblname, "OBSTABLE", 8) )
+ break; /* found an interesting table */
+ }
+ } /* end while */
+ }
+ } /* end if (hdunum==1) */
+ }
+
+ if (*imagecolname)
+ {
+ /* ----------------------------------------------------------------- */
+ /* we need to open an image contained in a single table cell */
+ /* First, determine which row of the table to use. */
+ /* ----------------------------------------------------------------- */
+
+ if (isdigit((int) *rowexpress)) /* is the row specification a number? */
+ {
+ sscanf(rowexpress, "%ld", &rownum);
+ if (rownum < 1)
+ {
+ ffpmsg("illegal rownum for image cell:");
+ ffpmsg(rowexpress);
+ ffpmsg("Could not open the following image in a table cell:");
+ ffpmsg(extspec);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status = BAD_ROW_NUM);
+ }
+ }
+ else if (fits_find_first_row(*fptr, rowexpress, &rownum, status) > 0)
+ {
+ ffpmsg("Failed to find row matching this expression:");
+ ffpmsg(rowexpress);
+ ffpmsg("Could not open the following image in a table cell:");
+ ffpmsg(extspec);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+
+ if (rownum == 0)
+ {
+ ffpmsg("row statisfying this expression doesn't exist::");
+ ffpmsg(rowexpress);
+ ffpmsg("Could not open the following image in a table cell:");
+ ffpmsg(extspec);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status = BAD_ROW_NUM);
+ }
+
+ /* determine the name of the new file to contain copy of the image */
+ if (*histfilename && !(*pixfilter) )
+ strcpy(outfile, histfilename); /* the original outfile name */
+ else
+ strcpy(outfile, "mem://_1"); /* create image file in memory */
+
+ /* Copy the image into new primary array and open it as the current */
+ /* fptr. This will close the table that contains the original image. */
+
+ /* create new empty file to hold copy of the image */
+ if (ffinit(&newptr, outfile, status) > 0)
+ {
+ ffpmsg("failed to create file for copy of image in table cell:");
+ ffpmsg(outfile);
+ return(*status);
+ }
+
+ if (fits_copy_cell2image(*fptr, newptr, imagecolname, rownum,
+ status) > 0)
+ {
+ ffpmsg("Failed to copy table cell to new primary array:");
+ ffpmsg(extspec);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+
+ /* close the original file and set fptr to the new image */
+ ffclos(*fptr, status);
+
+ *fptr = newptr; /* reset the pointer to the new table */
+
+ writecopy = 1; /* we are now dealing with a copy of the original file */
+
+ /* add some HISTORY; fits_copy_image_cell also wrote HISTORY keywords */
+
+/* disable this; leave it up to calling routine to write any HISTORY keywords
+ if (*extname)
+ sprintf(card,"HISTORY in HDU '%.16s' of file '%.36s'",extname,infile);
+ else
+ sprintf(card,"HISTORY in HDU %d of file '%.45s'", extnum, infile);
+
+ ffprec(*fptr, card, status);
+*/
+ }
+
+ /* --------------------------------------------------------------------- */
+ /* edit columns (and/or keywords) in the table, if specified in the URL */
+ /* --------------------------------------------------------------------- */
+
+ if (*colspec)
+ {
+ /* the column specifier will modify the file, so make sure */
+ /* we are already dealing with a copy, or else make a new copy */
+
+ if (!writecopy) /* Is the current file already a copy? */
+ writecopy = fits_is_this_a_copy(urltype);
+
+ if (!writecopy)
+ {
+ if (*filtfilename && *outfile == '\0')
+ strcpy(outfile, filtfilename); /* the original outfile name */
+ else
+ strcpy(outfile, "mem://_1"); /* will create copy in memory */
+
+ writecopy = 1;
+ }
+ else
+ {
+ ((*fptr)->Fptr)->writemode = READWRITE; /* we have write access */
+ outfile[0] = '\0';
+ }
+
+ if (ffedit_columns(fptr, outfile, colspec, status) > 0)
+ {
+ ffpmsg("editing columns in input table failed (ffopen)");
+ ffpmsg(" while trying to perform the following operation:");
+ ffpmsg(colspec);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+ }
+
+ /* ------------------------------------------------------------------- */
+ /* select rows from the table, if specified in the URL */
+ /* or select a subimage (if this is an image HDU and not a table) */
+ /* ------------------------------------------------------------------- */
+
+ if (*rowfilter)
+ {
+ fits_get_hdu_type(*fptr, &hdutyp, status); /* get type of HDU */
+ if (hdutyp == IMAGE_HDU)
+ {
+ /* this is an image so 'rowfilter' is an image section specification */
+
+ if (*filtfilename && *outfile == '\0')
+ strcpy(outfile, filtfilename); /* the original outfile name */
+ else if (*outfile == '\0') /* output file name not already defined? */
+ strcpy(outfile, "mem://_2"); /* will create file in memory */
+
+ /* create new file containing the image section, plus a copy of */
+ /* any other HDUs that exist in the input file. This routine */
+ /* will close the original image file and return a pointer */
+ /* to the new file. */
+
+ if (fits_select_image_section(fptr, outfile, rowfilter, status) > 0)
+ {
+ ffpmsg("on-the-fly selection of image section failed (ffopen)");
+ ffpmsg(" while trying to use the following section filter:");
+ ffpmsg(rowfilter);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+ }
+ else
+ {
+ /* this is a table HDU, so the rowfilter is really a row filter */
+
+ if (*binspec)
+ {
+ /* since we are going to make a histogram of the selected rows, */
+ /* it would be a waste of time and memory to make a whole copy of */
+ /* the selected rows. Instead, just construct an array of TRUE */
+ /* or FALSE values that indicate which rows are to be included */
+ /* in the histogram and pass that to the histogram generating */
+ /* routine */
+
+ fits_get_num_rows(*fptr, &nrows, status); /* get no. of rows */
+
+ rowselect = (char *) calloc(nrows, 1);
+ if (!rowselect)
+ {
+ ffpmsg(
+ "failed to allocate memory for selected columns array (ffopen)");
+ ffpmsg(" while trying to select rows with the following filter:");
+ ffpmsg(rowfilter);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ if (fits_find_rows(*fptr, rowfilter, 1L, nrows, &goodrows,
+ rowselect, status) > 0)
+ {
+ ffpmsg("selection of rows in input table failed (ffopen)");
+ ffpmsg(" while trying to select rows with the following filter:");
+ ffpmsg(rowfilter);
+ free(rowselect);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+ }
+ else
+ {
+ if (!writecopy) /* Is the current file already a copy? */
+ writecopy = fits_is_this_a_copy(urltype);
+
+ if (!writecopy)
+ {
+ if (*filtfilename && *outfile == '\0')
+ strcpy(outfile, filtfilename); /* the original outfile name */
+ else if (*outfile == '\0') /* output filename not already defined? */
+ strcpy(outfile, "mem://_2"); /* will create copy in memory */
+ }
+ else
+ {
+ ((*fptr)->Fptr)->writemode = READWRITE; /* we have write access */
+ outfile[0] = '\0';
+ }
+
+ /* select rows in the table. If a copy of the input file has */
+ /* not already been made, then this routine will make a copy */
+ /* and then close the input file, so that the modifications will */
+ /* only be made on the copy, not the original */
+
+ if (ffselect_table(fptr, outfile, rowfilter, status) > 0)
+ {
+ ffpmsg("on-the-fly selection of rows in input table failed (ffopen)");
+ ffpmsg(" while trying to select rows with the following filter:");
+ ffpmsg(rowfilter);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+
+ /* write history records */
+ ffphis(*fptr,
+ "CFITSIO used the following filtering expression to create this table:",
+ status);
+ ffphis(*fptr, name, status);
+
+ } /* end of no binspec case */
+ } /* end of table HDU case */
+ } /* end of rowfilter exists case */
+
+ /* ------------------------------------------------------------------- */
+ /* make an image histogram by binning columns, if specified in the URL */
+ /* ------------------------------------------------------------------- */
+
+ if (*binspec)
+ {
+ if (*histfilename && !(*pixfilter) )
+ strcpy(outfile, histfilename); /* the original outfile name */
+ else
+ strcpy(outfile, "mem://_3"); /* create histogram in memory */
+ /* if not already copied the file */
+
+ /* parse the binning specifier into individual parameters */
+ ffbins(binspec, &imagetype, &haxis, colname,
+ minin, maxin, binsizein,
+ minname, maxname, binname,
+ &weight, wtcol, &recip, status);
+
+ /* Create the histogram primary array and open it as the current fptr */
+ /* This will close the table that was used to create the histogram. */
+ ffhist2(fptr, outfile, imagetype, haxis, colname, minin, maxin,
+ binsizein, minname, maxname, binname,
+ weight, wtcol, recip, rowselect, status);
+
+ if (rowselect)
+ free(rowselect);
+
+ if (*status > 0)
+ {
+ ffpmsg("on-the-fly histogramming of input table failed (ffopen)");
+ ffpmsg(" while trying to execute the following histogram specification:");
+ ffpmsg(binspec);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+
+ /* write history records */
+ ffphis(*fptr,
+ "CFITSIO used the following expression to create this histogram:",
+ status);
+ ffphis(*fptr, name, status);
+ }
+
+ if (*pixfilter)
+ {
+ if (*histfilename)
+ strcpy(outfile, histfilename); /* the original outfile name */
+ else
+ strcpy(outfile, "mem://_4"); /* create in memory */
+ /* if not already copied the file */
+
+ /* Ensure type of HDU is consistent with pixel filtering */
+ fits_get_hdu_type(*fptr, &hdutyp, status); /* get type of HDU */
+ if (hdutyp == IMAGE_HDU) {
+
+ pixel_filter_helper(fptr, outfile, pixfilter, status);
+
+ if (*status > 0) {
+ ffpmsg("pixel filtering of input image failed (ffopen)");
+ ffpmsg(" while trying to execute the following:");
+ ffpmsg(pixfilter);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ return(*status);
+ }
+
+ /* write history records */
+ ffphis(*fptr,
+ "CFITSIO used the following expression to create this image:",
+ status);
+ ffphis(*fptr, name, status);
+
+ return *status;
+ }
+ else {
+ ffpmsg("cannot use pixel filter on non-IMAGE HDU");
+ ffpmsg(pixfilter);
+ ffclos(*fptr, status);
+ *fptr = 0; /* return null file pointer */
+ *status = NOT_IMAGE;
+ return(*status);
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffreopen(fitsfile *openfptr, /* I - FITS file pointer to open file */
+ fitsfile **newfptr, /* O - pointer to new re opened file */
+ int *status) /* IO - error status */
+/*
+ Reopen an existing FITS file with either readonly or read/write access.
+ The reopened file shares the same FITSfile structure but may point to a
+ different HDU within the file.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ /* check that the open file pointer is valid */
+ if (!openfptr)
+ return(*status = NULL_INPUT_PTR);
+ else if ((openfptr->Fptr)->validcode != VALIDSTRUC) /* check magic value */
+ return(*status = BAD_FILEPTR);
+
+ /* allocate fitsfile structure and initialize = 0 */
+ *newfptr = (fitsfile *) calloc(1, sizeof(fitsfile));
+
+ (*newfptr)->Fptr = openfptr->Fptr; /* both point to the same structure */
+ (*newfptr)->HDUposition = 0; /* set initial position to primary array */
+ (((*newfptr)->Fptr)->open_count)++; /* increment the file usage counter */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_store_Fptr(FITSfile *Fptr, /* O - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ store the new Fptr address for future use by fits_already_open
+*/
+{
+ int ii;
+
+ if (*status > 0)
+ return(*status);
+
+ FFLOCK;
+ for (ii = 0; ii < NMAXFILES; ii++) {
+ if (FptrTable[ii] == 0) {
+ FptrTable[ii] = Fptr;
+ break;
+ }
+ }
+ FFUNLOCK;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_clear_Fptr(FITSfile *Fptr, /* O - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ clear the Fptr address from the Fptr Table
+*/
+{
+ int ii;
+
+ FFLOCK;
+ for (ii = 0; ii < NMAXFILES; ii++) {
+ if (FptrTable[ii] == Fptr) {
+ FptrTable[ii] = 0;
+ break;
+ }
+ }
+ FFUNLOCK;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_already_open(fitsfile **fptr, /* I/O - FITS file pointer */
+ char *url,
+ char *urltype,
+ char *infile,
+ char *extspec,
+ char *rowfilter,
+ char *binspec,
+ char *colspec,
+ int mode, /* I - 0 = open readonly; 1 = read/write */
+ int *isopen, /* O - 1 = file is already open */
+ int *status) /* IO - error status */
+/*
+ Check if the file to be opened is already open. If so, then attach to it.
+*/
+
+ /* the input strings must not exceed the standard lengths */
+ /* of FLEN_FILENAME, MAX_PREFIX_LEN, etc. */
+
+ /*
+ this function was changed so that for files of access method FILE://
+ the file paths are compared using standard URL syntax and absolute
+ paths (as opposed to relative paths). This eliminates some instances
+ where a file is already opened but it is not realized because it
+ was opened with another file path. For instance, if the CWD is
+ /a/b/c and I open /a/b/c/foo.fits then open ./foo.fits the previous
+ version of this function would not have reconized that the two files
+ were the same. This version does recognize that the two files are
+ the same.
+ */
+{
+ FITSfile *oldFptr;
+ int ii;
+ char oldurltype[MAX_PREFIX_LEN], oldinfile[FLEN_FILENAME];
+ char oldextspec[FLEN_FILENAME], oldoutfile[FLEN_FILENAME];
+ char oldrowfilter[FLEN_FILENAME];
+ char oldbinspec[FLEN_FILENAME], oldcolspec[FLEN_FILENAME];
+ char cwd[FLEN_FILENAME];
+ char tmpStr[FLEN_FILENAME];
+ char tmpinfile[FLEN_FILENAME];
+
+ *isopen = 0;
+
+/* When opening a file with readonly access then we simply let
+ the operating system open the file again, instead of using the CFITSIO
+ trick of attaching to the previously opened file. This is required
+ if CFITSIO is running in a multi-threaded environment, because 2 different
+ threads cannot share the same FITSfile pointer.
+
+ If the file is opened/reopened with write access, then the file MUST
+ only be physically opened once..
+*/
+ if (mode == 0)
+ return(*status);
+
+ if(strcasecmp(urltype,"FILE://") == 0)
+ {
+ fits_path2url(infile,tmpinfile,status);
+
+ if(tmpinfile[0] != '/')
+ {
+ fits_get_cwd(cwd,status);
+ strcat(cwd,"/");
+
+ if (strlen(cwd) + strlen(tmpinfile) > FLEN_FILENAME-1) {
+ ffpmsg("File name is too long. (fits_already_open)");
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ strcat(cwd,tmpinfile);
+ fits_clean_url(cwd,tmpinfile,status);
+ }
+ }
+ else
+ strcpy(tmpinfile,infile);
+
+ for (ii = 0; ii < NMAXFILES; ii++) /* check every buffer */
+ {
+ if (FptrTable[ii] != 0)
+ {
+ oldFptr = FptrTable[ii];
+
+ fits_parse_input_url(oldFptr->filename, oldurltype,
+ oldinfile, oldoutfile, oldextspec, oldrowfilter,
+ oldbinspec, oldcolspec, status);
+
+ if (*status > 0)
+ {
+ ffpmsg("could not parse the previously opened filename: (ffopen)");
+ ffpmsg(oldFptr->filename);
+ return(*status);
+ }
+
+ if(strcasecmp(oldurltype,"FILE://") == 0)
+ {
+ fits_path2url(oldinfile,tmpStr,status);
+
+ if(tmpStr[0] != '/')
+ {
+ fits_get_cwd(cwd,status);
+ strcat(cwd,"/");
+
+
+ strcat(cwd,tmpStr);
+ fits_clean_url(cwd,tmpStr,status);
+ }
+
+ strcpy(oldinfile,tmpStr);
+ }
+
+ if (!strcmp(urltype, oldurltype) && !strcmp(tmpinfile, oldinfile) )
+ {
+ /* identical type of file and root file name */
+
+ if ( (!rowfilter[0] && !oldrowfilter[0] &&
+ !binspec[0] && !oldbinspec[0] &&
+ !colspec[0] && !oldcolspec[0])
+
+ /* no filtering or binning specs for either file, so */
+ /* this is a case where the same file is being reopened. */
+ /* It doesn't matter if the extensions are different */
+
+ || /* or */
+
+ (!strcmp(rowfilter, oldrowfilter) &&
+ !strcmp(binspec, oldbinspec) &&
+ !strcmp(colspec, oldcolspec) &&
+ !strcmp(extspec, oldextspec) ) )
+
+ /* filtering specs are given and are identical, and */
+ /* the same extension is specified */
+
+ {
+ if (mode == READWRITE && oldFptr->writemode == READONLY)
+ {
+ /*
+ cannot assume that a file previously opened with READONLY
+ can now be written to (e.g., files on CDROM, or over the
+ the network, or STDIN), so return with an error.
+ */
+
+ ffpmsg(
+ "cannot reopen file READWRITE when previously opened READONLY");
+ ffpmsg(url);
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ *fptr = (fitsfile *) calloc(1, sizeof(fitsfile));
+
+ if (!(*fptr))
+ {
+ ffpmsg(
+ "failed to allocate structure for following file: (ffopen)");
+ ffpmsg(url);
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ (*fptr)->Fptr = oldFptr; /* point to the structure */
+ (*fptr)->HDUposition = 0; /* set initial position */
+ (((*fptr)->Fptr)->open_count)++; /* increment usage counter */
+
+ if (binspec[0]) /* if binning specified, don't move */
+ extspec[0] = '\0';
+
+ /* all the filtering has already been applied, so ignore */
+ rowfilter[0] = '\0';
+ binspec[0] = '\0';
+ colspec[0] = '\0';
+
+ *isopen = 1;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_is_this_a_copy(char *urltype) /* I - type of file */
+/*
+ specialized routine that returns 1 if the file is known to be a temporary
+ copy of the originally opened file. Otherwise it returns 0.
+*/
+{
+ int iscopy;
+
+ if (!strncmp(urltype, "mem", 3) )
+ iscopy = 1; /* file copy is in memory */
+ else if (!strncmp(urltype, "compress", 8) )
+ iscopy = 1; /* compressed diskfile that is uncompressed in memory */
+ else if (!strncmp(urltype, "http", 4) )
+ iscopy = 1; /* copied file using http protocol */
+ else if (!strncmp(urltype, "ftp", 3) )
+ iscopy = 1; /* copied file using ftp protocol */
+ else if (!strncmp(urltype, "gsiftp", 6) )
+ iscopy = 1; /* copied file using gsiftp protocol */
+ else if (!strncpy(urltype, "stdin", 5) )
+ iscopy = 1; /* piped stdin has been copied to memory */
+ else
+ iscopy = 0; /* file is not known to be a copy */
+
+ return(iscopy);
+}
+/*--------------------------------------------------------------------------*/
+int ffedit_columns(
+ fitsfile **fptr, /* IO - pointer to input table; on output it */
+ /* points to the new selected rows table */
+ char *outfile, /* I - name for output file */
+ char *expr, /* I - column edit expression */
+ int *status)
+/*
+ modify columns in a table and/or header keywords in the HDU
+*/
+{
+ fitsfile *newptr;
+ int ii, hdunum, slen, colnum = -1, testnum, deletecol = 0, savecol = 0;
+ int numcols = 0, *colindex = 0, tstatus = 0;
+ char *cptr, *cptr2, *cptr3, clause[FLEN_FILENAME], keyname[FLEN_KEYWORD];
+ char colname[FLEN_VALUE], oldname[FLEN_VALUE], colformat[FLEN_VALUE];
+ char *file_expr = NULL, testname[FLEN_VALUE], card[FLEN_CARD];
+
+ if (*outfile)
+ {
+ /* create new empty file in to hold the selected rows */
+ if (ffinit(&newptr, outfile, status) > 0)
+ {
+ ffpmsg("failed to create file for copy (ffedit_columns)");
+ return(*status);
+ }
+
+ fits_get_hdu_num(*fptr, &hdunum); /* current HDU number in input file */
+
+ /* copy all HDUs to the output copy, if the 'only_one' flag is not set */
+ if (!((*fptr)->Fptr)->only_one) {
+ for (ii = 1; 1; ii++)
+ {
+ if (fits_movabs_hdu(*fptr, ii, NULL, status) > 0)
+ break;
+
+ fits_copy_hdu(*fptr, newptr, 0, status);
+ }
+
+ if (*status == END_OF_FILE)
+ {
+ *status = 0; /* got the expected EOF error; reset = 0 */
+ }
+ else if (*status > 0)
+ {
+ ffclos(newptr, status);
+ ffpmsg("failed to copy all HDUs from input file (ffedit_columns)");
+ return(*status);
+ }
+
+
+ } else {
+ /* only copy the primary array and the designated table extension */
+ fits_movabs_hdu(*fptr, 1, NULL, status);
+ fits_copy_hdu(*fptr, newptr, 0, status);
+ fits_movabs_hdu(*fptr, hdunum, NULL, status);
+ fits_copy_hdu(*fptr, newptr, 0, status);
+ if (*status > 0)
+ {
+ ffclos(newptr, status);
+ ffpmsg("failed to copy all HDUs from input file (ffedit_columns)");
+ return(*status);
+ }
+ hdunum = 2;
+ }
+
+ /* close the original file and return ptr to the new image */
+ ffclos(*fptr, status);
+
+ *fptr = newptr; /* reset the pointer to the new table */
+
+ /* move back to the selected table HDU */
+ if (fits_movabs_hdu(*fptr, hdunum, NULL, status) > 0)
+ {
+ ffpmsg("failed to copy the input file (ffedit_columns)");
+ return(*status);
+ }
+ }
+
+ /* remove the "col " from the beginning of the column edit expression */
+ cptr = expr + 4;
+
+ while (*cptr == ' ')
+ cptr++; /* skip leading white space */
+
+ /* Check if need to import expression from a file */
+
+ if( *cptr=='@' ) {
+ if( ffimport_file( cptr+1, &file_expr, status ) ) return(*status);
+ cptr = file_expr;
+ while (*cptr == ' ')
+ cptr++; /* skip leading white space... again */
+ }
+
+ tstatus = 0;
+ ffgncl(*fptr, &numcols, &tstatus); /* get initial # of cols */
+
+ /* parse expression and get first clause, if more than 1 */
+
+ while ((slen = fits_get_token(&cptr, ";", clause, NULL)) > 0 )
+ {
+ if( *cptr==';' ) cptr++;
+ clause[slen] = '\0';
+
+ if (clause[0] == '!' || clause[0] == '-')
+ {
+ /* ===================================== */
+ /* Case I. delete this column or keyword */
+ /* ===================================== */
+
+ if (ffgcno(*fptr, CASEINSEN, &clause[1], &colnum, status) <= 0)
+ {
+ /* a column with this name exists, so try to delete it */
+ if (ffdcol(*fptr, colnum, status) > 0)
+ {
+ ffpmsg("failed to delete column in input file:");
+ ffpmsg(clause);
+ if( colindex ) free( colindex );
+ if( file_expr ) free( file_expr );
+ return(*status);
+ }
+ deletecol = 1; /* set flag that at least one col was deleted */
+ numcols--;
+ colnum = -1;
+ }
+ else
+ {
+ ffcmsg(); /* clear previous error message from ffgcno */
+ /* try deleting a keyword with this name */
+ *status = 0;
+ if (ffdkey(*fptr, &clause[1], status) > 0)
+ {
+ ffpmsg("column or keyword to be deleted does not exist:");
+ ffpmsg(clause);
+ if( colindex ) free( colindex );
+ if( file_expr ) free( file_expr );
+ return(*status);
+ }
+ }
+ }
+ else
+ {
+ /* ===================================================== */
+ /* Case II:
+ this is either a column name, (case 1)
+
+ or a new column name followed by double = ("==") followed
+ by the old name which is to be renamed. (case 2A)
+
+ or a column or keyword name followed by a single "=" and a
+ calculation expression (case 2B) */
+ /* ===================================================== */
+ cptr2 = clause;
+ slen = fits_get_token(&cptr2, "( =", colname, NULL);
+
+
+ if (slen == 0)
+ {
+ ffpmsg("error: column or keyword name is blank:");
+ ffpmsg(clause);
+ if( colindex ) free( colindex );
+ if( file_expr ) free( file_expr );
+ return(*status= URL_PARSE_ERROR);
+ }
+
+ /* If this is a keyword of the form
+ #KEYWORD#
+ then transform to the form
+ #KEYWORDn
+ where n is the previously used column number
+ */
+ if (colname[0] == '#' &&
+ strstr(colname+1, "#") == (colname + strlen(colname) - 1))
+ {
+ if (colnum <= 0)
+ {
+ ffpmsg("The keyword name:");
+ ffpmsg(colname);
+ ffpmsg("is invalid unless a column has been previously");
+ ffpmsg("created or editted by a calculator command");
+ return(*status = URL_PARSE_ERROR);
+ }
+ colname[strlen(colname)-1] = '\0';
+ /* Make keyword name and put it in oldname */
+ ffkeyn(colname+1, colnum, oldname, status);
+ if (*status) return (*status);
+ /* Re-copy back into colname */
+ strcpy(colname+1,oldname);
+ }
+ else if (strstr(colname, "#") == (colname + strlen(colname) - 1))
+ {
+ /* colname is of the form "NAME#"; if
+ a) colnum is defined, and
+ b) a column with literal name "NAME#" does not exist, and
+ c) a keyword with name "NAMEn" (where n=colnum) exists, then
+ transfrom the colname string to "NAMEn", otherwise
+ do nothing.
+ */
+ if (colnum > 0) { /* colnum must be defined */
+ tstatus = 0;
+ ffgcno(*fptr, CASEINSEN, colname, &testnum, &tstatus);
+ if (tstatus != 0 && tstatus != COL_NOT_UNIQUE)
+ {
+ /* OK, column doesn't exist, now see if keyword exists */
+ ffcmsg(); /* clear previous error message from ffgcno */
+ strcpy(testname, colname);
+ testname[strlen(testname)-1] = '\0';
+ /* Make keyword name and put it in oldname */
+ ffkeyn(testname, colnum, oldname, status);
+ if (*status) return (*status);
+
+ tstatus = 0;
+ if (!fits_read_card(*fptr, oldname, card, &tstatus)) {
+ /* Keyword does exist; copy real name back into colname */
+ strcpy(colname,oldname);
+ }
+ }
+ }
+ }
+
+ /* if we encountered an opening parenthesis, then we need to */
+ /* find the closing parenthesis, and concatinate the 2 strings */
+ /* This supports expressions like:
+ [col #EXTNAME(Extension name)="GTI"]
+ */
+ if (*cptr2 == '(')
+ {
+ fits_get_token(&cptr2, ")", oldname, NULL);
+ strcat(colname, oldname);
+ strcat(colname, ")");
+ cptr2++;
+ }
+
+ while (*cptr2 == ' ')
+ cptr2++; /* skip white space */
+
+ if (*cptr2 != '=')
+ {
+ /* ------------------------------------ */
+ /* case 1 - simply the name of a column */
+ /* ------------------------------------ */
+
+ /* look for matching column */
+ ffgcno(*fptr, CASEINSEN, colname, &testnum, status);
+
+ while (*status == COL_NOT_UNIQUE)
+ {
+ /* the column name contained wild cards, and it */
+ /* matches more than one column in the table. */
+
+ colnum = testnum;
+
+ /* keep this column in the output file */
+ savecol = 1;
+
+ if (!colindex)
+ colindex = (int *) calloc(999, sizeof(int));
+
+ colindex[colnum - 1] = 1; /* flag this column number */
+
+ /* look for other matching column names */
+ ffgcno(*fptr, CASEINSEN, colname, &testnum, status);
+
+ if (*status == COL_NOT_FOUND)
+ *status = 999; /* temporary status flag value */
+ }
+
+ if (*status <= 0)
+ {
+ colnum = testnum;
+
+ /* keep this column in the output file */
+ savecol = 1;
+
+ if (!colindex)
+ colindex = (int *) calloc(999, sizeof(int));
+
+ colindex[colnum - 1] = 1; /* flag this column number */
+ }
+ else if (*status == 999)
+ {
+ /* this special flag value does not represent an error */
+ *status = 0;
+ }
+ else
+ {
+ ffpmsg("Syntax error in columns specifier in input URL:");
+ ffpmsg(cptr2);
+ if( colindex ) free( colindex );
+ if( file_expr ) free( file_expr );
+ return(*status = URL_PARSE_ERROR);
+ }
+ }
+ else
+ {
+ /* ----------------------------------------------- */
+ /* case 2 where the token ends with an equals sign */
+ /* ----------------------------------------------- */
+
+ cptr2++; /* skip over the first '=' */
+
+ if (*cptr2 == '=')
+ {
+ /*................................................. */
+ /* Case A: rename a column or keyword; syntax is
+ "new_name == old_name" */
+ /*................................................. */
+
+ cptr2++; /* skip the 2nd '=' */
+ while (*cptr2 == ' ')
+ cptr2++; /* skip white space */
+
+ fits_get_token(&cptr2, " ", oldname, NULL);
+
+ /* get column number of the existing column */
+ if (ffgcno(*fptr, CASEINSEN, oldname, &colnum, status) <= 0)
+ {
+ /* modify the TTYPEn keyword value with the new name */
+ ffkeyn("TTYPE", colnum, keyname, status);
+
+ if (ffmkys(*fptr, keyname, colname, NULL, status) > 0)
+ {
+ ffpmsg("failed to rename column in input file");
+ ffpmsg(" oldname =");
+ ffpmsg(oldname);
+ ffpmsg(" newname =");
+ ffpmsg(colname);
+ if( colindex ) free( colindex );
+ if( file_expr ) free( file_expr );
+ return(*status);
+ }
+ /* keep this column in the output file */
+ savecol = 1;
+ if (!colindex)
+ colindex = (int *) calloc(999, sizeof(int));
+
+ colindex[colnum - 1] = 1; /* flag this column number */
+ }
+ else
+ {
+ /* try renaming a keyword */
+ ffcmsg(); /* clear error message stack */
+ *status = 0;
+ if (ffmnam(*fptr, oldname, colname, status) > 0)
+ {
+ ffpmsg("column or keyword to be renamed does not exist:");
+ ffpmsg(clause);
+ if( colindex ) free( colindex );
+ if( file_expr ) free( file_expr );
+ return(*status);
+ }
+ }
+ }
+ else
+ {
+ /*...................................................... */
+ /* Case B: */
+ /* this must be a general column/keyword calc expression */
+ /* "name = expression" or "colname(TFORM) = expression" */
+ /*...................................................... */
+
+ /* parse the name and TFORM values, if present */
+ colformat[0] = '\0';
+ cptr3 = colname;
+
+ fits_get_token(&cptr3, "(", oldname, NULL);
+
+ if (cptr3[0] == '(' )
+ {
+ cptr3++; /* skip the '(' */
+ fits_get_token(&cptr3, ")", colformat, NULL);
+ }
+
+ /* calculate values for the column or keyword */
+ /* cptr2 = the expression to be calculated */
+ /* oldname = name of the column or keyword */
+ /* colformat = column format, or keyword comment string */
+ if (fits_calculator(*fptr, cptr2, *fptr, oldname, colformat,
+ status) > 0) {
+
+ ffpmsg("Unable to calculate expression");
+ return(*status);
+ }
+
+ /* test if this is a column and not a keyword */
+ tstatus = 0;
+ ffgcno(*fptr, CASEINSEN, oldname, &testnum, &tstatus);
+ if (tstatus == 0)
+ {
+ /* keep this column in the output file */
+ colnum = testnum;
+ savecol = 1;
+
+ if (!colindex)
+ colindex = (int *) calloc(999, sizeof(int));
+
+ colindex[colnum - 1] = 1;
+ if (colnum > numcols)numcols++;
+ }
+ else
+ {
+ ffcmsg(); /* clear the error message stack */
+ }
+ }
+ }
+ }
+ }
+
+ if (savecol && !deletecol)
+ {
+ /* need to delete all but the specified columns */
+ for (ii = numcols; ii > 0; ii--)
+ {
+ if (!colindex[ii-1]) /* delete this column */
+ {
+ if (ffdcol(*fptr, ii, status) > 0)
+ {
+ ffpmsg("failed to delete column in input file:");
+ ffpmsg(clause);
+ if( colindex ) free( colindex );
+ if( file_expr ) free( file_expr );
+ return(*status);
+ }
+ }
+ }
+ }
+
+ if( colindex ) free( colindex );
+ if( file_expr ) free( file_expr );
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_copy_cell2image(
+ fitsfile *fptr, /* I - point to input table */
+ fitsfile *newptr, /* O - existing output file; new image HDU
+ will be appended to it */
+ char *colname, /* I - column name / number containing the image*/
+ long rownum, /* I - number of the row containing the image */
+ int *status) /* IO - error status */
+
+/*
+ Copy a table cell of a given row and column into an image extension.
+ The output file must already have been created. A new image
+ extension will be created in that file.
+
+ This routine was written by Craig Markwardt, GSFC
+*/
+
+{
+ unsigned char buffer[30000];
+ int hdutype, colnum, typecode, bitpix, naxis, maxelem, tstatus;
+ LONGLONG naxes[9], nbytes, firstbyte, ntodo;
+ LONGLONG repeat, startpos, elemnum, rowlen, tnull;
+ long twidth, incre;
+ double scale, zero;
+ char tform[20];
+ char card[FLEN_CARD];
+ char templt[FLEN_CARD] = "";
+
+ /* Table-to-image keyword translation table */
+ /* INPUT OUTPUT */
+ /* 01234567 01234567 */
+ char *patterns[][2] = {{"TSCALn", "BSCALE" }, /* Standard FITS keywords */
+ {"TZEROn", "BZERO" },
+ {"TUNITn", "BUNIT" },
+ {"TNULLn", "BLANK" },
+ {"TDMINn", "DATAMIN" },
+ {"TDMAXn", "DATAMAX" },
+ {"iCTYPn", "CTYPEi" }, /* Coordinate labels */
+ {"iCTYna", "CTYPEia" },
+ {"iCUNIn", "CUNITi" }, /* Coordinate units */
+ {"iCUNna", "CUNITia" },
+ {"iCRVLn", "CRVALi" }, /* WCS keywords */
+ {"iCRVna", "CRVALia" },
+ {"iCDLTn", "CDELTi" },
+ {"iCDEna", "CDELTia" },
+ {"iCRPXn", "CRPIXi" },
+ {"iCRPna", "CRPIXia" },
+ {"ijPCna", "PCi_ja" },
+ {"ijCDna", "CDi_ja" },
+ {"iVn_ma", "PVi_ma" },
+ {"iSn_ma", "PSi_ma" },
+ {"iCRDna", "CRDERia" },
+ {"iCSYna", "CSYERia" },
+ {"iCROTn", "CROTAi" },
+ {"WCAXna", "WCSAXESa"},
+ {"WCSNna", "WCSNAMEa"},
+
+ {"LONPna", "LONPOLEa"},
+ {"LATPna", "LATPOLEa"},
+ {"EQUIna", "EQUINOXa"},
+ {"MJDOBn", "MJD-OBS" },
+ {"MJDAn", "MJD-AVG" },
+ {"RADEna", "RADESYSa"},
+ {"iCNAna", "CNAMEia" },
+ {"DAVGn", "DATE-AVG"},
+
+ /* Delete table keywords related to other columns */
+ {"T????#a", "-" },
+ {"TC??#a", "-" },
+ {"TWCS#a", "-" },
+ {"TDIM#", "-" },
+ {"iCTYPm", "-" },
+ {"iCUNIm", "-" },
+ {"iCRVLm", "-" },
+ {"iCDLTm", "-" },
+ {"iCRPXm", "-" },
+ {"iCTYma", "-" },
+ {"iCUNma", "-" },
+ {"iCRVma", "-" },
+ {"iCDEma", "-" },
+ {"iCRPma", "-" },
+ {"ijPCma", "-" },
+ {"ijCDma", "-" },
+ {"iVm_ma", "-" },
+ {"iSm_ma", "-" },
+ {"iCRDma", "-" },
+ {"iCSYma", "-" },
+ {"iCROTm", "-" },
+ {"WCAXma", "-" },
+ {"WCSNma", "-" },
+
+ {"LONPma", "-" },
+ {"LATPma", "-" },
+ {"EQUIma", "-" },
+ {"MJDOBm", "-" },
+ {"MJDAm", "-" },
+ {"RADEma", "-" },
+ {"iCNAma", "-" },
+ {"DAVGm", "-" },
+
+ {"EXTNAME", "-" }, /* Remove structural keywords*/
+ {"EXTVER", "-" },
+ {"EXTLEVEL","-" },
+ {"CHECKSUM","-" },
+ {"DATASUM", "-" },
+
+ {"*", "+" }}; /* copy all other keywords */
+ int npat;
+
+ if (*status > 0)
+ return(*status);
+
+ /* get column number */
+ if (ffgcno(fptr, CASEINSEN, colname, &colnum, status) > 0)
+ {
+ ffpmsg("column containing image in table cell does not exist:");
+ ffpmsg(colname);
+ return(*status);
+ }
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if ( ffgcprll(fptr, colnum, rownum, 1L, 1L, 0, &scale, &zero,
+ tform, &twidth, &typecode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, (char *) buffer, status) > 0 )
+ return(*status);
+
+ /* get the actual column name, in case a column number was given */
+ ffkeyn("", colnum, templt, &tstatus);
+ ffgcnn(fptr, CASEINSEN, templt, colname, &colnum, &tstatus);
+
+ if (hdutype != BINARY_TBL)
+ {
+ ffpmsg("This extension is not a binary table.");
+ ffpmsg(" Cannot open the image in a binary table cell.");
+ return(*status = NOT_BTABLE);
+ }
+
+ if (typecode < 0)
+ {
+ /* variable length array */
+ typecode *= -1;
+
+ /* variable length arrays are 1-dimensional by default */
+ naxis = 1;
+ naxes[0] = repeat;
+ }
+ else
+ {
+ /* get the dimensions of the image */
+ ffgtdmll(fptr, colnum, 9, &naxis, naxes, status);
+ }
+
+ if (*status > 0)
+ {
+ ffpmsg("Error getting the dimensions of the image");
+ return(*status);
+ }
+
+ /* determine BITPIX value for the image */
+ if (typecode == TBYTE)
+ {
+ bitpix = BYTE_IMG;
+ nbytes = repeat;
+ }
+ else if (typecode == TSHORT)
+ {
+ bitpix = SHORT_IMG;
+ nbytes = repeat * 2;
+ }
+ else if (typecode == TLONG)
+ {
+ bitpix = LONG_IMG;
+ nbytes = repeat * 4;
+ }
+ else if (typecode == TFLOAT)
+ {
+ bitpix = FLOAT_IMG;
+ nbytes = repeat * 4;
+ }
+ else if (typecode == TDOUBLE)
+ {
+ bitpix = DOUBLE_IMG;
+ nbytes = repeat * 8;
+ }
+ else if (typecode == TLONGLONG)
+ {
+ bitpix = LONGLONG_IMG;
+ nbytes = repeat * 8;
+ }
+ else if (typecode == TLOGICAL)
+ {
+ bitpix = BYTE_IMG;
+ nbytes = repeat;
+ }
+ else
+ {
+ ffpmsg("Error: the following image column has invalid datatype:");
+ ffpmsg(colname);
+ ffpmsg(tform);
+ ffpmsg("Cannot open an image in a single row of this column.");
+ return(*status = BAD_TFORM);
+ }
+
+ /* create new image in output file */
+ if (ffcrimll(newptr, bitpix, naxis, naxes, status) > 0)
+ {
+ ffpmsg("failed to write required primary array keywords in the output file");
+ return(*status);
+ }
+
+ npat = sizeof(patterns)/sizeof(patterns[0][0])/2;
+
+ /* skip over the first 8 keywords, starting just after TFIELDS */
+ fits_translate_keywords(fptr, newptr, 9, patterns, npat,
+ colnum, 0, 0, status);
+
+ /* add some HISTORY */
+ sprintf(card,"HISTORY This image was copied from row %ld of column '%s',",
+ rownum, colname);
+/* disable this; leave it up to the caller to write history if needed.
+ ffprec(newptr, card, status);
+*/
+ /* the use of ffread routine, below, requires that any 'dirty' */
+ /* buffers in memory be flushed back to the file first */
+
+ ffflsh(fptr, FALSE, status);
+
+ /* finally, copy the data, one buffer size at a time */
+ ffmbyt(fptr, startpos, TRUE, status);
+ firstbyte = 1;
+
+ /* the upper limit on the number of bytes must match the declaration */
+ /* read up to the first 30000 bytes in the normal way with ffgbyt */
+
+ ntodo = minvalue(30000, nbytes);
+ ffgbyt(fptr, ntodo, buffer, status);
+ ffptbb(newptr, 1, firstbyte, ntodo, buffer, status);
+
+ nbytes -= ntodo;
+ firstbyte += ntodo;
+
+ /* read any additional bytes with low-level ffread routine, for speed */
+ while (nbytes && (*status <= 0) )
+ {
+ ntodo = minvalue(30000, nbytes);
+ ffread((fptr)->Fptr, (long) ntodo, buffer, status);
+ ffptbb(newptr, 1, firstbyte, ntodo, buffer, status);
+ nbytes -= ntodo;
+ firstbyte += ntodo;
+ }
+
+ /* Re-scan the header so that CFITSIO knows about all the new keywords */
+ ffrdef(newptr,status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_copy_image2cell(
+ fitsfile *fptr, /* I - pointer to input image extension */
+ fitsfile *newptr, /* I - pointer to output table */
+ char *colname, /* I - name of column containing the image */
+ long rownum, /* I - number of the row containing the image */
+ int copykeyflag, /* I - controls which keywords to copy */
+ int *status) /* IO - error status */
+
+/*
+ Copy an image extension into a table cell at a given row and
+ column. The table must have already been created. If the "colname"
+ column exists, it will be used, otherwise a new column will be created
+ in the table.
+
+ The "copykeyflag" parameter controls which keywords to copy from the
+ input image to the output table header (with any appropriate translation).
+
+ copykeyflag = 0 -- no keywords will be copied
+ copykeyflag = 1 -- essentially all keywords will be copied
+ copykeyflag = 2 -- copy only the WCS related keywords
+
+ This routine was written by Craig Markwardt, GSFC
+
+*/
+{
+ tcolumn *colptr;
+ unsigned char buffer[30000];
+ int ii, hdutype, colnum, typecode, bitpix, naxis, ncols, hdunum;
+ char tformchar, tform[20], card[FLEN_CARD];
+ LONGLONG imgstart, naxes[9], nbytes, repeat, ntodo,firstbyte;
+ char filename[FLEN_FILENAME+20];
+
+ int npat;
+
+ int naxis1;
+ LONGLONG naxes1[9] = {0,0,0,0,0,0,0,0,0}, repeat1, width1;
+ int typecode1;
+ unsigned char dummy = 0;
+
+ LONGLONG headstart, datastart, dataend;
+
+ /* Image-to-table keyword translation table */
+ /* INPUT OUTPUT */
+ /* 01234567 01234567 */
+ char *patterns[][2] = {{"BSCALE", "TSCALn" }, /* Standard FITS keywords */
+ {"BZERO", "TZEROn" },
+ {"BUNIT", "TUNITn" },
+ {"BLANK", "TNULLn" },
+ {"DATAMIN", "TDMINn" },
+ {"DATAMAX", "TDMAXn" },
+ {"CTYPEi", "iCTYPn" }, /* Coordinate labels */
+ {"CTYPEia", "iCTYna" },
+ {"CUNITi", "iCUNIn" }, /* Coordinate units */
+ {"CUNITia", "iCUNna" },
+ {"CRVALi", "iCRVLn" }, /* WCS keywords */
+ {"CRVALia", "iCRVna" },
+ {"CDELTi", "iCDLTn" },
+ {"CDELTia", "iCDEna" },
+ {"CRPIXj", "jCRPXn" },
+ {"CRPIXja", "jCRPna" },
+ {"PCi_ja", "ijPCna" },
+ {"CDi_ja", "ijCDna" },
+ {"PVi_ma", "iVn_ma" },
+ {"PSi_ma", "iSn_ma" },
+ {"WCSAXESa","WCAXna" },
+ {"WCSNAMEa","WCSNna" },
+ {"CRDERia", "iCRDna" },
+ {"CSYERia", "iCSYna" },
+ {"CROTAi", "iCROTn" },
+
+ {"LONPOLEa","LONPna"},
+ {"LATPOLEa","LATPna"},
+ {"EQUINOXa","EQUIna"},
+ {"MJD-OBS", "MJDOBn" },
+ {"MJD-AVG", "MJDAn" },
+ {"RADESYSa","RADEna"},
+ {"CNAMEia", "iCNAna" },
+ {"DATE-AVG","DAVGn"},
+
+ {"NAXISi", "-" }, /* Remove structural keywords*/
+ {"PCOUNT", "-" },
+ {"GCOUNT", "-" },
+ {"EXTEND", "-" },
+ {"EXTNAME", "-" },
+ {"EXTVER", "-" },
+ {"EXTLEVEL","-" },
+ {"CHECKSUM","-" },
+ {"DATASUM", "-" },
+ {"*", "+" }}; /* copy all other keywords */
+
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr == 0 || newptr == 0) return (*status = NULL_INPUT_PTR);
+
+ if (ffghdt(fptr, &hdutype, status) > 0) {
+ ffpmsg("could not get input HDU type");
+ return (*status);
+ }
+
+ if (hdutype != IMAGE_HDU) {
+ ffpmsg("The input extension is not an image.");
+ ffpmsg(" Cannot open the image.");
+ return(*status = NOT_IMAGE);
+ }
+
+ if (ffghdt(newptr, &hdutype, status) > 0) {
+ ffpmsg("could not get output HDU type");
+ return (*status);
+ }
+
+ if (hdutype != BINARY_TBL) {
+ ffpmsg("The output extension is not a table.");
+ return(*status = NOT_BTABLE);
+ }
+
+
+ if (ffgiprll(fptr, 9, &bitpix, &naxis, naxes, status) > 0) {
+ ffpmsg("Could not read image parameters.");
+ return (*status);
+ }
+
+ /* Determine total number of pixels in the image */
+ repeat = 1;
+ for (ii = 0; ii < naxis; ii++) repeat *= naxes[ii];
+
+ /* Determine the TFORM value for the table cell */
+ if (bitpix == BYTE_IMG) {
+ typecode = TBYTE;
+ tformchar = 'B';
+ nbytes = repeat;
+ } else if (bitpix == SHORT_IMG) {
+ typecode = TSHORT;
+ tformchar = 'I';
+ nbytes = repeat*2;
+ } else if (bitpix == LONG_IMG) {
+ typecode = TLONG;
+ tformchar = 'J';
+ nbytes = repeat*4;
+ } else if (bitpix == FLOAT_IMG) {
+ typecode = TFLOAT;
+ tformchar = 'E';
+ nbytes = repeat*4;
+ } else if (bitpix == DOUBLE_IMG) {
+ typecode = TDOUBLE;
+ tformchar = 'D';
+ nbytes = repeat*8;
+ } else if (bitpix == LONGLONG_IMG) {
+ typecode = TLONGLONG;
+ tformchar = 'K';
+ nbytes = repeat*8;
+ } else {
+ ffpmsg("Error: the image has an invalid datatype.");
+ return (*status = BAD_BITPIX);
+ }
+
+ /* get column number */
+ ffpmrk();
+ ffgcno(newptr, CASEINSEN, colname, &colnum, status);
+ ffcmrk();
+
+ /* Column does not exist; create it */
+ if (*status) {
+
+ *status = 0;
+ sprintf(tform, "%.0f%c", (double) repeat, tformchar);
+ ffgncl(newptr, &ncols, status);
+ colnum = ncols+1;
+ fficol(newptr, colnum, colname, tform, status);
+ ffptdmll(newptr, colnum, naxis, naxes, status);
+
+ if (*status) {
+ ffpmsg("Could not insert new column into output table.");
+ return *status;
+ }
+
+ } else {
+
+ ffgtdmll(newptr, colnum, 9, &naxis1, naxes1, status);
+ if (*status > 0 || naxis != naxis1) {
+ ffpmsg("Input image dimensions and output table cell dimensions do not match.");
+ return (*status = BAD_DIMEN);
+ }
+ for (ii=0; ii<naxis; ii++) if (naxes[ii] != naxes1[ii]) {
+ ffpmsg("Input image dimensions and output table cell dimensions do not match.");
+ return (*status = BAD_DIMEN);
+ }
+
+ ffgtclll(newptr, colnum, &typecode1, &repeat1, &width1, status);
+ if ((*status > 0) || (typecode1 != typecode) || (repeat1 != repeat)) {
+ ffpmsg("Input image data type does not match output table cell type.");
+ return (*status = BAD_TFORM);
+ }
+ }
+
+ /* copy keywords from input image to output table, if required */
+
+ if (copykeyflag) {
+
+ npat = sizeof(patterns)/sizeof(patterns[0][0])/2;
+
+ if (copykeyflag == 2) { /* copy only the WCS-related keywords */
+ patterns[npat-1][1] = "-";
+ }
+
+ /* The 3rd parameter value = 5 means skip the first 4 keywords in the image */
+ fits_translate_keywords(fptr, newptr, 5, patterns, npat,
+ colnum, 0, 0, status);
+ }
+
+ /* Here is all the code to compute offsets:
+ * * byte offset from start of row to column (dest table)
+ * * byte offset from start of file to image data (source image)
+ */
+
+ /* Force the writing of the row of the table by writing the last byte of
+ the array, which grows the table, and/or shifts following extensions */
+ ffpcl(newptr, TBYTE, colnum, rownum, repeat, 1, &dummy, status);
+
+ /* byte offset within the row to the start of the image column */
+ colptr = (newptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+ firstbyte = colptr->tbcol + 1;
+
+ /* get starting address of input image to be read */
+ ffghadll(fptr, &headstart, &datastart, &dataend, status);
+ imgstart = datastart;
+
+ sprintf(card, "HISTORY Table column '%s' row %ld copied from image",
+ colname, rownum);
+/*
+ Don't automatically write History keywords; leave this up to the caller.
+ ffprec(newptr, card, status);
+*/
+
+ /* write HISTORY keyword with the file name (this is now disabled)*/
+
+ filename[0] = '\0'; hdunum = 0;
+ strcpy(filename, "HISTORY ");
+ ffflnm(fptr, filename+strlen(filename), status);
+ ffghdn(fptr, &hdunum);
+ sprintf(filename+strlen(filename),"[%d]", hdunum-1);
+/*
+ ffprec(newptr, filename, status);
+*/
+
+ /* the use of ffread routine, below, requires that any 'dirty' */
+ /* buffers in memory be flushed back to the file first */
+
+ ffflsh(fptr, FALSE, status);
+
+ /* move to the first byte of the input image */
+ ffmbyt(fptr, imgstart, TRUE, status);
+
+ ntodo = minvalue(30000L, nbytes);
+ ffgbyt(fptr, ntodo, buffer, status); /* read input image */
+ ffptbb(newptr, rownum, firstbyte, ntodo, buffer, status); /* write to table */
+
+ nbytes -= ntodo;
+ firstbyte += ntodo;
+
+
+ /* read any additional bytes with low-level ffread routine, for speed */
+ while (nbytes && (*status <= 0) )
+ {
+ ntodo = minvalue(30000L, nbytes);
+ ffread(fptr->Fptr, (long) ntodo, buffer, status);
+ ffptbb(newptr, rownum, firstbyte, ntodo, buffer, status);
+ nbytes -= ntodo;
+ firstbyte += ntodo;
+ }
+
+ /* Re-scan the header so that CFITSIO knows about all the new keywords */
+ ffrdef(newptr,status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_select_image_section(
+ fitsfile **fptr, /* IO - pointer to input image; on output it */
+ /* points to the new subimage */
+ char *outfile, /* I - name for output file */
+ char *expr, /* I - Image section expression */
+ int *status)
+{
+ /*
+ copies an image section from the input file to a new output file.
+ Any HDUs preceding or following the image are also copied to the
+ output file.
+ */
+
+ fitsfile *newptr;
+ int ii, hdunum;
+
+ /* create new empty file to hold the image section */
+ if (ffinit(&newptr, outfile, status) > 0)
+ {
+ ffpmsg(
+ "failed to create output file for image section:");
+ ffpmsg(outfile);
+ return(*status);
+ }
+
+ fits_get_hdu_num(*fptr, &hdunum); /* current HDU number in input file */
+
+ /* copy all preceding extensions to the output file, if 'only_one' flag not set */
+ if (!(((*fptr)->Fptr)->only_one)) {
+ for (ii = 1; ii < hdunum; ii++)
+ {
+ fits_movabs_hdu(*fptr, ii, NULL, status);
+ if (fits_copy_hdu(*fptr, newptr, 0, status) > 0)
+ {
+ ffclos(newptr, status);
+ return(*status);
+ }
+ }
+
+ /* move back to the original HDU position */
+ fits_movabs_hdu(*fptr, hdunum, NULL, status);
+ }
+
+ if (fits_copy_image_section(*fptr, newptr, expr, status) > 0)
+ {
+ ffclos(newptr, status);
+ return(*status);
+ }
+
+ /* copy any remaining HDUs to the output file, if 'only_one' flag not set */
+
+ if (!(((*fptr)->Fptr)->only_one)) {
+ for (ii = hdunum + 1; 1; ii++)
+ {
+ if (fits_movabs_hdu(*fptr, ii, NULL, status) > 0)
+ break;
+
+ fits_copy_hdu(*fptr, newptr, 0, status);
+ }
+
+ if (*status == END_OF_FILE)
+ *status = 0; /* got the expected EOF error; reset = 0 */
+ else if (*status > 0)
+ {
+ ffclos(newptr, status);
+ return(*status);
+ }
+ } else {
+ ii = hdunum + 1; /* this value of ii is required below */
+ }
+
+ /* close the original file and return ptr to the new image */
+ ffclos(*fptr, status);
+
+ *fptr = newptr; /* reset the pointer to the new table */
+
+ /* move back to the image subsection */
+ if (ii - 1 != hdunum)
+ fits_movabs_hdu(*fptr, hdunum, NULL, status);
+ else
+ {
+ /* may have to reset BSCALE and BZERO pixel scaling, */
+ /* since the keywords were previously turned off */
+
+ if (ffrdef(*fptr, status) > 0)
+ {
+ ffclos(*fptr, status);
+ return(*status);
+ }
+
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_copy_image_section(
+ fitsfile *fptr, /* I - pointer to input image */
+ fitsfile *newptr, /* I - pointer to output image */
+ char *expr, /* I - Image section expression */
+ int *status)
+{
+ /*
+ copies an image section from the input file to a new output HDU
+ */
+
+ int bitpix, naxis, numkeys, nkey;
+ long naxes[] = {1,1,1,1,1,1,1,1,1}, smin, smax, sinc;
+ long fpixels[] = {1,1,1,1,1,1,1,1,1};
+ long lpixels[] = {1,1,1,1,1,1,1,1,1};
+ long incs[] = {1,1,1,1,1,1,1,1,1};
+ char *cptr, keyname[FLEN_KEYWORD], card[FLEN_CARD];
+ int ii, tstatus, anynull;
+ long minrow, maxrow, minslice, maxslice, mincube, maxcube;
+ long firstpix;
+ long ncubeiter, nsliceiter, nrowiter, kiter, jiter, iiter;
+ int klen, kk, jj;
+ long outnaxes[9], outsize, buffsize;
+ double *buffer, crpix, cdelt;
+
+ if (*status > 0)
+ return(*status);
+
+ /* get the size of the input image */
+ fits_get_img_type(fptr, &bitpix, status);
+ fits_get_img_dim(fptr, &naxis, status);
+ if (fits_get_img_size(fptr, naxis, naxes, status) > 0)
+ return(*status);
+
+ if (naxis < 1 || naxis > 4)
+ {
+ ffpmsg(
+ "Input image either had NAXIS = 0 (NULL image) or has > 4 dimensions");
+ return(*status = BAD_NAXIS);
+ }
+
+ /* create output image with same size and type as the input image */
+ /* Will update the size later */
+ fits_create_img(newptr, bitpix, naxis, naxes, status);
+
+ /* copy all other non-structural keywords from the input to output file */
+ fits_get_hdrspace(fptr, &numkeys, NULL, status);
+
+ for (nkey = 4; nkey <= numkeys; nkey++) /* skip the first few keywords */
+ {
+ fits_read_record(fptr, nkey, card, status);
+
+ if (fits_get_keyclass(card) > TYP_CMPRS_KEY)
+ {
+ /* write the record to the output file */
+ fits_write_record(newptr, card, status);
+ }
+ }
+
+ if (*status > 0)
+ {
+ ffpmsg("error copying header from input image to output image");
+ return(*status);
+ }
+
+ /* parse the section specifier to get min, max, and inc for each axis */
+ /* and the size of each output image axis */
+
+ cptr = expr;
+ for (ii=0; ii < naxis; ii++)
+ {
+ if (fits_get_section_range(&cptr, &smin, &smax, &sinc, status) > 0)
+ {
+ ffpmsg("error parsing the following image section specifier:");
+ ffpmsg(expr);
+ return(*status);
+ }
+
+ if (smax == 0)
+ smax = naxes[ii]; /* use whole axis by default */
+ else if (smin == 0)
+ smin = naxes[ii]; /* use inverted whole axis */
+
+ if (smin > naxes[ii] || smax > naxes[ii])
+ {
+ ffpmsg("image section exceeds dimensions of input image:");
+ ffpmsg(expr);
+ return(*status = BAD_NAXIS);
+ }
+
+ fpixels[ii] = smin;
+ lpixels[ii] = smax;
+ incs[ii] = sinc;
+
+ if (smin <= smax)
+ outnaxes[ii] = (smax - smin + sinc) / sinc;
+ else
+ outnaxes[ii] = (smin - smax + sinc) / sinc;
+
+ /* modify the NAXISn keyword */
+ fits_make_keyn("NAXIS", ii + 1, keyname, status);
+ fits_modify_key_lng(newptr, keyname, outnaxes[ii], NULL, status);
+
+ /* modify the WCS keywords if necessary */
+
+ if (fpixels[ii] != 1 || incs[ii] != 1)
+ {
+ for (kk=-1;kk<26; kk++) /* modify any alternate WCS keywords */
+ {
+ /* read the CRPIXn keyword if it exists in the input file */
+ fits_make_keyn("CRPIX", ii + 1, keyname, status);
+
+ if (kk != -1) {
+ klen = strlen(keyname);
+ keyname[klen]='A' + kk;
+ keyname[klen + 1] = '\0';
+ }
+
+ tstatus = 0;
+ if (fits_read_key(fptr, TDOUBLE, keyname,
+ &crpix, NULL, &tstatus) == 0)
+ {
+ /* calculate the new CRPIXn value */
+ if (fpixels[ii] <= lpixels[ii]) {
+ crpix = (crpix - (fpixels[ii])) / incs[ii] + 1.0;
+ /* crpix = (crpix - (fpixels[ii] - 1.0) - .5) / incs[ii] + 0.5; */
+ } else {
+ crpix = (fpixels[ii] - crpix) / incs[ii] + 1.0;
+ /* crpix = (fpixels[ii] - (crpix - 1.0) - .5) / incs[ii] + 0.5; */
+ }
+
+ /* modify the value in the output file */
+ fits_modify_key_dbl(newptr, keyname, crpix, 15, NULL, status);
+
+ if (incs[ii] != 1 || fpixels[ii] > lpixels[ii])
+ {
+ /* read the CDELTn keyword if it exists in the input file */
+ fits_make_keyn("CDELT", ii + 1, keyname, status);
+
+ if (kk != -1) {
+ klen = strlen(keyname);
+ keyname[klen]='A' + kk;
+ keyname[klen + 1] = '\0';
+ }
+
+ tstatus = 0;
+ if (fits_read_key(fptr, TDOUBLE, keyname,
+ &cdelt, NULL, &tstatus) == 0)
+ {
+ /* calculate the new CDELTn value */
+ if (fpixels[ii] <= lpixels[ii])
+ cdelt = cdelt * incs[ii];
+ else
+ cdelt = cdelt * (-incs[ii]);
+
+ /* modify the value in the output file */
+ fits_modify_key_dbl(newptr, keyname, cdelt, 15, NULL, status);
+ }
+
+ /* modify the CDi_j keywords if they exist in the input file */
+
+ fits_make_keyn("CD1_", ii + 1, keyname, status);
+
+ if (kk != -1) {
+ klen = strlen(keyname);
+ keyname[klen]='A' + kk;
+ keyname[klen + 1] = '\0';
+ }
+
+ for (jj=0; jj < 9; jj++) /* look for up to 9 dimensions */
+ {
+ keyname[2] = '1' + jj;
+
+ tstatus = 0;
+ if (fits_read_key(fptr, TDOUBLE, keyname,
+ &cdelt, NULL, &tstatus) == 0)
+ {
+ /* calculate the new CDi_j value */
+ if (fpixels[ii] <= lpixels[ii])
+ cdelt = cdelt * incs[ii];
+ else
+ cdelt = cdelt * (-incs[ii]);
+
+ /* modify the value in the output file */
+ fits_modify_key_dbl(newptr, keyname, cdelt, 15, NULL, status);
+ }
+ }
+
+ } /* end of if (incs[ii]... loop */
+ } /* end of fits_read_key loop */
+ } /* end of for (kk loop */
+ }
+ } /* end of main NAXIS loop */
+
+ if (ffrdef(newptr, status) > 0) /* force the header to be scanned */
+ {
+ return(*status);
+ }
+
+ /* turn off any scaling of the pixel values */
+ fits_set_bscale(fptr, 1.0, 0.0, status);
+ fits_set_bscale(newptr, 1.0, 0.0, status);
+
+ /* to reduce memory foot print, just read/write image 1 row at a time */
+
+ outsize = outnaxes[0];
+ buffsize = (abs(bitpix) / 8) * outsize;
+
+ buffer = (double *) malloc(buffsize); /* allocate memory for the image row */
+ if (!buffer)
+ {
+ ffpmsg("fits_copy_image_section: no memory for image section");
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* read the image section then write it to the output file */
+
+ minrow = fpixels[1];
+ maxrow = lpixels[1];
+ if (minrow > maxrow) {
+ nrowiter = (minrow - maxrow + incs[1]) / incs[1];
+ } else {
+ nrowiter = (maxrow - minrow + incs[1]) / incs[1];
+ }
+
+ minslice = fpixels[2];
+ maxslice = lpixels[2];
+ if (minslice > maxslice) {
+ nsliceiter = (minslice - maxslice + incs[2]) / incs[2];
+ } else {
+ nsliceiter = (maxslice - minslice + incs[2]) / incs[2];
+ }
+
+ mincube = fpixels[3];
+ maxcube = lpixels[3];
+ if (mincube > maxcube) {
+ ncubeiter = (mincube - maxcube + incs[3]) / incs[3];
+ } else {
+ ncubeiter = (maxcube - mincube + incs[3]) / incs[3];
+ }
+
+ firstpix = 1;
+ for (kiter = 0; kiter < ncubeiter; kiter++)
+ {
+ if (mincube > maxcube) {
+ fpixels[3] = mincube - (kiter * incs[3]);
+ } else {
+ fpixels[3] = mincube + (kiter * incs[3]);
+ }
+
+ lpixels[3] = fpixels[3];
+
+ for (jiter = 0; jiter < nsliceiter; jiter++)
+ {
+ if (minslice > maxslice) {
+ fpixels[2] = minslice - (jiter * incs[2]);
+ } else {
+ fpixels[2] = minslice + (jiter * incs[2]);
+ }
+
+ lpixels[2] = fpixels[2];
+
+ for (iiter = 0; iiter < nrowiter; iiter++)
+ {
+ if (minrow > maxrow) {
+ fpixels[1] = minrow - (iiter * incs[1]);
+ } else {
+ fpixels[1] = minrow + (iiter * incs[1]);
+ }
+
+ lpixels[1] = fpixels[1];
+
+ if (bitpix == 8)
+ {
+ ffgsvb(fptr, 1, naxis, naxes, fpixels, lpixels, incs, 0,
+ (unsigned char *) buffer, &anynull, status);
+
+ ffpprb(newptr, 1, firstpix, outsize, (unsigned char *) buffer, status);
+ }
+ else if (bitpix == 16)
+ {
+ ffgsvi(fptr, 1, naxis, naxes, fpixels, lpixels, incs, 0,
+ (short *) buffer, &anynull, status);
+
+ ffppri(newptr, 1, firstpix, outsize, (short *) buffer, status);
+ }
+ else if (bitpix == 32)
+ {
+ ffgsvk(fptr, 1, naxis, naxes, fpixels, lpixels, incs, 0,
+ (int *) buffer, &anynull, status);
+
+ ffpprk(newptr, 1, firstpix, outsize, (int *) buffer, status);
+ }
+ else if (bitpix == -32)
+ {
+ ffgsve(fptr, 1, naxis, naxes, fpixels, lpixels, incs, FLOATNULLVALUE,
+ (float *) buffer, &anynull, status);
+
+ ffppne(newptr, 1, firstpix, outsize, (float *) buffer, FLOATNULLVALUE, status);
+ }
+ else if (bitpix == -64)
+ {
+ ffgsvd(fptr, 1, naxis, naxes, fpixels, lpixels, incs, DOUBLENULLVALUE,
+ buffer, &anynull, status);
+
+ ffppnd(newptr, 1, firstpix, outsize, buffer, DOUBLENULLVALUE,
+ status);
+ }
+ else if (bitpix == 64)
+ {
+ ffgsvjj(fptr, 1, naxis, naxes, fpixels, lpixels, incs, 0,
+ (LONGLONG *) buffer, &anynull, status);
+
+ ffpprjj(newptr, 1, firstpix, outsize, (LONGLONG *) buffer, status);
+ }
+
+ firstpix += outsize;
+ }
+ }
+ }
+
+ free(buffer); /* finished with the memory */
+
+ if (*status > 0)
+ {
+ ffpmsg("fits_copy_image_section: error copying image section");
+ return(*status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_get_section_range(char **ptr,
+ long *secmin,
+ long *secmax,
+ long *incre,
+ int *status)
+/*
+ Parse the input image section specification string, returning
+ the min, max and increment values.
+ Typical string = "1:512:2" or "1:512"
+*/
+{
+ int slen, isanumber;
+ char token[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ slen = fits_get_token(ptr, " ,:", token, &isanumber); /* get 1st token */
+
+ /* support [:2,:2] type syntax, where the leading * is implied */
+ if (slen==0) strcpy(token,"*");
+
+ if (*token == '*') /* wild card means to use the whole range */
+ {
+ *secmin = 1;
+ *secmax = 0;
+ }
+ else if (*token == '-' && *(token+1) == '*' ) /* invert the whole range */
+ {
+ *secmin = 0;
+ *secmax = 1;
+ }
+ else
+ {
+ if (slen == 0 || !isanumber || **ptr != ':')
+ return(*status = URL_PARSE_ERROR);
+
+ /* the token contains the min value */
+ *secmin = atol(token);
+
+ (*ptr)++; /* skip the colon between the min and max values */
+ slen = fits_get_token(ptr, " ,:", token, &isanumber); /* get token */
+
+ if (slen == 0 || !isanumber)
+ return(*status = URL_PARSE_ERROR);
+
+ /* the token contains the max value */
+ *secmax = atol(token);
+ }
+
+ if (**ptr == ':')
+ {
+ (*ptr)++; /* skip the colon between the max and incre values */
+ slen = fits_get_token(ptr, " ,", token, &isanumber); /* get token */
+
+ if (slen == 0 || !isanumber)
+ return(*status = URL_PARSE_ERROR);
+
+ *incre = atol(token);
+ }
+ else
+ *incre = 1; /* default increment if none is supplied */
+
+ if (**ptr == ',')
+ (*ptr)++;
+
+ while (**ptr == ' ') /* skip any trailing blanks */
+ (*ptr)++;
+
+ if (*secmin < 0 || *secmax < 0 || *incre < 1)
+ *status = URL_PARSE_ERROR;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffselect_table(
+ fitsfile **fptr, /* IO - pointer to input table; on output it */
+ /* points to the new selected rows table */
+ char *outfile, /* I - name for output file */
+ char *expr, /* I - Boolean expression */
+ int *status)
+{
+ fitsfile *newptr;
+ int ii, hdunum;
+
+ if (*outfile)
+ {
+ /* create new empty file in to hold the selected rows */
+ if (ffinit(&newptr, outfile, status) > 0)
+ {
+ ffpmsg(
+ "failed to create file for selected rows from input table");
+ ffpmsg(outfile);
+ return(*status);
+ }
+
+ fits_get_hdu_num(*fptr, &hdunum); /* current HDU number in input file */
+
+ /* copy all preceding extensions to the output file, if the 'only_one' flag is not set */
+ if (!((*fptr)->Fptr)->only_one) {
+ for (ii = 1; ii < hdunum; ii++)
+ {
+ fits_movabs_hdu(*fptr, ii, NULL, status);
+ if (fits_copy_hdu(*fptr, newptr, 0, status) > 0)
+ {
+ ffclos(newptr, status);
+ return(*status);
+ }
+ }
+ } else {
+ /* just copy the primary array */
+ fits_movabs_hdu(*fptr, 1, NULL, status);
+ if (fits_copy_hdu(*fptr, newptr, 0, status) > 0)
+ {
+ ffclos(newptr, status);
+ return(*status);
+ }
+ }
+
+ fits_movabs_hdu(*fptr, hdunum, NULL, status);
+
+ /* copy all the header keywords from the input to output file */
+ if (fits_copy_header(*fptr, newptr, status) > 0)
+ {
+ ffclos(newptr, status);
+ return(*status);
+ }
+
+ /* set number of rows = 0 */
+ fits_modify_key_lng(newptr, "NAXIS2", 0, NULL,status);
+ (newptr->Fptr)->numrows = 0;
+ (newptr->Fptr)->origrows = 0;
+
+ if (ffrdef(newptr, status) > 0) /* force the header to be scanned */
+ {
+ ffclos(newptr, status);
+ return(*status);
+ }
+ }
+ else
+ newptr = *fptr; /* will delete rows in place in the table */
+
+ /* copy rows which satisfy the selection expression to the output table */
+ /* or delete the nonqualifying rows if *fptr = newptr. */
+ if (fits_select_rows(*fptr, newptr, expr, status) > 0)
+ {
+ if (*outfile)
+ ffclos(newptr, status);
+
+ return(*status);
+ }
+
+ if (*outfile)
+ {
+ /* copy any remaining HDUs to the output copy */
+
+ if (!((*fptr)->Fptr)->only_one) {
+ for (ii = hdunum + 1; 1; ii++)
+ {
+ if (fits_movabs_hdu(*fptr, ii, NULL, status) > 0)
+ break;
+
+ fits_copy_hdu(*fptr, newptr, 0, status);
+ }
+
+ if (*status == END_OF_FILE)
+ *status = 0; /* got the expected EOF error; reset = 0 */
+ else if (*status > 0)
+ {
+ ffclos(newptr, status);
+ return(*status);
+ }
+ } else {
+ hdunum = 2;
+ }
+
+ /* close the original file and return ptr to the new image */
+ ffclos(*fptr, status);
+
+ *fptr = newptr; /* reset the pointer to the new table */
+
+ /* move back to the selected table HDU */
+ fits_movabs_hdu(*fptr, hdunum, NULL, status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffparsecompspec(fitsfile *fptr, /* I - FITS file pointer */
+ char *compspec, /* I - image compression specification */
+ int *status) /* IO - error status */
+/*
+ Parse the image compression specification that was give in square brackets
+ following the output FITS file name, as in these examples:
+
+ myfile.fits[compress] - default Rice compression, row by row
+ myfile.fits[compress TYPE] - the first letter of TYPE defines the
+ compression algorithm:
+ R = Rice
+ G = GZIP
+ H = HCOMPRESS
+ HS = HCOMPRESS (with smoothing)
+ B - BZIP2
+ P = PLIO
+
+ myfile.fits[compress TYPE 100,100] - the numbers give the dimensions
+ of the compression tiles. Default
+ is NAXIS1, 1, 1, ...
+
+ other optional parameters may be specified following a semi-colon
+
+ myfile.fits[compress; q 8.0] q specifies the floating point
+ mufile.fits[compress TYPE; q -.0002] quantization level;
+ myfile.fits[compress TYPE 100,100; q 10, s 25] s specifies the HCOMPRESS
+ integer scaling parameter
+
+The compression parameters are saved in the fptr->Fptr structure for use
+when writing FITS images.
+
+*/
+{
+ char *ptr1;
+
+ /* initialize with default values */
+ int ii, compresstype = RICE_1, smooth = 0;
+ long tilesize[MAX_COMPRESS_DIM] = {0,1,1,1,1,1};
+ float qlevel = 0.0, scale = 0.;
+
+ ptr1 = compspec;
+ while (*ptr1 == ' ') /* ignore leading blanks */
+ ptr1++;
+
+ if (strncmp(ptr1, "compress", 8) && strncmp(ptr1, "COMPRESS", 8) )
+ {
+ /* apparently this string does not specify compression parameters */
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ ptr1 += 8;
+ while (*ptr1 == ' ') /* ignore leading blanks */
+ ptr1++;
+
+ /* ========================= */
+ /* look for compression type */
+ /* ========================= */
+
+ if (*ptr1 == 'r' || *ptr1 == 'R')
+ {
+ compresstype = RICE_1;
+ while (*ptr1 != ' ' && *ptr1 != ';' && *ptr1 != '\0')
+ ptr1++;
+ }
+ else if (*ptr1 == 'g' || *ptr1 == 'G')
+ {
+ compresstype = GZIP_1;
+ while (*ptr1 != ' ' && *ptr1 != ';' && *ptr1 != '\0')
+ ptr1++;
+
+ }
+/*
+ else if (*ptr1 == 'b' || *ptr1 == 'B')
+ {
+ compresstype = BZIP2_1;
+ while (*ptr1 != ' ' && *ptr1 != ';' && *ptr1 != '\0')
+ ptr1++;
+
+ }
+*/
+ else if (*ptr1 == 'p' || *ptr1 == 'P')
+ {
+ compresstype = PLIO_1;
+ while (*ptr1 != ' ' && *ptr1 != ';' && *ptr1 != '\0')
+ ptr1++;
+ }
+ else if (*ptr1 == 'h' || *ptr1 == 'H')
+ {
+ compresstype = HCOMPRESS_1;
+ ptr1++;
+ if (*ptr1 == 's' || *ptr1 == 'S')
+ smooth = 1; /* apply smoothing when uncompressing HCOMPRESSed image */
+
+ while (*ptr1 != ' ' && *ptr1 != ';' && *ptr1 != '\0')
+ ptr1++;
+ }
+
+ /* ======================== */
+ /* look for tile dimensions */
+ /* ======================== */
+
+ while (*ptr1 == ' ') /* ignore leading blanks */
+ ptr1++;
+
+ ii = 0;
+ while (isdigit( (int) *ptr1) && ii < 9)
+ {
+ tilesize[ii] = atol(ptr1); /* read the integer value */
+ ii++;
+
+ while (isdigit((int) *ptr1)) /* skip over the integer */
+ ptr1++;
+
+ if (*ptr1 == ',')
+ ptr1++; /* skip over the comma */
+
+ while (*ptr1 == ' ') /* ignore leading blanks */
+ ptr1++;
+ }
+
+ /* ========================================================= */
+ /* look for semi-colon, followed by other optional parameters */
+ /* ========================================================= */
+
+ if (*ptr1 == ';') {
+ ptr1++;
+ while (*ptr1 == ' ') /* ignore leading blanks */
+ ptr1++;
+
+ while (*ptr1 != 0) { /* haven't reached end of string yet */
+
+ if (*ptr1 == 's' || *ptr1 == 'S') {
+ /* this should be the HCOMPRESS "scale" parameter; default = 1 */
+
+ ptr1++;
+ while (*ptr1 == ' ') /* ignore leading blanks */
+ ptr1++;
+
+ scale = (float) strtod(ptr1, &ptr1);
+
+ while (*ptr1 == ' ' || *ptr1 == ',') /* skip over blanks or comma */
+ ptr1++;
+
+ } else if (*ptr1 == 'q' || *ptr1 == 'Q') {
+ /* this should be the floating point quantization parameter */
+
+ ptr1++;
+ while (*ptr1 == ' ') /* ignore leading blanks */
+ ptr1++;
+
+ qlevel = (float) strtod(ptr1, &ptr1);
+
+ while (*ptr1 == ' ' || *ptr1 == ',') /* skip over blanks or comma */
+ ptr1++;
+
+ } else {
+ return(*status = URL_PARSE_ERROR);
+ }
+ }
+ }
+
+ /* ================================= */
+ /* finished parsing; save the values */
+ /* ================================= */
+
+ fits_set_compression_type(fptr, compresstype, status);
+ fits_set_tile_dim(fptr, MAX_COMPRESS_DIM, tilesize, status);
+
+ if (compresstype == HCOMPRESS_1) {
+ fits_set_hcomp_scale (fptr, scale, status);
+ fits_set_hcomp_smooth(fptr, smooth, status);
+ }
+
+ if (qlevel != 0.0)
+ fits_set_quantize_level(fptr, qlevel, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdkinit(fitsfile **fptr, /* O - FITS file pointer */
+ const char *name, /* I - name of file to create */
+ int *status) /* IO - error status */
+/*
+ Create and initialize a new FITS file on disk. This routine differs
+ from ffinit in that the input 'name' is literally taken as the name
+ of the disk file to be created, and it does not support CFITSIO's
+ extended filename syntax.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ *status = CREATE_DISK_FILE;
+
+ ffinit(fptr, name,status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffinit(fitsfile **fptr, /* O - FITS file pointer */
+ const char *name, /* I - name of file to create */
+ int *status) /* IO - error status */
+/*
+ Create and initialize a new FITS file.
+*/
+{
+ int ii, driver, slen, clobber = 0;
+ char *url;
+ char urltype[MAX_PREFIX_LEN], outfile[FLEN_FILENAME];
+ char tmplfile[FLEN_FILENAME], compspec[80];
+ int handle, create_disk_file = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ if (*status == CREATE_DISK_FILE)
+ {
+ create_disk_file = 1;
+ *status = 0;
+ }
+
+ *fptr = 0; /* initialize null file pointer */
+
+ if (need_to_initialize) { /* this is called only once */
+ *status = fits_init_cfitsio();
+ }
+
+ if (*status > 0)
+ return(*status);
+
+ url = (char *) name;
+ while (*url == ' ') /* ignore leading spaces in the filename */
+ url++;
+
+ if (*url == '\0')
+ {
+ ffpmsg("Name of file to create is blank. (ffinit)");
+ return(*status = FILE_NOT_CREATED);
+ }
+
+ if (create_disk_file)
+ {
+ if (strlen(url) > FLEN_FILENAME - 1)
+ {
+ ffpmsg("Filename is too long. (ffinit)");
+ return(*status = FILE_NOT_CREATED);
+ }
+
+ strcpy(outfile, url);
+ strcpy(urltype, "file://");
+ tmplfile[0] = '\0';
+ compspec[0] = '\0';
+ }
+ else
+ {
+
+ /* check for clobber symbol, i.e, overwrite existing file */
+ if (*url == '!')
+ {
+ clobber = TRUE;
+ url++;
+ }
+ else
+ clobber = FALSE;
+
+ /* parse the output file specification */
+ /* this routine checks that the strings will not overflow */
+ ffourl(url, urltype, outfile, tmplfile, compspec, status);
+
+ if (*status > 0)
+ {
+ ffpmsg("could not parse the output filename: (ffinit)");
+ ffpmsg(url);
+ return(*status);
+ }
+ }
+
+ /* find which driver corresponds to the urltype */
+ *status = urltype2driver(urltype, &driver);
+
+ if (*status)
+ {
+ ffpmsg("could not find driver for this file: (ffinit)");
+ ffpmsg(url);
+ return(*status);
+ }
+
+ /* delete pre-existing file, if asked to do so */
+ if (clobber)
+ {
+ if (driverTable[driver].remove)
+ (*driverTable[driver].remove)(outfile);
+ }
+
+ /* call appropriate driver to create the file */
+ if (driverTable[driver].create)
+ {
+ FFLOCK; /* lock this while searching for vacant handle */
+ *status = (*driverTable[driver].create)(outfile, &handle);
+ FFUNLOCK;
+ if (*status)
+ {
+ ffpmsg("failed to create new file (already exists?):");
+ ffpmsg(url);
+ return(*status);
+ }
+ }
+ else
+ {
+ ffpmsg("cannot create a new file of this type: (ffinit)");
+ ffpmsg(url);
+ return(*status = FILE_NOT_CREATED);
+ }
+
+ /* allocate fitsfile structure and initialize = 0 */
+ *fptr = (fitsfile *) calloc(1, sizeof(fitsfile));
+
+ if (!(*fptr))
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate structure for following file: (ffopen)");
+ ffpmsg(url);
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* allocate FITSfile structure and initialize = 0 */
+ (*fptr)->Fptr = (FITSfile *) calloc(1, sizeof(FITSfile));
+
+ if (!((*fptr)->Fptr))
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate structure for following file: (ffopen)");
+ ffpmsg(url);
+ free(*fptr);
+ *fptr = 0;
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ slen = strlen(url) + 1;
+ slen = maxvalue(slen, 32); /* reserve at least 32 chars */
+ ((*fptr)->Fptr)->filename = (char *) malloc(slen); /* mem for file name */
+
+ if ( !(((*fptr)->Fptr)->filename) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for filename: (ffinit)");
+ ffpmsg(url);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = FILE_NOT_CREATED);
+ }
+
+ /* mem for headstart array */
+ ((*fptr)->Fptr)->headstart = (LONGLONG *) calloc(1001, sizeof(LONGLONG));
+
+ if ( !(((*fptr)->Fptr)->headstart) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for headstart array: (ffinit)");
+ ffpmsg(url);
+ free( ((*fptr)->Fptr)->filename);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* mem for file I/O buffers */
+ ((*fptr)->Fptr)->iobuffer = (char *) calloc(NIOBUF, IOBUFLEN);
+
+ if ( !(((*fptr)->Fptr)->iobuffer) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for iobuffer array: (ffinit)");
+ ffpmsg(url);
+ free( ((*fptr)->Fptr)->headstart); /* free memory for headstart array */
+ free( ((*fptr)->Fptr)->filename);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* initialize the ageindex array (relative age of the I/O buffers) */
+ /* and initialize the bufrecnum array as being empty */
+ for (ii = 0; ii < NIOBUF; ii++) {
+ ((*fptr)->Fptr)->ageindex[ii] = ii;
+ ((*fptr)->Fptr)->bufrecnum[ii] = -1;
+ }
+
+ /* store the parameters describing the file */
+ ((*fptr)->Fptr)->MAXHDU = 1000; /* initial size of headstart */
+ ((*fptr)->Fptr)->filehandle = handle; /* store the file pointer */
+ ((*fptr)->Fptr)->driver = driver; /* driver number */
+ strcpy(((*fptr)->Fptr)->filename, url); /* full input filename */
+ ((*fptr)->Fptr)->filesize = 0; /* physical file size */
+ ((*fptr)->Fptr)->logfilesize = 0; /* logical file size */
+ ((*fptr)->Fptr)->writemode = 1; /* read-write mode */
+ ((*fptr)->Fptr)->datastart = DATA_UNDEFINED; /* unknown start of data */
+ ((*fptr)->Fptr)->curbuf = -1; /* undefined current IO buffer */
+ ((*fptr)->Fptr)->open_count = 1; /* structure is currently used once */
+ ((*fptr)->Fptr)->validcode = VALIDSTRUC; /* flag denoting valid structure */
+
+ ffldrc(*fptr, 0, IGNORE_EOF, status); /* initialize first record */
+
+ fits_store_Fptr( (*fptr)->Fptr, status); /* store Fptr address */
+
+ /* if template file was given, use it to define structure of new file */
+
+ if (tmplfile[0])
+ ffoptplt(*fptr, tmplfile, status);
+
+ /* parse and save image compression specification, if given */
+ if (compspec[0])
+ ffparsecompspec(*fptr, compspec, status);
+
+ return(*status); /* successful return */
+}
+/*--------------------------------------------------------------------------*/
+/* ffimem == fits_create_memfile */
+
+int ffimem(fitsfile **fptr, /* O - FITS file pointer */
+ void **buffptr, /* I - address of memory pointer */
+ size_t *buffsize, /* I - size of buffer, in bytes */
+ size_t deltasize, /* I - increment for future realloc's */
+ void *(*mem_realloc)(void *p, size_t newsize), /* function */
+ int *status) /* IO - error status */
+
+/*
+ Create and initialize a new FITS file in memory
+*/
+{
+ int ii, driver, slen;
+ char urltype[MAX_PREFIX_LEN];
+ int handle;
+
+ if (*status > 0)
+ return(*status);
+
+ *fptr = 0; /* initialize null file pointer */
+
+ if (need_to_initialize) { /* this is called only once */
+ *status = fits_init_cfitsio();
+ }
+
+ if (*status > 0)
+ return(*status);
+
+ strcpy(urltype, "memkeep://"); /* URL type for pre-existing memory file */
+
+ *status = urltype2driver(urltype, &driver);
+
+ if (*status > 0)
+ {
+ ffpmsg("could not find driver for pre-existing memory file: (ffimem)");
+ return(*status);
+ }
+
+ /* call driver routine to "open" the memory file */
+ FFLOCK; /* lock this while searching for vacant handle */
+ *status = mem_openmem( buffptr, buffsize, deltasize,
+ mem_realloc, &handle);
+ FFUNLOCK;
+
+ if (*status > 0)
+ {
+ ffpmsg("failed to open pre-existing memory file: (ffimem)");
+ return(*status);
+ }
+
+ /* allocate fitsfile structure and initialize = 0 */
+ *fptr = (fitsfile *) calloc(1, sizeof(fitsfile));
+
+ if (!(*fptr))
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate structure for memory file: (ffimem)");
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* allocate FITSfile structure and initialize = 0 */
+ (*fptr)->Fptr = (FITSfile *) calloc(1, sizeof(FITSfile));
+
+ if (!((*fptr)->Fptr))
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate structure for memory file: (ffimem)");
+ free(*fptr);
+ *fptr = 0;
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ slen = 32; /* reserve at least 32 chars */
+ ((*fptr)->Fptr)->filename = (char *) malloc(slen); /* mem for file name */
+
+ if ( !(((*fptr)->Fptr)->filename) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for filename: (ffimem)");
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* mem for headstart array */
+ ((*fptr)->Fptr)->headstart = (LONGLONG *) calloc(1001, sizeof(LONGLONG));
+
+ if ( !(((*fptr)->Fptr)->headstart) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for headstart array: (ffimem)");
+ free( ((*fptr)->Fptr)->filename);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* mem for file I/O buffers */
+ ((*fptr)->Fptr)->iobuffer = (char *) calloc(NIOBUF, IOBUFLEN);
+
+ if ( !(((*fptr)->Fptr)->iobuffer) )
+ {
+ (*driverTable[driver].close)(handle); /* close the file */
+ ffpmsg("failed to allocate memory for iobuffer array: (ffimem)");
+ free( ((*fptr)->Fptr)->headstart); /* free memory for headstart array */
+ free( ((*fptr)->Fptr)->filename);
+ free((*fptr)->Fptr);
+ free(*fptr);
+ *fptr = 0; /* return null file pointer */
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* initialize the ageindex array (relative age of the I/O buffers) */
+ /* and initialize the bufrecnum array as being empty */
+ for (ii = 0; ii < NIOBUF; ii++) {
+ ((*fptr)->Fptr)->ageindex[ii] = ii;
+ ((*fptr)->Fptr)->bufrecnum[ii] = -1;
+ }
+
+ /* store the parameters describing the file */
+ ((*fptr)->Fptr)->MAXHDU = 1000; /* initial size of headstart */
+ ((*fptr)->Fptr)->filehandle = handle; /* file handle */
+ ((*fptr)->Fptr)->driver = driver; /* driver number */
+ strcpy(((*fptr)->Fptr)->filename, "memfile"); /* dummy filename */
+ ((*fptr)->Fptr)->filesize = *buffsize; /* physical file size */
+ ((*fptr)->Fptr)->logfilesize = *buffsize; /* logical file size */
+ ((*fptr)->Fptr)->writemode = 1; /* read-write mode */
+ ((*fptr)->Fptr)->datastart = DATA_UNDEFINED; /* unknown start of data */
+ ((*fptr)->Fptr)->curbuf = -1; /* undefined current IO buffer */
+ ((*fptr)->Fptr)->open_count = 1; /* structure is currently used once */
+ ((*fptr)->Fptr)->validcode = VALIDSTRUC; /* flag denoting valid structure */
+
+ ffldrc(*fptr, 0, IGNORE_EOF, status); /* initialize first record */
+ fits_store_Fptr( (*fptr)->Fptr, status); /* store Fptr address */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_init_cfitsio(void)
+/*
+ initialize anything that is required before using the CFITSIO routines
+*/
+{
+ int status;
+
+ union u_tag {
+ short ival;
+ char cval[2];
+ } u;
+
+ fitsio_init_lock();
+
+ FFLOCK; /* lockout other threads while executing this critical */
+ /* section of code */
+
+ if (need_to_initialize == 0) { /* already initialized? */
+ FFUNLOCK;
+ return(0);
+ }
+
+ /* test for correct byteswapping. */
+
+ u.ival = 1;
+ if ((BYTESWAPPED && u.cval[0] != 1) ||
+ (BYTESWAPPED == FALSE && u.cval[1] != 1) )
+ {
+ printf ("\n!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n");
+ printf(" Byteswapping is not being done correctly on this system.\n");
+ printf(" Check the MACHINE and BYTESWAPPED definitions in fitsio2.h\n");
+ printf(" Please report this problem to the CFITSIO developers.\n");
+ printf( "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n");
+ FFUNLOCK;
+ return(1);
+ }
+
+
+ /* test that LONGLONG is an 8 byte integer */
+
+ if (sizeof(LONGLONG) != 8)
+ {
+ printf ("\n!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n");
+ printf(" CFITSIO did not find an 8-byte long integer data type.\n");
+ printf(" sizeof(LONGLONG) = %d\n",(int)sizeof(LONGLONG));
+ printf(" Please report this problem to the CFITSIO developers.\n");
+ printf( "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n");
+ FFUNLOCK;
+ return(1);
+ }
+
+ /* register the standard I/O drivers that are always available */
+
+ /* 1--------------------disk file driver-----------------------*/
+ status = fits_register_driver("file://",
+ file_init,
+ file_shutdown,
+ file_setoptions,
+ file_getoptions,
+ file_getversion,
+ file_checkfile,
+ file_open,
+ file_create,
+#ifdef HAVE_FTRUNCATE
+ file_truncate,
+#else
+ NULL, /* no file truncate function */
+#endif
+ file_close,
+ file_remove,
+ file_size,
+ file_flush,
+ file_seek,
+ file_read,
+ file_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the file:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 2------------ output temporary memory file driver ----------------*/
+ status = fits_register_driver("mem://",
+ mem_init,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ NULL, /* open function not allowed */
+ mem_create,
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+
+ if (status)
+ {
+ ffpmsg("failed to register the mem:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 3--------------input pre-existing memory file driver----------------*/
+ status = fits_register_driver("memkeep://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ NULL, /* file open driver function is not used */
+ NULL, /* create function not allowed */
+ mem_truncate,
+ mem_close_keep,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+
+ if (status)
+ {
+ ffpmsg("failed to register the memkeep:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 4-------------------stdin stream driver----------------------*/
+ /* the stdin stream is copied to memory then opened in memory */
+
+ status = fits_register_driver("stdin://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ stdin_checkfile,
+ stdin_open,
+ NULL, /* create function not allowed */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the stdin:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 5-------------------stdin file stream driver----------------------*/
+ /* the stdin stream is copied to a disk file then the disk file is opened */
+
+ status = fits_register_driver("stdinfile://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ stdin_open,
+ NULL, /* create function not allowed */
+#ifdef HAVE_FTRUNCATE
+ file_truncate,
+#else
+ NULL, /* no file truncate function */
+#endif
+ file_close,
+ file_remove,
+ file_size,
+ file_flush,
+ file_seek,
+ file_read,
+ file_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the stdinfile:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+
+ /* 6-----------------------stdout stream driver------------------*/
+ status = fits_register_driver("stdout://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ NULL, /* open function not required */
+ mem_create,
+ mem_truncate,
+ stdout_close,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the stdout:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 7------------------iraf disk file to memory driver -----------*/
+ status = fits_register_driver("irafmem://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ mem_iraf_open,
+ NULL, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the irafmem:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 8------------------raw binary file to memory driver -----------*/
+ status = fits_register_driver("rawfile://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ mem_rawfile_open,
+ NULL, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the rawfile:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 9------------------compressed disk file to memory driver -----------*/
+ status = fits_register_driver("compress://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ mem_compress_open,
+ NULL, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the compress:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 10------------------compressed disk file to memory driver -----------*/
+ /* Identical to compress://, except it allows READWRITE access */
+
+ status = fits_register_driver("compressmem://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ mem_compress_openrw,
+ NULL, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the compressmem:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 11------------------compressed disk file to disk file driver -------*/
+ status = fits_register_driver("compressfile://",
+ NULL,
+ file_shutdown,
+ file_setoptions,
+ file_getoptions,
+ file_getversion,
+ NULL, /* checkfile not needed */
+ file_compress_open,
+ file_create,
+#ifdef HAVE_FTRUNCATE
+ file_truncate,
+#else
+ NULL, /* no file truncate function */
+#endif
+ file_close,
+ file_remove,
+ file_size,
+ file_flush,
+ file_seek,
+ file_read,
+ file_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the compressfile:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 12---create file in memory, then compress it to disk file on close--*/
+ status = fits_register_driver("compressoutfile://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ NULL, /* open function not allowed */
+ mem_create_comp,
+ mem_truncate,
+ mem_close_comp,
+ file_remove, /* delete existing compressed disk file */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+
+ if (status)
+ {
+ ffpmsg(
+ "failed to register the compressoutfile:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* Register Optional drivers */
+
+#ifdef HAVE_NET_SERVICES
+
+ /* 13--------------------root driver-----------------------*/
+
+ status = fits_register_driver("root://",
+ root_init,
+ root_shutdown,
+ root_setoptions,
+ root_getoptions,
+ root_getversion,
+ NULL, /* checkfile not needed */
+ root_open,
+ root_create,
+ NULL, /* No truncate possible */
+ root_close,
+ NULL, /* No remove possible */
+ root_size, /* no size possible */
+ root_flush,
+ root_seek, /* Though will always succeed */
+ root_read,
+ root_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the root:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 14--------------------http driver-----------------------*/
+ status = fits_register_driver("http://";,
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ http_checkfile,
+ http_open,
+ NULL, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the http:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 15--------------------http file driver-----------------------*/
+
+ status = fits_register_driver("httpfile://",
+ NULL,
+ file_shutdown,
+ file_setoptions,
+ file_getoptions,
+ file_getversion,
+ NULL, /* checkfile not needed */
+ http_file_open,
+ file_create,
+#ifdef HAVE_FTRUNCATE
+ file_truncate,
+#else
+ NULL, /* no file truncate function */
+#endif
+ file_close,
+ file_remove,
+ file_size,
+ file_flush,
+ file_seek,
+ file_read,
+ file_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the httpfile:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 16--------------------http memory driver-----------------------*/
+ /* same as http:// driver, except memory file can be opened READWRITE */
+ status = fits_register_driver("httpmem://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ http_checkfile,
+ http_file_open, /* this will simply call http_open */
+ NULL, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the httpmem:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 17--------------------httpcompress file driver-----------------------*/
+
+ status = fits_register_driver("httpcompress://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ http_compress_open,
+ NULL, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the httpcompress:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+
+ /* 18--------------------ftp driver-----------------------*/
+ status = fits_register_driver("ftp://";,
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ ftp_checkfile,
+ ftp_open,
+ NULL, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the ftp:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 19--------------------ftp file driver-----------------------*/
+ status = fits_register_driver("ftpfile://",
+ NULL,
+ file_shutdown,
+ file_setoptions,
+ file_getoptions,
+ file_getversion,
+ NULL, /* checkfile not needed */
+ ftp_file_open,
+ file_create,
+#ifdef HAVE_FTRUNCATE
+ file_truncate,
+#else
+ NULL, /* no file truncate function */
+#endif
+ file_close,
+ file_remove,
+ file_size,
+ file_flush,
+ file_seek,
+ file_read,
+ file_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the ftpfile:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 20--------------------ftp mem driver-----------------------*/
+ /* same as ftp:// driver, except memory file can be opened READWRITE */
+ status = fits_register_driver("ftpmem://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ ftp_checkfile,
+ ftp_file_open, /* this will simply call ftp_open */
+ NULL, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ NULL, /* remove function not required */
+ mem_size,
+ NULL, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the ftpmem:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* 21--------------------ftp compressed file driver------------------*/
+ status = fits_register_driver("ftpcompress://",
+ NULL,
+ mem_shutdown,
+ mem_setoptions,
+ mem_getoptions,
+ mem_getversion,
+ NULL, /* checkfile not needed */
+ ftp_compress_open,
+ 0, /* create function not required */
+ mem_truncate,
+ mem_close_free,
+ 0, /* remove function not required */
+ mem_size,
+ 0, /* flush function not required */
+ mem_seek,
+ mem_read,
+ mem_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the ftpcompress:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+ /* === End of net drivers section === */
+#endif
+
+/* ==================== SHARED MEMORY DRIVER SECTION ======================= */
+
+#ifdef HAVE_SHMEM_SERVICES
+
+ /* 22--------------------shared memory driver-----------------------*/
+ status = fits_register_driver("shmem://",
+ smem_init,
+ smem_shutdown,
+ smem_setoptions,
+ smem_getoptions,
+ smem_getversion,
+ NULL, /* checkfile not needed */
+ smem_open,
+ smem_create,
+ NULL, /* truncate file not supported yet */
+ smem_close,
+ smem_remove,
+ smem_size,
+ smem_flush,
+ smem_seek,
+ smem_read,
+ smem_write );
+
+ if (status)
+ {
+ ffpmsg("failed to register the shmem:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+#endif
+/* ==================== END OF SHARED MEMORY DRIVER SECTION ================ */
+
+
+#ifdef HAVE_GSIFTP
+ /* 23--------------------gsiftp driver-----------------------*/
+ status = fits_register_driver("gsiftp://";,
+ gsiftp_init,
+ gsiftp_shutdown,
+ gsiftp_setoptions,
+ gsiftp_getoptions,
+ gsiftp_getversion,
+ gsiftp_checkfile,
+ gsiftp_open,
+ gsiftp_create,
+#ifdef HAVE_FTRUNCATE
+ gsiftp_truncate,
+#else
+ NULL,
+#endif
+ gsiftp_close,
+ NULL, /* remove function not yet implemented */
+ gsiftp_size,
+ gsiftp_flush,
+ gsiftp_seek,
+ gsiftp_read,
+ gsiftp_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the gsiftp:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+#endif
+
+ /* 24---------------stdin and stdout stream driver-------------------*/
+ status = fits_register_driver("stream://",
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ stream_open,
+ stream_create,
+ NULL, /* no stream truncate function */
+ stream_close,
+ NULL, /* no stream remove */
+ stream_size,
+ stream_flush,
+ stream_seek,
+ stream_read,
+ stream_write);
+
+ if (status)
+ {
+ ffpmsg("failed to register the stream:// driver (init_cfitsio)");
+ FFUNLOCK;
+ return(status);
+ }
+
+ /* reset flag. Any other threads will now not need to call this routine */
+ need_to_initialize = 0;
+
+ FFUNLOCK;
+ return(status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_register_driver(char *prefix,
+ int (*init)(void),
+ int (*shutdown)(void),
+ int (*setoptions)(int option),
+ int (*getoptions)(int *options),
+ int (*getversion)(int *version),
+ int (*checkfile) (char *urltype, char *infile, char *outfile),
+ int (*open)(char *filename, int rwmode, int *driverhandle),
+ int (*create)(char *filename, int *driverhandle),
+ int (*truncate)(int driverhandle, LONGLONG filesize),
+ int (*close)(int driverhandle),
+ int (*fremove)(char *filename),
+ int (*size)(int driverhandle, LONGLONG *size),
+ int (*flush)(int driverhandle),
+ int (*seek)(int driverhandle, LONGLONG offset),
+ int (*read) (int driverhandle, void *buffer, long nbytes),
+ int (*write)(int driverhandle, void *buffer, long nbytes) )
+/*
+ register all the functions needed to support an I/O driver
+*/
+{
+ int status;
+
+ if (no_of_drivers < 0 ) {
+ /* This is bad. looks like memory has been corrupted. */
+ ffpmsg("Vital CFITSIO parameters held in memory have been corrupted!!");
+ ffpmsg("Fatal condition detected in fits_register_driver.");
+ return(TOO_MANY_DRIVERS);
+ }
+
+ if (no_of_drivers + 1 > MAX_DRIVERS)
+ return(TOO_MANY_DRIVERS);
+
+ if (prefix == NULL)
+ return(BAD_URL_PREFIX);
+
+
+ if (init != NULL)
+ {
+ status = (*init)(); /* initialize the driver */
+ if (status)
+ return(status);
+ }
+
+ /* fill in data in table */
+ strncpy(driverTable[no_of_drivers].prefix, prefix, MAX_PREFIX_LEN);
+ driverTable[no_of_drivers].prefix[MAX_PREFIX_LEN - 1] = 0;
+ driverTable[no_of_drivers].init = init;
+ driverTable[no_of_drivers].shutdown = shutdown;
+ driverTable[no_of_drivers].setoptions = setoptions;
+ driverTable[no_of_drivers].getoptions = getoptions;
+ driverTable[no_of_drivers].getversion = getversion;
+ driverTable[no_of_drivers].checkfile = checkfile;
+ driverTable[no_of_drivers].open = open;
+ driverTable[no_of_drivers].create = create;
+ driverTable[no_of_drivers].truncate = truncate;
+ driverTable[no_of_drivers].close = close;
+ driverTable[no_of_drivers].remove = fremove;
+ driverTable[no_of_drivers].size = size;
+ driverTable[no_of_drivers].flush = flush;
+ driverTable[no_of_drivers].seek = seek;
+ driverTable[no_of_drivers].read = read;
+ driverTable[no_of_drivers].write = write;
+
+ no_of_drivers++; /* increment the number of drivers */
+ return(0);
+ }
+/*--------------------------------------------------------------------------*/
+/* fits_parse_input_url */
+int ffiurl(char *url, /* input filename */
+ char *urltype, /* e.g., 'file://', 'http://', 'mem://' */
+ char *infilex, /* root filename (may be complete path) */
+ char *outfile, /* optional output file name */
+ char *extspec, /* extension spec: +n or [extname, extver] */
+ char *rowfilterx, /* boolean row filter expression */
+ char *binspec, /* histogram binning specifier */
+ char *colspec, /* column or keyword modifier expression */
+ int *status)
+/*
+ parse the input URL into its basic components.
+ This routine is big and ugly and should be redesigned someday!
+*/
+{
+ return fits_parse_input_filename(url, urltype, infilex, outfile,
+ extspec, rowfilterx, binspec, colspec, 0, status);
+}
+
+/*--------------------------------------------------------------------------*/
+/* fits_parse_input_file */
+int ffifile(char *url, /* input filename */
+ char *urltype, /* e.g., 'file://', 'http://', 'mem://' */
+ char *infilex, /* root filename (may be complete path) */
+ char *outfile, /* optional output file name */
+ char *extspec, /* extension spec: +n or [extname, extver] */
+ char *rowfilterx, /* boolean row filter expression */
+ char *binspec, /* histogram binning specifier */
+ char *colspec, /* column or keyword modifier expression */
+ char *pixfilter, /* pixel filter expression */
+ int *status)
+/*
+ fits_parse_input_filename
+ parse the input URL into its basic components.
+ This routine is big and ugly and should be redesigned someday!
+*/
+{
+ int ii, jj, slen, infilelen, plus_ext = 0, collen;
+ char *ptr1, *ptr2, *ptr3, *ptr4, *tmptr;
+ int hasAt, hasDot, hasOper, followingOper, spaceTerm, rowFilter;
+ int colStart, binStart, pixStart;
+
+
+ /* must have temporary variable for these, in case inputs are NULL */
+ char *infile;
+ char *rowfilter;
+ char *tmpstr;
+
+ if (*status > 0)
+ return(*status);
+
+ /* Initialize null strings */
+ if (infilex) *infilex = '\0';
+ if (urltype) *urltype = '\0';
+ if (outfile) *outfile = '\0';
+ if (extspec) *extspec = '\0';
+ if (binspec) *binspec = '\0';
+ if (colspec) *colspec = '\0';
+ if (rowfilterx) *rowfilterx = '\0';
+ if (pixfilter) *pixfilter = '\0';
+
+ slen = strlen(url);
+
+ if (slen == 0) /* blank filename ?? */
+ return(*status);
+
+ /* allocate memory for 3 strings, each as long as the input url */
+ infile = (char *) calloc(3, slen + 1);
+ if (!infile)
+ return(*status = MEMORY_ALLOCATION);
+
+ rowfilter = &infile[slen + 1];
+ tmpstr = &rowfilter[slen + 1];
+
+ ptr1 = url;
+
+ /* -------------------------------------------------------- */
+ /* get urltype (e.g., file://, ftp://, http://, etc.) */
+ /* --------------------------------------------------------- */
+
+ if (*ptr1 == '-' && ( *(ptr1 +1) == 0 || *(ptr1 +1) == ' ' ||
+ *(ptr1 +1) == '[' || *(ptr1 +1) == '(' ) )
+ {
+ /* "-" means read file from stdin. Also support "- ", */
+ /* "-[extname]" and '-(outfile.fits)" but exclude disk file */
+ /* names that begin with a minus sign, e.g., "-55d33m.fits" */
+
+ if (urltype)
+ strcat(urltype, "stdin://");
+ ptr1++;
+ }
+ else if (!strncasecmp(ptr1, "stdin", 5))
+ {
+ if (urltype)
+ strcat(urltype, "stdin://");
+ ptr1 = ptr1 + 5;
+ }
+ else
+ {
+ ptr2 = strstr(ptr1, "://");
+ ptr3 = strstr(ptr1, "(" );
+
+ if (ptr3 && (ptr3 < ptr2) )
+ {
+ /* the urltype follows a '(' character, so it must apply */
+ /* to the output file, and is not the urltype of the input file */
+ ptr2 = 0; /* so reset pointer to zero */
+ }
+
+ if (ptr2) /* copy the explicit urltype string */
+ {
+ if (urltype)
+ strncat(urltype, ptr1, ptr2 - ptr1 + 3);
+ ptr1 = ptr2 + 3;
+ }
+ else if (!strncmp(ptr1, "ftp:", 4) )
+ { /* the 2 //'s are optional */
+ if (urltype)
+ strcat(urltype, "ftp://";);
+ ptr1 += 4;
+ }
+ else if (!strncmp(ptr1, "gsiftp:", 7) )
+ { /* the 2 //'s are optional */
+ if (urltype)
+ strcat(urltype, "gsiftp://";);
+ ptr1 += 7;
+ }
+ else if (!strncmp(ptr1, "http:", 5) )
+ { /* the 2 //'s are optional */
+ if (urltype)
+ strcat(urltype, "http://";);
+ ptr1 += 5;
+ }
+ else if (!strncmp(ptr1, "mem:", 4) )
+ { /* the 2 //'s are optional */
+ if (urltype)
+ strcat(urltype, "mem://");
+ ptr1 += 4;
+ }
+ else if (!strncmp(ptr1, "shmem:", 6) )
+ { /* the 2 //'s are optional */
+ if (urltype)
+ strcat(urltype, "shmem://");
+ ptr1 += 6;
+ }
+ else if (!strncmp(ptr1, "file:", 5) )
+ { /* the 2 //'s are optional */
+ if (urltype)
+ strcat(urltype, "file://");
+ ptr1 += 5;
+ }
+ else /* assume file driver */
+ {
+ if (urltype)
+ strcat(urltype, "file://");
+ }
+ }
+
+ /* ----------------------------------------------------------
+ If this is a http:// type file, then the cgi file name could
+ include the '[' character, which should not be interpreted
+ as part of CFITSIO's Extended File Name Syntax. Test for this
+ case by seeing if the last character is a ']' or ')'. If it
+ is not, then just treat the whole input string as the file name
+ and do not attempt to interprete the name using the extended
+ filename syntax.
+ ----------------------------------------------------------- */
+
+ if (urltype && !strncmp(urltype, "http://";, 7) )
+ {
+ /* test for opening parenthesis or bracket in the file name */
+ if( strchr(ptr1, '(' ) || strchr(ptr1, '[' ) )
+ {
+ slen = strlen(ptr1);
+ ptr3 = ptr1 + slen - 1;
+ while (*ptr3 == ' ') /* ignore trailing blanks */
+ ptr3--;
+
+ if (*ptr3 != ']' && *ptr3 != ')' )
+ {
+ /* name doesn't end with a ']' or ')' so don't try */
+ /* to parse this unusual string (may be cgi string) */
+ if (infilex) {
+
+ if (strlen(ptr1) > FLEN_FILENAME - 1) {
+ ffpmsg("Name of file is too long.");
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strcpy(infilex, ptr1);
+ }
+
+ free(infile);
+ return(*status);
+ }
+ }
+ }
+
+ /* ----------------------------------------------------------
+ Look for VMS style filenames like:
+ disk:[directory.subdirectory]filename.ext, or
+ [directory.subdirectory]filename.ext
+
+ Check if the first character is a '[' and urltype != stdin
+ or if there is a ':[' string in the remaining url string. If
+ so, then need to move past this bracket character before
+ search for the opening bracket of a filter specification.
+ ----------------------------------------------------------- */
+
+ tmptr = ptr1;
+ if (*ptr1 == '[')
+ {
+ if (*url != '-')
+ tmptr = ptr1 + 1; /* this bracket encloses a VMS directory name */
+ }
+ else
+ {
+ tmptr = strstr(ptr1, ":[");
+ if (tmptr) /* these 2 chars are part of the VMS disk and directory */
+ tmptr += 2;
+ else
+ tmptr = ptr1;
+ }
+
+ /* ------------------------ */
+ /* get the input file name */
+ /* ------------------------ */
+
+ ptr2 = strchr(tmptr, '('); /* search for opening parenthesis ( */
+ ptr3 = strchr(tmptr, '['); /* search for opening bracket [ */
+
+ if (ptr2 == ptr3) /* simple case: no [ or ( in the file name */
+ {
+ strcat(infile, ptr1);
+ }
+ else if (!ptr3 || /* no bracket, so () enclose output file name */
+ (ptr2 && (ptr2 < ptr3)) ) /* () enclose output name before bracket */
+ {
+ strncat(infile, ptr1, ptr2 - ptr1);
+ ptr2++;
+
+ ptr1 = strchr(ptr2, ')' ); /* search for closing ) */
+ if (!ptr1)
+ {
+ free(infile);
+ return(*status = URL_PARSE_ERROR); /* error, no closing ) */
+ }
+
+ if (outfile) {
+
+ if (ptr1 - ptr2 > FLEN_FILENAME - 1)
+ {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(outfile, ptr2, ptr1 - ptr2);
+ }
+
+ /* the opening [ could have been part of output name, */
+ /* e.g., file(out[compress])[3][#row > 5] */
+ /* so search again for opening bracket following the closing ) */
+ ptr3 = strchr(ptr1, '[');
+
+ }
+ else /* bracket comes first, so there is no output name */
+ {
+ strncat(infile, ptr1, ptr3 - ptr1);
+ }
+
+ /* strip off any trailing blanks in the names */
+
+ slen = strlen(infile);
+ while ( (--slen) > 0 && infile[slen] == ' ')
+ infile[slen] = '\0';
+
+ if (outfile)
+ {
+ slen = strlen(outfile);
+ while ( (--slen) > 0 && outfile[slen] == ' ')
+ outfile[slen] = '\0';
+ }
+
+ /* --------------------------------------------- */
+ /* check if this is an IRAF file (.imh extension */
+ /* --------------------------------------------- */
+
+ ptr4 = strstr(infile, ".imh");
+
+ /* did the infile name end with ".imh" ? */
+ if (ptr4 && (*(ptr4 + 4) == '\0'))
+ {
+ if (urltype)
+ strcpy(urltype, "irafmem://");
+ }
+
+ /* --------------------------------------------- */
+ /* check if the 'filename+n' convention has been */
+ /* used to specifiy which HDU number to open */
+ /* --------------------------------------------- */
+
+ jj = strlen(infile);
+
+ for (ii = jj - 1; ii >= 0; ii--)
+ {
+ if (infile[ii] == '+') /* search backwards for '+' sign */
+ break;
+ }
+
+ if (ii > 0 && (jj - ii) < 7) /* limit extension numbers to 5 digits */
+ {
+ infilelen = ii;
+ ii++;
+ ptr1 = infile+ii; /* pointer to start of sequence */
+
+ for (; ii < jj; ii++)
+ {
+ if (!isdigit((int) infile[ii] ) ) /* are all the chars digits? */
+ break;
+ }
+
+ if (ii == jj)
+ {
+ /* yes, the '+n' convention was used. Copy */
+ /* the digits to the output extspec string. */
+ plus_ext = 1;
+
+ if (extspec) {
+ if (jj - infilelen > FLEN_FILENAME - 1)
+ {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncpy(extspec, ptr1, jj - infilelen);
+ }
+
+ infile[infilelen] = '\0'; /* delete the extension number */
+ }
+ }
+
+ /* -------------------------------------------------------------------- */
+ /* if '*' was given for the output name expand it to the root file name */
+ /* -------------------------------------------------------------------- */
+
+ if (outfile && outfile[0] == '*')
+ {
+ /* scan input name backwards to the first '/' character */
+ for (ii = jj - 1; ii >= 0; ii--)
+ {
+ if (infile[ii] == '/' || ii == 0)
+ {
+ if (strlen(&infile[ii + 1]) > FLEN_FILENAME - 1)
+ {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strcpy(outfile, &infile[ii + 1]);
+ break;
+ }
+ }
+ }
+
+ /* ------------------------------------------ */
+ /* copy strings from local copy to the output */
+ /* ------------------------------------------ */
+ if (infilex) {
+ if (strlen(infile) > FLEN_FILENAME - 1)
+ {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strcpy(infilex, infile);
+ }
+ /* ---------------------------------------------------------- */
+ /* if no '[' character in the input string, then we are done. */
+ /* ---------------------------------------------------------- */
+ if (!ptr3)
+ {
+ free(infile);
+ return(*status);
+ }
+
+ /* ------------------------------------------- */
+ /* see if [ extension specification ] is given */
+ /* ------------------------------------------- */
+
+ if (!plus_ext) /* extension no. not already specified? Then */
+ /* first brackets must enclose extension name or # */
+ /* or it encloses a image subsection specification */
+ /* or a raw binary image specifier */
+
+ /* Or, the extension specification may have been */
+ /* omitted and we have to guess what the user intended */
+ {
+ ptr1 = ptr3 + 1; /* pointer to first char after the [ */
+
+ ptr2 = strchr(ptr1, ']' ); /* search for closing ] */
+ if (!ptr2)
+ {
+ ffpmsg("input file URL is missing closing bracket ']'");
+ free(infile);
+ return(*status = URL_PARSE_ERROR); /* error, no closing ] */
+ }
+
+ /* ---------------------------------------------- */
+ /* First, test if this is a rawfile specifier */
+ /* which looks something like: '[ib512,512:2880]' */
+ /* Test if first character is b,i,j,d,r,f, or u, */
+ /* and optional second character is b or l, */
+ /* followed by one or more digits, */
+ /* finally followed by a ',', ':', or ']' */
+ /* ---------------------------------------------- */
+
+ if (*ptr1 == 'b' || *ptr1 == 'B' || *ptr1 == 'i' || *ptr1 == 'I' ||
+ *ptr1 == 'j' || *ptr1 == 'J' || *ptr1 == 'd' || *ptr1 == 'D' ||
+ *ptr1 == 'r' || *ptr1 == 'R' || *ptr1 == 'f' || *ptr1 == 'F' ||
+ *ptr1 == 'u' || *ptr1 == 'U')
+ {
+ /* next optional character may be a b or l (for Big or Little) */
+ ptr1++;
+ if (*ptr1 == 'b' || *ptr1 == 'B' || *ptr1 == 'l' || *ptr1 == 'L')
+ ptr1++;
+
+ if (isdigit((int) *ptr1)) /* must have at least 1 digit */
+ {
+ while (isdigit((int) *ptr1))
+ ptr1++; /* skip over digits */
+
+ if (*ptr1 == ',' || *ptr1 == ':' || *ptr1 == ']' )
+ {
+ /* OK, this looks like a rawfile specifier */
+
+ if (urltype)
+ {
+ if (strstr(urltype, "stdin") )
+ strcpy(urltype, "rawstdin://");
+ else
+ strcpy(urltype, "rawfile://");
+ }
+
+ /* append the raw array specifier to infilex */
+ if (infilex)
+ {
+
+ if (strlen(infilex) + strlen(ptr3) > FLEN_FILENAME - 1)
+ {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strcat(infilex, ptr3);
+ ptr1 = strchr(infilex, ']'); /* find the closing ] char */
+ if (ptr1)
+ *(ptr1 + 1) = '\0'; /* terminate string after the ] */
+ }
+
+ if (extspec)
+ strcpy(extspec, "0"); /* the 0 ext number is implicit */
+
+ tmptr = strchr(ptr2 + 1, '[' ); /* search for another [ char */
+
+ /* copy any remaining characters into rowfilterx */
+ if (tmptr && rowfilterx)
+ {
+
+
+ if (strlen(rowfilterx) + strlen(tmptr + 1) > FLEN_FILENAME -1)
+ {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strcat(rowfilterx, tmptr + 1);
+
+ tmptr = strchr(rowfilterx, ']' ); /* search for closing ] */
+ if (tmptr)
+ *tmptr = '\0'; /* overwrite the ] with null terminator */
+ }
+
+ free(infile); /* finished parsing, so return */
+ return(*status);
+ }
+ }
+ } /* end of rawfile specifier test */
+
+ /* -------------------------------------------------------- */
+ /* Not a rawfile, so next, test if this is an image section */
+ /* i.e., an integer followed by a ':' or a '*' or '-*' */
+ /* -------------------------------------------------------- */
+
+ ptr1 = ptr3 + 1; /* reset pointer to first char after the [ */
+ tmptr = ptr1;
+
+ while (*tmptr == ' ')
+ tmptr++; /* skip leading blanks */
+
+ while (isdigit((int) *tmptr))
+ tmptr++; /* skip over leading digits */
+
+ if (*tmptr == ':' || *tmptr == '*' || *tmptr == '-')
+ {
+ /* this is an image section specifier */
+ strcat(rowfilter, ptr3);
+/*
+ don't want to assume 0 extension any more; may imply an image extension.
+ if (extspec)
+ strcpy(extspec, "0");
+*/
+ }
+ else
+ {
+ /* -----------------------------------------------------------------
+ Not an image section or rawfile spec so may be an extension spec.
+
+ Examples of valid extension specifiers:
+ [3] - 3rd extension; 0 = primary array
+ [events] - events extension
+ [events, 2] - events extension, with EXTVER = 2
+ [events,2] - spaces are optional
+ [events, 3, b] - same as above, plus XTENSION = 'BINTABLE'
+ [PICS; colName(12)] - an image in row 12 of the colName column
+ in the PICS table extension
+ [PICS; colName(exposure > 1000)] - as above, but find image in
+ first row with with exposure column value > 1000.
+ [Rate Table] - extension name can contain spaces!
+ [Rate Table;colName(exposure>1000)]
+
+ Examples of other types of specifiers (Not extension specifiers)
+
+ [bin] !!! this is ambiguous, and can't be distinguished from
+ a valid extension specifier
+ [bini X=1:512:16] (also binb, binj, binr, and bind are allowed)
+ [binr (X,Y) = 5]
+ [bin @binfilter.txt]
+
+ [col Time;rate]
+ [col PI=PHA * 1.1]
+ [col -Time; status]
+
+ [X > 5]
+ [X>5]
+ [ filter txt]
+ [StatusCol] !!! this is ambiguous, and can't be distinguished
+ from a valid extension specifier
+ [StatusCol==0]
+ [StatusCol || x>6]
+ [gtifilter()]
+ [regfilter("region.reg")]
+
+ There will always be some ambiguity between an extension name and
+ a boolean row filtering expression, (as in a couple of the above
+ examples). If there is any doubt, the expression should be treated
+ as an extension specification; The user can always add an explicit
+ expression specifier to override this interpretation.
+
+ The following decision logic will be used:
+
+ 1) locate the first token, terminated with a space, comma,
+ semi-colon, or closing bracket.
+
+ 2) the token is not part of an extension specifier if any of
+ the following is true:
+
+ - if the token begins with '@' and contains a '.'
+ - if the token contains an operator: = > < || &&
+ - if the token begins with "gtifilter(" or "regfilter("
+ - if the token is terminated by a space and is followed by
+ additional characters (not a ']') AND any of the following:
+ - the token is 'col'
+ - the token is 3 or 4 chars long and begins with 'bin'
+ - the second token begins with an operator:
+ ! = < > | & + - * / %
+
+
+ 3) otherwise, the string is assumed to be an extension specifier
+
+ ----------------------------------------------------------------- */
+
+ tmptr = ptr1;
+ while(*tmptr == ' ')
+ tmptr++;
+
+ hasAt = 0;
+ hasDot = 0;
+ hasOper = 0;
+ followingOper = 0;
+ spaceTerm = 0;
+ rowFilter = 0;
+ colStart = 0;
+ binStart = 0;
+ pixStart = 0;
+
+ if (*tmptr == '@') /* test for leading @ symbol */
+ hasAt = 1;
+
+ if ( !strncasecmp(tmptr, "col ", 4) )
+ colStart = 1;
+
+ if ( !strncasecmp(tmptr, "bin", 3) )
+ binStart = 1;
+
+ if ( !strncasecmp(tmptr, "pix", 3) )
+ pixStart = 1;
+
+ if ( !strncasecmp(tmptr, "gtifilter(", 10) ||
+ !strncasecmp(tmptr, "regfilter(", 10) )
+ {
+ rowFilter = 1;
+ }
+ else
+ {
+ /* parse the first token of the expression */
+ for (ii = 0; ii < ptr2 - ptr1 + 1; ii++, tmptr++)
+ {
+ if (*tmptr == '.')
+ hasDot = 1;
+ else if (*tmptr == '=' || *tmptr == '>' || *tmptr == '<' ||
+ (*tmptr == '|' && *(tmptr+1) == '|') ||
+ (*tmptr == '&' && *(tmptr+1) == '&') )
+ hasOper = 1;
+
+ else if (*tmptr == ',' || *tmptr == ';' || *tmptr == ']')
+ {
+ break;
+ }
+ else if (*tmptr == ' ') /* a space char? */
+ {
+ while(*tmptr == ' ') /* skip spaces */
+ tmptr++;
+
+ if (*tmptr == ']') /* is this the end? */
+ break;
+
+ spaceTerm = 1; /* 1st token is terminated by space */
+
+ /* test if this is a column or binning specifier */
+ if (colStart || (ii <= 4 && (binStart || pixStart)) )
+ rowFilter = 1;
+ else
+ {
+
+ /* check if next character is an operator */
+ if (*tmptr == '=' || *tmptr == '>' || *tmptr == '<' ||
+ *tmptr == '|' || *tmptr == '&' || *tmptr == '!' ||
+ *tmptr == '+' || *tmptr == '-' || *tmptr == '*' ||
+ *tmptr == '/' || *tmptr == '%')
+ followingOper = 1;
+ }
+ break;
+ }
+ }
+ }
+
+ /* test if this is NOT an extension specifier */
+ if ( rowFilter || (pixStart && spaceTerm) ||
+ (hasAt && hasDot) ||
+ hasOper ||
+ (spaceTerm && followingOper) )
+ {
+ /* this is (probably) not an extension specifier */
+ /* so copy all chars to filter spec string */
+ strcat(rowfilter, ptr3);
+ }
+ else
+ {
+ /* this appears to be a legit extension specifier */
+ /* copy the extension specification */
+ if (extspec) {
+ if (ptr2 - ptr1 > FLEN_FILENAME - 1) {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+ strncat(extspec, ptr1, ptr2 - ptr1);
+ }
+
+ /* copy any remaining chars to filter spec string */
+ strcat(rowfilter, ptr2 + 1);
+ }
+ }
+ } /* end of if (!plus_ext) */
+ else
+ {
+ /* ------------------------------------------------------------------ */
+ /* already have extension, so this must be a filter spec of some sort */
+ /* ------------------------------------------------------------------ */
+
+ strcat(rowfilter, ptr3);
+ }
+
+ /* strip off any trailing blanks from filter */
+ slen = strlen(rowfilter);
+ while ( (--slen) >= 0 && rowfilter[slen] == ' ')
+ rowfilter[slen] = '\0';
+
+ if (!rowfilter[0])
+ {
+ free(infile);
+ return(*status); /* nothing left to parse */
+ }
+
+ /* ------------------------------------------------ */
+ /* does the filter contain a binning specification? */
+ /* ------------------------------------------------ */
+
+ ptr1 = strstr(rowfilter, "[bin"); /* search for "[bin" */
+ if (!ptr1)
+ ptr1 = strstr(rowfilter, "[BIN"); /* search for "[BIN" */
+ if (!ptr1)
+ ptr1 = strstr(rowfilter, "[Bin"); /* search for "[Bin" */
+
+ if (ptr1)
+ {
+ ptr2 = ptr1 + 4; /* end of the '[bin' string */
+ if (*ptr2 == 'b' || *ptr2 == 'i' || *ptr2 == 'j' ||
+ *ptr2 == 'r' || *ptr2 == 'd')
+ ptr2++; /* skip the datatype code letter */
+
+
+ if ( *ptr2 != ' ' && *ptr2 != ']')
+ ptr1 = NULL; /* bin string must be followed by space or ] */
+ }
+
+ if (ptr1)
+ {
+ /* found the binning string */
+ if (binspec)
+ {
+ if (strlen(ptr1 +1) > FLEN_FILENAME - 1)
+ {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strcpy(binspec, ptr1 + 1);
+ ptr2 = strchr(binspec, ']');
+
+ if (ptr2) /* terminate the binning filter */
+ {
+ *ptr2 = '\0';
+
+ if ( *(--ptr2) == ' ') /* delete trailing spaces */
+ *ptr2 = '\0';
+ }
+ else
+ {
+ ffpmsg("input file URL is missing closing bracket ']'");
+ ffpmsg(rowfilter);
+ free(infile);
+ return(*status = URL_PARSE_ERROR); /* error, no closing ] */
+ }
+ }
+
+ /* delete the binning spec from the row filter string */
+ ptr2 = strchr(ptr1, ']');
+ strcpy(tmpstr, ptr2+1); /* copy any chars after the binspec */
+ strcpy(ptr1, tmpstr); /* overwrite binspec */
+ }
+
+ /* --------------------------------------------------------- */
+ /* does the filter contain a column selection specification? */
+ /* --------------------------------------------------------- */
+
+ ptr1 = strstr(rowfilter, "[col ");
+ if (!ptr1)
+ {
+ ptr1 = strstr(rowfilter, "[COL ");
+
+ if (!ptr1)
+ ptr1 = strstr(rowfilter, "[Col ");
+ }
+
+ if (ptr1)
+ { /* find the end of the column specifier */
+ ptr2 = ptr1 + 5;
+ while (*ptr2 != ']')
+ {
+ if (*ptr2 == '\0')
+ {
+ ffpmsg("input file URL is missing closing bracket ']'");
+ free(infile);
+ return(*status = URL_PARSE_ERROR); /* error, no closing ] */
+ }
+
+ if (*ptr2 == '\'') /* start of a literal string */
+ {
+ ptr2 = strchr(ptr2 + 1, '\''); /* find closing quote */
+ if (!ptr2)
+ {
+ ffpmsg
+ ("literal string in input file URL is missing closing single quote");
+ free(infile);
+ return(*status = URL_PARSE_ERROR); /* error, no closing ] */
+ }
+ }
+
+ if (*ptr2 == '[') /* set of nested square brackets */
+ {
+ ptr2 = strchr(ptr2 + 1, ']'); /* find closing bracket */
+ if (!ptr2)
+ {
+ ffpmsg
+ ("nested brackets in input file URL is missing closing bracket");
+ free(infile);
+ return(*status = URL_PARSE_ERROR); /* error, no closing ] */
+ }
+ }
+
+ ptr2++; /* continue search for the closing bracket character */
+ }
+
+ collen = ptr2 - ptr1 - 1;
+
+ if (colspec) /* copy the column specifier to output string */
+ {
+ if (collen > FLEN_FILENAME - 1) {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncpy(colspec, ptr1 + 1, collen);
+ colspec[collen] = '\0';
+
+ while (colspec[--collen] == ' ')
+ colspec[collen] = '\0'; /* strip trailing blanks */
+ }
+
+ /* delete the column selection spec from the row filter string */
+ strcpy(tmpstr, ptr2 + 1); /* copy any chars after the colspec */
+ strcpy(ptr1, tmpstr); /* overwrite binspec */
+ }
+
+ /* --------------------------------------------------------- */
+ /* does the filter contain a pixel filter specification? */
+ /* --------------------------------------------------------- */
+
+ ptr1 = strstr(rowfilter, "[pix");
+ if (!ptr1)
+ {
+ ptr1 = strstr(rowfilter, "[PIX");
+
+ if (!ptr1)
+ ptr1 = strstr(rowfilter, "[Pix");
+ }
+
+ if (ptr1)
+ {
+ ptr2 = ptr1 + 4; /* end of the '[pix' string */
+ if (*ptr2 == 'b' || *ptr2 == 'i' || *ptr2 == 'j' || *ptr2 == 'B' ||
+ *ptr2 == 'I' || *ptr2 == 'J' || *ptr2 == 'r' || *ptr2 == 'd' ||
+ *ptr2 == 'R' || *ptr2 == 'D')
+ ptr2++; /* skip the datatype code letter */
+
+ if (*ptr2 == '1')
+ ptr2++; /* skip the single HDU indicator */
+
+ if ( *ptr2 != ' ')
+ ptr1 = NULL; /* pix string must be followed by space */
+ }
+
+ if (ptr1)
+ { /* find the end of the pixel filter */
+ while (*ptr2 != ']')
+ {
+ if (*ptr2 == '\0')
+ {
+ ffpmsg("input file URL is missing closing bracket ']'");
+ free(infile);
+ return(*status = URL_PARSE_ERROR); /* error, no closing ] */
+ }
+
+ if (*ptr2 == '\'') /* start of a literal string */
+ {
+ ptr2 = strchr(ptr2 + 1, '\''); /* find closing quote */
+ if (!ptr2)
+ {
+ ffpmsg
+ ("literal string in input file URL is missing closing single quote");
+ free(infile);
+ return(*status = URL_PARSE_ERROR); /* error, no closing ] */
+ }
+ }
+
+ if (*ptr2 == '[') /* set of nested square brackets */
+ {
+ ptr2 = strchr(ptr2 + 1, ']'); /* find closing bracket */
+ if (!ptr2)
+ {
+ ffpmsg
+ ("nested brackets in input file URL is missing closing bracket");
+ free(infile);
+ return(*status = URL_PARSE_ERROR); /* error, no closing ] */
+ }
+ }
+
+ ptr2++; /* continue search for the closing bracket character */
+ }
+
+ collen = ptr2 - ptr1 - 1;
+
+ if (pixfilter) /* copy the column specifier to output string */
+ {
+ if (collen > FLEN_FILENAME - 1) {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncpy(pixfilter, ptr1 + 1, collen);
+ pixfilter[collen] = '\0';
+
+ while (pixfilter[--collen] == ' ')
+ pixfilter[collen] = '\0'; /* strip trailing blanks */
+ }
+
+ /* delete the pixel filter from the row filter string */
+ strcpy(tmpstr, ptr2 + 1); /* copy any chars after the pixel filter */
+ strcpy(ptr1, tmpstr); /* overwrite binspec */
+ }
+
+
+ /* copy the remaining string to the rowfilter output... should only */
+ /* contain a rowfilter expression of the form "[expr]" */
+
+ if (rowfilterx && rowfilter[0]) {
+ ptr2 = rowfilter + strlen(rowfilter) - 1;
+ if( rowfilter[0]=='[' && *ptr2==']' ) {
+ *ptr2 = '\0';
+
+ if (strlen(rowfilter + 1) > FLEN_FILENAME - 1)
+ {
+ free(infile);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strcpy(rowfilterx, rowfilter+1);
+ } else {
+ ffpmsg("input file URL lacks valid row filter expression");
+ *status = URL_PARSE_ERROR;
+ }
+ }
+
+ free(infile);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffexist(const char *infile, /* I - input filename or URL */
+ int *exists, /* O - 2 = a compressed version of file exists */
+ /* 1 = yes, disk file exists */
+ /* 0 = no, disk file could not be found */
+ /* -1 = infile is not a disk file (could */
+ /* be a http, ftp, gsiftp, smem, or stdin file) */
+ int *status) /* I/O status */
+
+/*
+ test if the input file specifier is an existing file on disk
+ If the specified file can't be found, it then searches for a
+ compressed version of the file.
+*/
+{
+ FILE *diskfile;
+ char rootname[FLEN_FILENAME];
+ char *ptr1;
+
+ if (*status > 0)
+ return(*status);
+
+ /* strip off any extname or filters from the name */
+ ffrtnm( (char *)infile, rootname, status);
+
+ ptr1 = strstr(rootname, "://");
+
+ if (ptr1 || *rootname == '-') {
+ if (!strncmp(rootname, "file", 4) ) {
+ ptr1 = ptr1 + 3; /* pointer to start of the disk file name */
+ } else {
+ *exists = -1; /* this is not a disk file */
+ return (*status);
+ }
+ } else {
+ ptr1 = rootname;
+ }
+
+ /* see if the disk file exists */
+ if (file_openfile(ptr1, 0, &diskfile)) {
+
+ /* no, couldn't open file, so see if there is a compressed version */
+ if (file_is_compressed(ptr1) ) {
+ *exists = 2; /* a compressed version of the file exists */
+ } else {
+ *exists = 0; /* neither file nor compressed version exist */
+ }
+
+ } else {
+
+ /* yes, file exists */
+ *exists = 1;
+ fclose(diskfile);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffrtnm(char *url,
+ char *rootname,
+ int *status)
+/*
+ parse the input URL, returning the root name (filetype://basename).
+*/
+
+{
+ int ii, jj, slen, infilelen;
+ char *ptr1, *ptr2, *ptr3;
+ char urltype[MAX_PREFIX_LEN];
+ char infile[FLEN_FILENAME];
+
+ if (*status > 0)
+ return(*status);
+
+ ptr1 = url;
+ *rootname = '\0';
+ *urltype = '\0';
+ *infile = '\0';
+
+ /* get urltype (e.g., file://, ftp://, http://, etc.) */
+ if (*ptr1 == '-') /* "-" means read file from stdin */
+ {
+ strcat(urltype, "-");
+ ptr1++;
+ }
+ else if (!strncmp(ptr1, "stdin", 5) || !strncmp(ptr1, "STDIN", 5))
+ {
+ strcat(urltype, "-");
+ ptr1 = ptr1 + 5;
+ }
+ else
+ {
+ ptr2 = strstr(ptr1, "://");
+ ptr3 = strstr(ptr1, "(" );
+
+ if (ptr3 && (ptr3 < ptr2) )
+ {
+ /* the urltype follows a '(' character, so it must apply */
+ /* to the output file, and is not the urltype of the input file */
+ ptr2 = 0; /* so reset pointer to zero */
+ }
+
+
+ if (ptr2) /* copy the explicit urltype string */
+ {
+
+ if (ptr2 - ptr1 + 3 > MAX_PREFIX_LEN - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+ strncat(urltype, ptr1, ptr2 - ptr1 + 3);
+ ptr1 = ptr2 + 3;
+ }
+ else if (!strncmp(ptr1, "ftp:", 4) )
+ { /* the 2 //'s are optional */
+ strcat(urltype, "ftp://";);
+ ptr1 += 4;
+ }
+ else if (!strncmp(ptr1, "gsiftp:", 7) )
+ { /* the 2 //'s are optional */
+ strcat(urltype, "gsiftp://";);
+ ptr1 += 7;
+ }
+ else if (!strncmp(ptr1, "http:", 5) )
+ { /* the 2 //'s are optional */
+ strcat(urltype, "http://";);
+ ptr1 += 5;
+ }
+ else if (!strncmp(ptr1, "mem:", 4) )
+ { /* the 2 //'s are optional */
+ strcat(urltype, "mem://");
+ ptr1 += 4;
+ }
+ else if (!strncmp(ptr1, "shmem:", 6) )
+ { /* the 2 //'s are optional */
+ strcat(urltype, "shmem://");
+ ptr1 += 6;
+ }
+ else if (!strncmp(ptr1, "file:", 5) )
+ { /* the 2 //'s are optional */
+ ptr1 += 5;
+ }
+
+ /* else assume file driver */
+ }
+
+ /* get the input file name */
+ ptr2 = strchr(ptr1, '('); /* search for opening parenthesis ( */
+ ptr3 = strchr(ptr1, '['); /* search for opening bracket [ */
+
+ if (ptr2 == ptr3) /* simple case: no [ or ( in the file name */
+ {
+
+ if (strlen(ptr1) > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strcat(infile, ptr1);
+ }
+ else if (!ptr3) /* no bracket, so () enclose output file name */
+ {
+
+ if (ptr2 - ptr1 > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(infile, ptr1, ptr2 - ptr1);
+ ptr2++;
+
+ ptr1 = strchr(ptr2, ')' ); /* search for closing ) */
+ if (!ptr1)
+ return(*status = URL_PARSE_ERROR); /* error, no closing ) */
+
+ }
+ else if (ptr2 && (ptr2 < ptr3)) /* () enclose output name before bracket */
+ {
+
+ if (ptr2 - ptr1 > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(infile, ptr1, ptr2 - ptr1);
+ ptr2++;
+
+ ptr1 = strchr(ptr2, ')' ); /* search for closing ) */
+ if (!ptr1)
+ return(*status = URL_PARSE_ERROR); /* error, no closing ) */
+ }
+ else /* bracket comes first, so there is no output name */
+ {
+ if (ptr3 - ptr1 > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(infile, ptr1, ptr3 - ptr1);
+ }
+
+ /* strip off any trailing blanks in the names */
+ slen = strlen(infile);
+ for (ii = slen - 1; ii > 0; ii--)
+ {
+ if (infile[ii] == ' ')
+ infile[ii] = '\0';
+ else
+ break;
+ }
+
+ /* --------------------------------------------- */
+ /* check if the 'filename+n' convention has been */
+ /* used to specifiy which HDU number to open */
+ /* --------------------------------------------- */
+
+ jj = strlen(infile);
+
+ for (ii = jj - 1; ii >= 0; ii--)
+ {
+ if (infile[ii] == '+') /* search backwards for '+' sign */
+ break;
+ }
+
+ if (ii > 0 && (jj - ii) < 5) /* limit extension numbers to 4 digits */
+ {
+ infilelen = ii;
+ ii++;
+
+
+ for (; ii < jj; ii++)
+ {
+ if (!isdigit((int) infile[ii] ) ) /* are all the chars digits? */
+ break;
+ }
+
+ if (ii == jj)
+ {
+ /* yes, the '+n' convention was used. */
+
+ infile[infilelen] = '\0'; /* delete the extension number */
+ }
+ }
+
+ if (strlen(urltype) + strlen(infile) > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strcat(rootname, urltype); /* construct the root name */
+ strcat(rootname, infile);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffourl(char *url, /* I - full input URL */
+ char *urltype, /* O - url type */
+ char *outfile, /* O - base file name */
+ char *tpltfile, /* O - template file name, if any */
+ char *compspec, /* O - compression specification, if any */
+ int *status)
+/*
+ parse the output URL into its basic components.
+*/
+
+{
+ char *ptr1, *ptr2, *ptr3;
+
+ if (*status > 0)
+ return(*status);
+
+ if (urltype)
+ *urltype = '\0';
+ if (outfile)
+ *outfile = '\0';
+ if (tpltfile)
+ *tpltfile = '\0';
+ if (compspec)
+ *compspec = '\0';
+
+ ptr1 = url;
+ while (*ptr1 == ' ') /* ignore leading blanks */
+ ptr1++;
+
+ if ( ( (*ptr1 == '-') && ( *(ptr1 +1) == 0 || *(ptr1 +1) == ' ' ) )
+ || !strcmp(ptr1, "stdout")
+ || !strcmp(ptr1, "STDOUT"))
+
+ /* "-" means write to stdout; also support "- " */
+ /* but exclude disk file names that begin with a minus sign */
+ /* e.g., "-55d33m.fits" */
+ {
+ if (urltype)
+ strcpy(urltype, "stdout://");
+ }
+ else
+ {
+ /* not writing to stdout */
+ /* get urltype (e.g., file://, ftp://, http://, etc.) */
+
+ ptr2 = strstr(ptr1, "://");
+ if (ptr2) /* copy the explicit urltype string */
+ {
+ if (urltype) {
+ if (ptr2 - ptr1 + 3 > MAX_PREFIX_LEN - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(urltype, ptr1, ptr2 - ptr1 + 3);
+ }
+
+ ptr1 = ptr2 + 3;
+ }
+ else /* assume file driver */
+ {
+ if (urltype)
+ strcat(urltype, "file://");
+ }
+
+ /* look for template file name, enclosed in parenthesis */
+ ptr2 = strchr(ptr1, '(');
+
+ /* look for image compression parameters, enclosed in sq. brackets */
+ ptr3 = strchr(ptr1, '[');
+
+ if (outfile)
+ {
+ if (ptr2) { /* template file was specified */
+ if (ptr2 - ptr1 > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(outfile, ptr1, ptr2 - ptr1);
+ } else if (ptr3) { /* compression was specified */
+ if (ptr3 - ptr1 > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+ strncat(outfile, ptr1, ptr3 - ptr1);
+
+ } else { /* no template file or compression */
+ if (strlen(ptr1) > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+ strcpy(outfile, ptr1);
+ }
+ }
+
+
+ if (ptr2) /* template file was specified */
+ {
+ ptr2++;
+
+ ptr1 = strchr(ptr2, ')' ); /* search for closing ) */
+
+ if (!ptr1)
+ {
+ return(*status = URL_PARSE_ERROR); /* error, no closing ) */
+ }
+
+ if (tpltfile) {
+ if (ptr1 - ptr2 > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+ strncat(tpltfile, ptr2, ptr1 - ptr2);
+ }
+ }
+
+ if (ptr3) /* compression was specified */
+ {
+ ptr3++;
+
+ ptr1 = strchr(ptr3, ']' ); /* search for closing ] */
+
+ if (!ptr1)
+ {
+ return(*status = URL_PARSE_ERROR); /* error, no closing ] */
+ }
+
+ if (compspec) {
+
+ if (ptr1 - ptr3 > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(compspec, ptr3, ptr1 - ptr3);
+ }
+ }
+
+ /* check if a .gz compressed output file is to be created */
+ /* by seeing if the filename ends in '.gz' */
+ if (urltype && outfile)
+ {
+ if (!strcmp(urltype, "file://") )
+ {
+ ptr1 = strstr(outfile, ".gz");
+ if (ptr1)
+ { /* make sure the ".gz" is at the end of the file name */
+ ptr1 += 3;
+ if (*ptr1 == 0 || *ptr1 == ' ' )
+ strcpy(urltype, "compressoutfile://");
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffexts(char *extspec,
+ int *extnum,
+ char *extname,
+ int *extvers,
+ int *hdutype,
+ char *imagecolname,
+ char *rowexpress,
+ int *status)
+{
+/*
+ Parse the input extension specification string, returning either the
+ extension number or the values of the EXTNAME, EXTVERS, and XTENSION
+ keywords in desired extension. Also return the name of the column containing
+ an image, and an expression to be used to determine which row to use,
+ if present.
+*/
+ char *ptr1, *ptr2;
+ int slen, nvals;
+ int notint = 1; /* initially assume specified extname is not an integer */
+ char tmpname[FLEN_VALUE], *loc;
+
+ *extnum = 0;
+ *extname = '\0';
+ *extvers = 0;
+ *hdutype = ANY_HDU;
+ *imagecolname = '\0';
+ *rowexpress = '\0';
+
+ if (*status > 0)
+ return(*status);
+
+ ptr1 = extspec; /* pointer to first char */
+
+ while (*ptr1 == ' ') /* skip over any leading blanks */
+ ptr1++;
+
+ if (isdigit((int) *ptr1)) /* is the extension specification a number? */
+ {
+ notint = 0; /* looks like extname may actually be the ext. number */
+ errno = 0; /* reset this prior to calling strtol */
+ *extnum = strtol(ptr1, &loc, 10); /* read the string as an integer */
+
+ while (*loc == ' ') /* skip over trailing blanks */
+ loc++;
+
+ /* check for read error, or junk following the integer */
+ if ((*loc != '\0' && *loc != ';' ) || (errno == ERANGE) )
+ {
+ *extnum = 0;
+ notint = 1; /* no, extname was not a simple integer after all */
+ errno = 0; /* reset error condition flag if it was set */
+ }
+
+ if ( *extnum < 0 || *extnum > 99999)
+ {
+ *extnum = 0; /* this is not a reasonable extension number */
+ ffpmsg("specified extension number is out of range:");
+ ffpmsg(extspec);
+ return(*status = URL_PARSE_ERROR);
+ }
+ }
+
+
+/* This logic was too simple, and failed on extnames like '1000TEMP'
+ where it would try to move to the 1000th extension
+
+ if (isdigit((int) *ptr1))
+ {
+ sscanf(ptr1, "%d", extnum);
+ if (*extnum < 0 || *extnum > 9999)
+ {
+ *extnum = 0;
+ ffpmsg("specified extension number is out of range:");
+ ffpmsg(extspec);
+ return(*status = URL_PARSE_ERROR);
+ }
+ }
+*/
+
+ if (notint)
+ {
+ /* not a number, so EXTNAME must be specified, followed by */
+ /* optional EXTVERS and XTENSION values */
+
+ /* don't use space char as end indicator, because there */
+ /* may be imbedded spaces in the EXTNAME value */
+ slen = strcspn(ptr1, ",:;"); /* length of EXTNAME */
+
+ if (slen > FLEN_VALUE - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(extname, ptr1, slen); /* EXTNAME value */
+
+ /* now remove any trailing blanks */
+ while (slen > 0 && *(extname + slen -1) == ' ')
+ {
+ *(extname + slen -1) = '\0';
+ slen--;
+ }
+
+ ptr1 += slen;
+ slen = strspn(ptr1, " ,:"); /* skip delimiter characters */
+ ptr1 += slen;
+
+ slen = strcspn(ptr1, " ,:;"); /* length of EXTVERS */
+ if (slen)
+ {
+ nvals = sscanf(ptr1, "%d", extvers); /* EXTVERS value */
+ if (nvals != 1)
+ {
+ ffpmsg("illegal EXTVER value in input URL:");
+ ffpmsg(extspec);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ ptr1 += slen;
+ slen = strspn(ptr1, " ,:"); /* skip delimiter characters */
+ ptr1 += slen;
+
+ slen = strcspn(ptr1, ";"); /* length of HDUTYPE */
+ if (slen)
+ {
+ if (*ptr1 == 'b' || *ptr1 == 'B')
+ *hdutype = BINARY_TBL;
+ else if (*ptr1 == 't' || *ptr1 == 'T' ||
+ *ptr1 == 'a' || *ptr1 == 'A')
+ *hdutype = ASCII_TBL;
+ else if (*ptr1 == 'i' || *ptr1 == 'I')
+ *hdutype = IMAGE_HDU;
+ else
+ {
+ ffpmsg("unknown type of HDU in input URL:");
+ ffpmsg(extspec);
+ return(*status = URL_PARSE_ERROR);
+ }
+ }
+ }
+ else
+ {
+ strcpy(tmpname, extname);
+ ffupch(tmpname);
+ if (!strcmp(tmpname, "PRIMARY") || !strcmp(tmpname, "P") )
+ *extname = '\0'; /* return extnum = 0 */
+ }
+ }
+
+ ptr1 = strchr(ptr1, ';');
+ if (ptr1)
+ {
+ /* an image is to be opened; the image is contained in a single */
+ /* cell of a binary table. A column name and an expression to */
+ /* determine which row to use has been entered. */
+
+ ptr1++; /* skip over the ';' delimiter */
+ while (*ptr1 == ' ') /* skip over any leading blanks */
+ ptr1++;
+
+ ptr2 = strchr(ptr1, '(');
+ if (!ptr2)
+ {
+ ffpmsg("illegal specification of image in table cell in input URL:");
+ ffpmsg(" did not find a row expression enclosed in ( )");
+ ffpmsg(extspec);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ if (ptr2 - ptr1 > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(imagecolname, ptr1, ptr2 - ptr1); /* copy column name */
+
+ ptr2++; /* skip over the '(' delimiter */
+ while (*ptr2 == ' ') /* skip over any leading blanks */
+ ptr2++;
+
+
+ ptr1 = strchr(ptr2, ')');
+ if (!ptr2)
+ {
+ ffpmsg("illegal specification of image in table cell in input URL:");
+ ffpmsg(" missing closing ')' character in row expression");
+ ffpmsg(extspec);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ if (ptr1 - ptr2 > FLEN_FILENAME - 1)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ strncat(rowexpress, ptr2, ptr1 - ptr2); /* row expression */
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffextn(char *url, /* I - input filename/URL */
+ int *extension_num, /* O - returned extension number */
+ int *status)
+{
+/*
+ Parse the input url string and return the number of the extension that
+ CFITSIO would automatically move to if CFITSIO were to open this input URL.
+ The extension numbers are one's based, so 1 = the primary array, 2 = the
+ first extension, etc.
+
+ The extension number that gets returned is determined by the following
+ algorithm:
+
+ 1. If the input URL includes a binning specification (e.g.
+ 'myfile.fits[3][bin X,Y]') then the returned extension number
+ will always = 1, since CFITSIO would create a temporary primary
+ image on the fly in this case. The same is true if an image
+ within a single cell of a binary table is opened.
+
+ 2. Else if the input URL specifies an extension number (e.g.,
+ 'myfile.fits[3]' or 'myfile.fits+3') then the specified extension
+ number (+ 1) is returned.
+
+ 3. Else if the extension name is specified in brackets
+ (e.g., this 'myfile.fits[EVENTS]') then the file will be opened and searched
+ for the extension number. If the input URL is '-' (reading from the stdin
+ file stream) this is not possible and an error will be returned.
+
+ 4. Else if the URL does not specify an extension (e.g. 'myfile.fits') then
+ a special extension number = -99 will be returned to signal that no
+ extension was specified. This feature is mainly for compatibility with
+ existing FTOOLS software. CFITSIO would open the primary array by default
+ (extension_num = 1) in this case.
+
+*/
+ fitsfile *fptr;
+ char urltype[20];
+ char infile[FLEN_FILENAME];
+ char outfile[FLEN_FILENAME];
+ char extspec[FLEN_FILENAME];
+ char extname[FLEN_FILENAME];
+ char rowfilter[FLEN_FILENAME];
+ char binspec[FLEN_FILENAME];
+ char colspec[FLEN_FILENAME];
+ char imagecolname[FLEN_VALUE], rowexpress[FLEN_FILENAME];
+ char *cptr;
+ int extnum, extvers, hdutype, tstatus = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* parse the input URL into its basic components */
+ fits_parse_input_url(url, urltype, infile, outfile,
+ extspec, rowfilter,binspec, colspec, status);
+
+ if (*status > 0)
+ return(*status);
+
+ if (*binspec) /* is there a binning specification? */
+ {
+ *extension_num = 1; /* a temporary primary array image is created */
+ return(*status);
+ }
+
+ if (*extspec) /* is an extension specified? */
+ {
+ ffexts(extspec, &extnum,
+ extname, &extvers, &hdutype, imagecolname, rowexpress, status);
+
+ if (*status > 0)
+ return(*status);
+
+ if (*imagecolname) /* is an image within a table cell being opened? */
+ {
+ *extension_num = 1; /* a temporary primary array image is created */
+ return(*status);
+ }
+
+ if (*extname)
+ {
+ /* have to open the file to search for the extension name (curses!) */
+
+ if (!strcmp(urltype, "stdin://"))
+ /* opening stdin would destroying it! */
+ return(*status = URL_PARSE_ERROR);
+
+ /* First, strip off any filtering specification */
+ infile[0] = '\0';
+ strncat(infile, url, FLEN_FILENAME -1);
+
+ cptr = strchr(infile, ']'); /* locate the closing bracket */
+ if (!cptr)
+ {
+ return(*status = URL_PARSE_ERROR);
+ }
+ else
+ {
+ cptr++;
+ *cptr = '\0'; /* terminate URl after the extension spec */
+ }
+
+ if (ffopen(&fptr, infile, READONLY, status) > 0) /* open the file */
+ {
+ ffclos(fptr, &tstatus);
+ return(*status);
+ }
+
+ ffghdn(fptr, &extnum); /* where am I in the file? */
+ *extension_num = extnum;
+ ffclos(fptr, status);
+
+ return(*status);
+ }
+ else
+ {
+ *extension_num = extnum + 1; /* return the specified number (+ 1) */
+ return(*status);
+ }
+ }
+ else
+ {
+ *extension_num = -99; /* no specific extension was specified */
+ /* defaults to primary array */
+ return(*status);
+ }
+}
+/*--------------------------------------------------------------------------*/
+
+int ffurlt(fitsfile *fptr, char *urlType, int *status)
+/*
+ return the prefix string associated with the driver in use by the
+ fitsfile pointer fptr
+*/
+
+{
+ strcpy(urlType, driverTable[fptr->Fptr->driver].prefix);
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int ffimport_file( char *filename, /* Text file to read */
+ char **contents, /* Pointer to pointer to hold file */
+ int *status ) /* CFITSIO error code */
+/*
+ Read and concatenate all the lines from the given text file. User
+ must free the pointer returned in contents. Pointer is guaranteed
+ to hold 2 characters more than the length of the text... allows the
+ calling routine to append (or prepend) a newline (or quotes?) without
+ reallocating memory.
+*/
+{
+ int allocLen, totalLen, llen, eoline;
+ char *lines,line[256];
+ FILE *aFile;
+
+ if( *status > 0 ) return( *status );
+
+ totalLen = 0;
+ allocLen = 1024;
+ lines = (char *)malloc( allocLen * sizeof(char) );
+ if( !lines ) {
+ ffpmsg("Couldn't allocate memory to hold ASCII file contents.");
+ return(*status = MEMORY_ALLOCATION );
+ }
+ lines[0] = '\0';
+
+ if( (aFile = fopen( filename, "r" ))==NULL ) {
+ sprintf(line,"Could not open ASCII file %s.",filename);
+ ffpmsg(line);
+ free( lines );
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ while( fgets(line,256,aFile)!=NULL ) {
+ llen = strlen(line);
+ if ((llen > 1) && (line[0] == '/' && line[1] == '/'))
+ continue; /* skip comment lines begging with // */
+
+ eoline = 0;
+
+ /* replace CR and newline chars at end of line with nulls */
+ if ((llen > 0) && (line[llen-1]=='\n' || line[llen-1] == '\r')) {
+ line[--llen] = '\0';
+ eoline = 1; /* found an end of line character */
+
+ if ((llen > 0) && (line[llen-1]=='\n' || line[llen-1] == '\r')) {
+ line[--llen] = '\0';
+ }
+ }
+
+ if( totalLen + llen + 3 >= allocLen ) {
+ allocLen += 256;
+ lines = (char *)realloc(lines, allocLen * sizeof(char) );
+ if( ! lines ) {
+ ffpmsg("Couldn't allocate memory to hold ASCII file contents.");
+ *status = MEMORY_ALLOCATION;
+ break;
+ }
+ }
+ strcpy( lines+totalLen, line );
+ totalLen += llen;
+
+ if (eoline) {
+ strcpy( lines+totalLen, " "); /* add a space between lines */
+ totalLen += 1;
+ }
+ }
+ fclose(aFile);
+
+ *contents = lines;
+ return( *status );
+}
+
+/*--------------------------------------------------------------------------*/
+int fits_get_token(char **ptr,
+ char *delimiter,
+ char *token,
+ int *isanumber) /* O - is this token a number? */
+/*
+ parse off the next token, delimited by a character in 'delimiter',
+ from the input ptr string; increment *ptr to the end of the token.
+ Returns the length of the token, not including the delimiter char;
+*/
+{
+ char *loc, tval[73];
+ int slen;
+ double dval;
+
+ *token = '\0';
+
+ while (**ptr == ' ') /* skip over leading blanks */
+ (*ptr)++;
+
+ slen = strcspn(*ptr, delimiter); /* length of next token */
+ if (slen)
+ {
+ strncat(token, *ptr, slen); /* copy token */
+
+ (*ptr) += slen; /* skip over the token */
+
+ if (isanumber) /* check if token is a number */
+ {
+ *isanumber = 1;
+
+ if (strchr(token, 'D')) {
+ strcpy(tval, token);
+
+ /* The C language does not support a 'D'; replace with 'E' */
+ if (loc = strchr(tval, 'D')) *loc = 'E';
+
+ dval = strtod(tval, &loc);
+ } else {
+ dval = strtod(token, &loc);
+ }
+
+ /* check for read error, or junk following the value */
+ if (*loc != '\0' && *loc != ' ' ) *isanumber = 0;
+ if (errno == ERANGE) *isanumber = 0;
+ }
+ }
+
+ return(slen);
+}
+/*---------------------------------------------------------------------------*/
+char *fits_split_names(
+ char *list) /* I - input list of names */
+{
+/*
+ A sequence of calls to fits_split_names will split the input string
+ into name tokens. The string typically contains a list of file or
+ column names. The names must be delimited by a comma and/or spaces.
+ This routine ignores spaces and commas that occur within parentheses,
+ brackets, or curly brackets. It also strips any leading and trailing
+ blanks from the returned name.
+
+ This routine is similar to the ANSI C 'strtok' function:
+
+ The first call to fits_split_names has a non-null input string.
+ It finds the first name in the string and terminates it by
+ overwriting the next character of the string with a '\0' and returns
+ a pointer to the name. Each subsequent call, indicated by a NULL
+ value of the input string, returns the next name, searching from
+ just past the end of the previous name. It returns NULL when no
+ further names are found.
+
+ The following line illustrates how a string would be split into 3 names:
+ myfile[1][bin (x,y)=4], file2.fits file3.fits
+ ^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^ ^^^^^^^^^^
+ 1st name 2nd name 3rd name
+
+
+NOTE: This routine is not thread-safe.
+This routine is simply provided as a utility routine for other external
+software. It is not used by any CFITSIO routine.
+
+*/
+ int depth = 0;
+ char *start;
+ static char *ptr;
+
+ if (list) /* reset ptr if a string is given */
+ ptr = list;
+
+ while (*ptr == ' ')ptr++; /* skip leading white space */
+
+ if (*ptr == '\0')return(0); /* no remaining file names */
+
+ start = ptr;
+
+ while (*ptr != '\0') {
+ if ((*ptr == '[') || (*ptr == '(') || (*ptr == '{')) depth ++;
+ else if ((*ptr == '}') || (*ptr == ')') || (*ptr == ']')) depth --;
+ else if ((depth == 0) && (*ptr == ',' || *ptr == ' ')) {
+ *ptr = '\0'; /* terminate the filename here */
+ ptr++; /* save pointer to start of next filename */
+ break;
+ }
+ ptr++;
+ }
+
+ return(start);
+}
+/*--------------------------------------------------------------------------*/
+int urltype2driver(char *urltype, int *driver)
+/*
+ compare input URL with list of known drivers, returning the
+ matching driver numberL.
+*/
+
+{
+ int ii;
+
+ /* find matching driver; search most recent drivers first */
+
+ for (ii=no_of_drivers - 1; ii >= 0; ii--)
+ {
+ if (0 == strcmp(driverTable[ii].prefix, urltype))
+ {
+ *driver = ii;
+ return(0);
+ }
+ }
+
+ return(NO_MATCHING_DRIVER);
+}
+/*--------------------------------------------------------------------------*/
+int ffclos(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ close the FITS file by completing the current HDU, flushing it to disk,
+ then calling the system dependent routine to physically close the FITS file
+*/
+{
+ int tstatus = NO_CLOSE_ERROR, zerostatus = 0;
+
+ if (!fptr)
+ return(*status = NULL_INPUT_PTR);
+ else if ((fptr->Fptr)->validcode != VALIDSTRUC) /* check for magic value */
+ return(*status = BAD_FILEPTR);
+
+ /* close and flush the current HDU */
+ if (*status > 0)
+ ffchdu(fptr, &tstatus); /* turn off the error message from ffchdu */
+ else
+ ffchdu(fptr, status);
+
+ ((fptr->Fptr)->open_count)--; /* decrement usage counter */
+
+ if ((fptr->Fptr)->open_count == 0) /* if no other files use structure */
+ {
+ ffflsh(fptr, TRUE, status); /* flush and disassociate IO buffers */
+
+ /* call driver function to actually close the file */
+ if ((*driverTable[(fptr->Fptr)->driver].close)((fptr->Fptr)->filehandle))
+ {
+ if (*status <= 0)
+ {
+ *status = FILE_NOT_CLOSED; /* report if no previous error */
+
+ ffpmsg("failed to close the following file: (ffclos)");
+ ffpmsg((fptr->Fptr)->filename);
+ }
+ }
+
+ fits_clear_Fptr( fptr->Fptr, status); /* clear Fptr address */
+ free((fptr->Fptr)->iobuffer); /* free memory for I/O buffers */
+ free((fptr->Fptr)->headstart); /* free memory for headstart array */
+ free((fptr->Fptr)->filename); /* free memory for the filename */
+ (fptr->Fptr)->filename = 0;
+ (fptr->Fptr)->validcode = 0; /* magic value to indicate invalid fptr */
+ free(fptr->Fptr); /* free memory for the FITS file structure */
+ free(fptr); /* free memory for the FITS file structure */
+ }
+ else
+ {
+ /*
+ to minimize the fallout from any previous error (e.g., trying to
+ open a non-existent extension in a already opened file),
+ always call ffflsh with status = 0.
+ */
+ /* just flush the buffers, don't disassociate them */
+ if (*status > 0)
+ ffflsh(fptr, FALSE, &zerostatus);
+ else
+ ffflsh(fptr, FALSE, status);
+
+ free(fptr); /* free memory for the FITS file structure */
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdelt(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ close and DELETE the FITS file.
+*/
+{
+ char *basename;
+ int slen, tstatus = 0;
+
+ if (!fptr)
+ return(*status = NULL_INPUT_PTR);
+ else if ((fptr->Fptr)->validcode != VALIDSTRUC) /* check for magic value */
+ return(*status = BAD_FILEPTR);
+
+ ffchdu(fptr, status); /* close the current HDU, ignore any errors */
+ ffflsh(fptr, TRUE, status); /* flush and disassociate IO buffers */
+
+ /* call driver function to actually close the file */
+ if ( (*driverTable[(fptr->Fptr)->driver].close)((fptr->Fptr)->filehandle) )
+ {
+ if (*status <= 0)
+ {
+ *status = FILE_NOT_CLOSED; /* report error if no previous error */
+
+ ffpmsg("failed to close the following file: (ffdelt)");
+ ffpmsg((fptr->Fptr)->filename);
+ }
+ }
+
+ /* call driver function to actually delete the file */
+ if ( (driverTable[(fptr->Fptr)->driver].remove) )
+ {
+ /* parse the input URL to get the base filename */
+ slen = strlen((fptr->Fptr)->filename);
+ basename = (char *) malloc(slen +1);
+ if (!basename)
+ return(*status = MEMORY_ALLOCATION);
+
+ fits_parse_input_url((fptr->Fptr)->filename, NULL, basename, NULL, NULL, NULL, NULL,
+ NULL, &tstatus);
+
+ if ((*driverTable[(fptr->Fptr)->driver].remove)(basename))
+ {
+ ffpmsg("failed to delete the following file: (ffdelt)");
+ ffpmsg((fptr->Fptr)->filename);
+ if (!(*status))
+ *status = FILE_NOT_CLOSED;
+ }
+ free(basename);
+ }
+
+ fits_clear_Fptr( fptr->Fptr, status); /* clear Fptr address */
+ free((fptr->Fptr)->iobuffer); /* free memory for I/O buffers */
+ free((fptr->Fptr)->headstart); /* free memory for headstart array */
+ free((fptr->Fptr)->filename); /* free memory for the filename */
+ (fptr->Fptr)->filename = 0;
+ (fptr->Fptr)->validcode = 0; /* magic value to indicate invalid fptr */
+ free(fptr->Fptr); /* free memory for the FITS file structure */
+ free(fptr); /* free memory for the FITS file structure */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fftrun( fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG filesize, /* I - size to truncate the file */
+ int *status) /* O - error status */
+/*
+ low level routine to truncate a file to a new smaller size.
+*/
+{
+ if (driverTable[(fptr->Fptr)->driver].truncate)
+ {
+ ffflsh(fptr, FALSE, status); /* flush all the buffers first */
+ (fptr->Fptr)->filesize = filesize;
+ (fptr->Fptr)->io_pos = filesize;
+ (fptr->Fptr)->logfilesize = filesize;
+ (fptr->Fptr)->bytepos = filesize;
+ ffbfeof(fptr, status); /* eliminate any buffers beyond current EOF */
+ return (*status =
+ (*driverTable[(fptr->Fptr)->driver].truncate)((fptr->Fptr)->filehandle,
+ filesize) );
+ }
+ else
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffflushx( FITSfile *fptr) /* I - FITS file pointer */
+/*
+ low level routine to flush internal file buffers to the file.
+*/
+{
+ if (driverTable[fptr->driver].flush)
+ return ( (*driverTable[fptr->driver].flush)(fptr->filehandle) );
+ else
+ return(0); /* no flush function defined for this driver */
+}
+/*--------------------------------------------------------------------------*/
+int ffseek( FITSfile *fptr, /* I - FITS file pointer */
+ LONGLONG position) /* I - byte position to seek to */
+/*
+ low level routine to seek to a position in a file.
+*/
+{
+ return( (*driverTable[fptr->driver].seek)(fptr->filehandle, position) );
+}
+/*--------------------------------------------------------------------------*/
+int ffwrite( FITSfile *fptr, /* I - FITS file pointer */
+ long nbytes, /* I - number of bytes to write */
+ void *buffer, /* I - buffer to write */
+ int *status) /* O - error status */
+/*
+ low level routine to write bytes to a file.
+*/
+{
+ if ( (*driverTable[fptr->driver].write)(fptr->filehandle, buffer, nbytes) )
+ {
+ ffpmsg("Error writing data buffer to file:");
+ ffpmsg(fptr->filename);
+
+ *status = WRITE_ERROR;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffread( FITSfile *fptr, /* I - FITS file pointer */
+ long nbytes, /* I - number of bytes to read */
+ void *buffer, /* O - buffer to read into */
+ int *status) /* O - error status */
+/*
+ low level routine to read bytes from a file.
+*/
+{
+ int readstatus;
+
+ readstatus = (*driverTable[fptr->driver].read)(fptr->filehandle,
+ buffer, nbytes);
+
+ if (readstatus == END_OF_FILE)
+ *status = END_OF_FILE;
+ else if (readstatus > 0)
+ {
+ ffpmsg("Error reading data buffer from file:");
+ ffpmsg(fptr->filename);
+
+ *status = READ_ERROR;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fftplt(fitsfile **fptr, /* O - FITS file pointer */
+ const char *filename, /* I - name of file to create */
+ const char *tempname, /* I - name of template file */
+ int *status) /* IO - error status */
+/*
+ Create and initialize a new FITS file based on a template file.
+ Uses C fopen and fgets functions.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ if ( ffinit(fptr, filename, status) ) /* create empty file */
+ return(*status);
+
+ ffoptplt(*fptr, tempname, status); /* open and use template */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffoptplt(fitsfile *fptr, /* O - FITS file pointer */
+ const char *tempname, /* I - name of template file */
+ int *status) /* IO - error status */
+/*
+ open template file and use it to create new file
+*/
+{
+ fitsfile *tptr;
+ int tstatus = 0, nkeys, nadd, ii;
+ char card[FLEN_CARD];
+
+ if (*status > 0)
+ return(*status);
+
+ if (tempname == NULL || *tempname == '\0') /* no template file? */
+ return(*status);
+
+ /* try opening template */
+ ffopen(&tptr, (char *) tempname, READONLY, &tstatus);
+
+ if (tstatus) /* not a FITS file, so treat it as an ASCII template */
+ {
+ ffxmsg(2, card); /* clear the error message */
+ fits_execute_template(fptr, (char *) tempname, status);
+
+ ffmahd(fptr, 1, 0, status); /* move back to the primary array */
+ return(*status);
+ }
+ else /* template is a valid FITS file */
+ {
+ ffmahd(tptr, 1, NULL, status); /* make sure we are at the beginning */
+ while (*status <= 0)
+ {
+ ffghsp(tptr, &nkeys, &nadd, status); /* get no. of keywords */
+
+ for (ii = 1; ii <= nkeys; ii++) /* copy keywords */
+ {
+ ffgrec(tptr, ii, card, status);
+
+ /* must reset the PCOUNT keyword to zero in the new output file */
+ if (strncmp(card, "PCOUNT ",8) == 0) { /* the PCOUNT keyword? */
+ if (strncmp(card+25, " 0", 5)) { /* non-zero value? */
+ strncpy(card, "PCOUNT = 0", 30);
+ }
+ }
+
+ ffprec(fptr, card, status);
+ }
+
+ ffmrhd(tptr, 1, 0, status); /* move to next HDU until error */
+ ffcrhd(fptr, status); /* create empty new HDU in output file */
+ }
+
+ if (*status == END_OF_FILE)
+ {
+ *status = 0; /* expected error condition */
+ }
+ ffclos(tptr, status); /* close the template file */
+ }
+
+ ffmahd(fptr, 1, 0, status); /* move to the primary array */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+void ffrprt( FILE *stream, int status)
+/*
+ Print out report of cfitsio error status and messages on the error stack.
+ Uses C FILE stream.
+*/
+{
+ char status_str[FLEN_STATUS], errmsg[FLEN_ERRMSG];
+
+ if (status)
+ {
+
+ fits_get_errstatus(status, status_str); /* get the error description */
+ fprintf(stream, "\nFITSIO status = %d: %s\n", status, status_str);
+
+ while ( fits_read_errmsg(errmsg) ) /* get error stack messages */
+ fprintf(stream, "%s\n", errmsg);
+ }
+ return;
+}
+/*--------------------------------------------------------------------------*/
+int pixel_filter_helper(
+ fitsfile **fptr, /* IO - pointer to input image; on output it */
+ /* points to the new image */
+ char *outfile, /* I - name for output file */
+ char *expr, /* I - Image filter expression */
+ int *status)
+{
+ PixelFilter filter = { 0 };
+ char * DEFAULT_TAG = "X";
+ int ii, hdunum;
+ int singleHDU = 0;
+
+ filter.count = 1;
+ filter.ifptr = fptr;
+ filter.tag = &DEFAULT_TAG;
+
+ /* create new empty file for result */
+ if (ffinit(&filter.ofptr, outfile, status) > 0)
+ {
+ ffpmsg("failed to create output file for pixel filter:");
+ ffpmsg(outfile);
+ return(*status);
+ }
+
+ fits_get_hdu_num(*fptr, &hdunum); /* current HDU number in input file */
+
+ expr += 3; /* skip 'pix' */
+ switch (expr[0]) {
+ case 'b':
+ case 'B': filter.bitpix = BYTE_IMG; break;
+ case 'i':
+ case 'I': filter.bitpix = SHORT_IMG; break;
+ case 'j':
+ case 'J': filter.bitpix = LONG_IMG; break;
+ case 'r':
+ case 'R': filter.bitpix = FLOAT_IMG; break;
+ case 'd':
+ case 'D': filter.bitpix = DOUBLE_IMG; break;
+ }
+ if (filter.bitpix) /* skip bitpix indicator */
+ ++expr;
+
+ if (*expr == '1') {
+ ++expr;
+ singleHDU = 1;
+ }
+
+ if (((*fptr)->Fptr)->only_one)
+ singleHDU = 1;
+
+ if (*expr != ' ') {
+ ffpmsg("pixel filtering expression not space separated:");
+ ffpmsg(expr);
+ }
+ while (*expr == ' ')
+ ++expr;
+
+ /* copy all preceding extensions to the output file */
+ for (ii = 1; !singleHDU && ii < hdunum; ii++)
+ {
+ fits_movabs_hdu(*fptr, ii, NULL, status);
+ if (fits_copy_hdu(*fptr, filter.ofptr, 0, status) > 0)
+ {
+ ffclos(filter.ofptr, status);
+ return(*status);
+ }
+ }
+
+ /* move back to the original HDU position */
+ fits_movabs_hdu(*fptr, hdunum, NULL, status);
+
+ filter.expression = expr;
+ if (fits_pixel_filter(&filter, status)) {
+ ffpmsg("failed to execute image filter:");
+ ffpmsg(expr);
+ ffclos(filter.ofptr, status);
+ return(*status);
+ }
+
+
+ /* copy any remaining HDUs to the output file */
+
+ for (ii = hdunum + 1; !singleHDU; ii++)
+ {
+ if (fits_movabs_hdu(*fptr, ii, NULL, status) > 0)
+ break;
+
+ fits_copy_hdu(*fptr, filter.ofptr, 0, status);
+ }
+
+ if (*status == END_OF_FILE)
+ *status = 0; /* got the expected EOF error; reset = 0 */
+ else if (*status > 0)
+ {
+ ffclos(filter.ofptr, status);
+ return(*status);
+ }
+
+ /* close the original file and return ptr to the new image */
+ ffclos(*fptr, status);
+
+ *fptr = filter.ofptr; /* reset the pointer to the new table */
+
+ /* move back to the image subsection */
+ if (ii - 1 != hdunum)
+ fits_movabs_hdu(*fptr, hdunum, NULL, status);
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/cfortran.h b/src/plugins/cfitsio/cfortran.h
new file mode 100644
index 0000000..703a41b
--- /dev/null
+++ b/src/plugins/cfitsio/cfortran.h
@@ -0,0 +1,2515 @@
+/* cfortran.h 4.4 */
+/* http://www-zeus.desy.de/~burow/cfortran/ */
+/* Burkhard Burow burow desy de 1990 - 2002. */
+
+#ifndef __CFORTRAN_LOADED
+#define __CFORTRAN_LOADED
+
+/*
+ THIS FILE IS PROPERTY OF BURKHARD BUROW. IF YOU ARE USING THIS FILE YOU
+ SHOULD ALSO HAVE ACCESS TO CFORTRAN.DOC WHICH PROVIDES TERMS FOR USING,
+ MODIFYING, COPYING AND DISTRIBUTING THE CFORTRAN.H PACKAGE.
+*/
+
+/* The following modifications were made by the authors of CFITSIO or by me.
+ * They are flagged below with CFITSIO, the author's initials, or KMCCARTY.
+ * PDW = Peter Wilson
+ * DM = Doug Mink
+ * LEB = Lee E Brotzman
+ * MR = Martin Reinecke
+ * WDP = William D Pence
+ * -- Kevin McCarty, for Debian (19 Dec. 2005) */
+
+/*******
+ Modifications:
+ Oct 1997: Changed symbol name extname to appendus (PDW/HSTX)
+ (Conflicted with a common variable name in FTOOLS)
+ Nov 1997: If g77Fortran defined, also define f2cFortran (PDW/HSTX)
+ Feb 1998: Let VMS see the NUM_ELEMS code. Lets programs treat
+ single strings as vectors with single elements
+ Nov 1999: If macintoxh defined, also define f2cfortran (for Mac OS-X)
+ Apr 2000: If WIN32 defined, also define PowerStationFortran and
+ VISUAL_CPLUSPLUS (Visual C++)
+ Jun 2000: If __GNUC__ and linux defined, also define f2cFortran
+ (linux/gcc environment detection)
+ Apr 2002: If __CYGWIN__ is defined, also define f2cFortran
+ Nov 2002: If __APPLE__ defined, also define f2cfortran (for Mac OS-X)
+
+ Nov 2003: If __INTEL_COMPILER or INTEL_COMPILER defined, also define
+ f2cFortran (KMCCARTY)
+ Dec 2005: If f2cFortran is defined, enforce REAL functions in FORTRAN
+ returning "double" in C. This was one of the items on
+ Burkhard's TODO list. (KMCCARTY)
+ Dec 2005: Modifications to support 8-byte integers. (MR)
+ USE AT YOUR OWN RISK!
+ Feb 2006 Added logic to typedef the symbol 'LONGLONG' to an appropriate
+ intrinsic 8-byte integer datatype (WDP)
+ Apr 2006: Modifications to support gfortran (and g77 with -fno-f2c flag)
+ since by default it returns "float" for FORTRAN REAL function.
+ (KMCCARTY)
+ May 2008: Revert commenting out of "extern" in COMMON_BLOCK_DEF macro.
+ Add braces around do-nothing ";" in 3 empty while blocks to
+ get rid of compiler warnings. Thanks to ROOT developers
+ Jacek Holeczek and Rene Brun for these suggestions. (KMCCARTY)
+ Dec 2008 Added typedef for LONGLONG to support Borland compiler (WDP)
+ *******/
+
+/*
+ Avoid symbols already used by compilers and system *.h:
+ __ - OSF1 zukal06 V3.0 347 alpha, cc -c -std1 cfortest.c
+
+*/
+
+/*
+ Determine what 8-byte integer data type is available.
+ 'long long' is now supported by most compilers, but older
+ MS Visual C++ compilers before V7.0 use '__int64' instead. (WDP)
+*/
+
+#ifndef LONGLONG_TYPE /* this may have been previously defined */
+#if defined(_MSC_VER) /* Microsoft Visual C++ */
+
+#if (_MSC_VER < 1300) /* versions earlier than V7.0 do not have 'long long' */
+ typedef __int64 LONGLONG;
+#else /* newer versions do support 'long long' */
+ typedef long long LONGLONG;
+#endif
+
+#elif defined( __BORLANDC__) /* (WDP) for the free Borland compiler, in particular */
+ typedef __int64 LONGLONG;
+#else
+ typedef long long LONGLONG;
+#endif
+
+#define LONGLONG_TYPE
+#endif
+
+
+/* First prepare for the C compiler. */
+
+#ifndef ANSI_C_preprocessor /* i.e. user can override. */
+#ifdef __CF__KnR
+#define ANSI_C_preprocessor 0
+#else
+#ifdef __STDC__
+#define ANSI_C_preprocessor 1
+#else
+#define _cfleft 1
+#define _cfright
+#define _cfleft_cfright 0
+#define ANSI_C_preprocessor _cfleft/**/_cfright
+#endif
+#endif
+#endif
+
+#if ANSI_C_preprocessor
+#define _0(A,B) A##B
+#define _(A,B) _0(A,B) /* see cat,xcat of K&R ANSI C p. 231 */
+#define _2(A,B) A##B /* K&R ANSI C p.230: .. identifier is not replaced */
+#define _3(A,B,C) _(A,_(B,C))
+#else /* if it turns up again during rescanning. */
+#define _(A,B) A/**/B
+#define _2(A,B) A/**/B
+#define _3(A,B,C) A/**/B/**/C
+#endif
+
+#if (defined(vax)&&defined(unix)) || (defined(__vax__)&&defined(__unix__))
+#define VAXUltrix
+#endif
+
+#include <stdio.h> /* NULL [in all machines stdio.h] */
+#include <string.h> /* strlen, memset, memcpy, memchr. */
+#if !( defined(VAXUltrix) || defined(sun) || (defined(apollo)&&!defined(__STDCPP__)) )
+#include <stdlib.h> /* malloc,free */
+#else
+#include <malloc.h> /* Had to be removed for DomainOS h105 10.4 sys5.3 425t*/
+#ifdef apollo
+#define __CF__APOLLO67 /* __STDCPP__ is in Apollo 6.8 (i.e. ANSI) and onwards */
+#endif
+#endif
+
+#if !defined(__GNUC__) && !defined(__sun) && (defined(sun)||defined(VAXUltrix)||defined(lynx))
+#define __CF__KnR /* Sun, LynxOS and VAX Ultrix cc only supports K&R. */
+ /* Manually define __CF__KnR for HP if desired/required.*/
+#endif /* i.e. We will generate Kernighan and Ritchie C. */
+/* Note that you may define __CF__KnR before #include cfortran.h, in order to
+generate K&R C instead of the default ANSI C. The differences are mainly in the
+function prototypes and declarations. All machines, except the Apollo, work
+with either style. The Apollo's argument promotion rules require ANSI or use of
+the obsolete std_$call which we have not implemented here. Hence on the Apollo,
+only C calling FORTRAN subroutines will work using K&R style.*/
+
+
+/* Remainder of cfortran.h depends on the Fortran compiler. */
+
+/* 11/29/2003 (KMCCARTY): add *INTEL_COMPILER symbols here */
+/* 04/05/2006 (KMCCARTY): add gFortran symbol here */
+#if defined(CLIPPERFortran) || defined(pgiFortran) || defined(__INTEL_COMPILER) || defined(INTEL_COMPILER) || defined(gFortran)
+#define f2cFortran
+#endif
+
+/* VAX/VMS does not let us \-split long #if lines. */
+/* Split #if into 2 because some HP-UX can't handle long #if */
+#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
+#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
+/* If no Fortran compiler is given, we choose one for the machines we know. */
+#if defined(lynx) || defined(VAXUltrix)
+#define f2cFortran /* Lynx: Only support f2c at the moment.
+ VAXUltrix: f77 behaves like f2c.
+ Support f2c or f77 with gcc, vcc with f2c.
+ f77 with vcc works, missing link magic for f77 I/O.*/
+#endif
+/* 04/13/00 DM (CFITSIO): Add these lines for NT */
+/* with PowerStationFortran and and Visual C++ */
+#if defined(WIN32) && !defined(__CYGWIN__)
+#define PowerStationFortran
+#define VISUAL_CPLUSPLUS
+#endif
+#if defined(g77Fortran) /* 11/03/97 PDW (CFITSIO) */
+#define f2cFortran
+#endif
+#if defined(__CYGWIN__) /* 04/11/02 LEB (CFITSIO) */
+#define f2cFortran
+#endif
+#if defined(__GNUC__) && defined(linux) /* 06/21/00 PDW (CFITSIO) */
+#define f2cFortran
+#endif
+#if defined(macintosh) /* 11/1999 (CFITSIO) */
+#define f2cFortran
+#endif
+#if defined(__APPLE__) /* 11/2002 (CFITSIO) */
+#define f2cFortran
+#endif
+#if defined(__hpux) /* 921107: Use __hpux instead of __hp9000s300 */
+#define hpuxFortran /* Should also allow hp9000s7/800 use.*/
+#endif
+#if defined(apollo)
+#define apolloFortran /* __CF__APOLLO67 also defines some behavior. */
+#endif
+#if defined(sun) || defined(__sun)
+#define sunFortran
+#endif
+#if defined(_IBMR2)
+#define IBMR2Fortran
+#endif
+#if defined(_CRAY)
+#define CRAYFortran /* _CRAYT3E also defines some behavior. */
+#endif
+#if defined(_SX)
+#define SXFortran
+#endif
+#if defined(mips) || defined(__mips)
+#define mipsFortran
+#endif
+#if defined(vms) || defined(__vms)
+#define vmsFortran
+#endif
+#if defined(__alpha) && defined(__unix__)
+#define DECFortran
+#endif
+#if defined(__convex__)
+#define CONVEXFortran
+#endif
+#if defined(VISUAL_CPLUSPLUS)
+#define PowerStationFortran
+#endif
+#endif /* ...Fortran */
+#endif /* ...Fortran */
+
+/* Split #if into 2 because some HP-UX can't handle long #if */
+#if !(defined(NAGf90Fortran)||defined(f2cFortran)||defined(hpuxFortran)||defined(apolloFortran)||defined(sunFortran)||defined(IBMR2Fortran)||defined(CRAYFortran))
+#if !(defined(mipsFortran)||defined(DECFortran)||defined(vmsFortran)||defined(CONVEXFortran)||defined(PowerStationFortran)||defined(AbsoftUNIXFortran)||defined(AbsoftProFortran)||defined(SXFortran))
+/* If your compiler barfs on ' #error', replace # with the trigraph for # */
+ #error "cfortran.h: Can't find your environment among:\
+ - GNU gcc (g77) on Linux. \
+ - MIPS cc and f77 2.0. (e.g. Silicon Graphics, DECstations, ...) \
+ - IBM AIX XL C and FORTRAN Compiler/6000 Version 01.01.0000.0000 \
+ - VAX VMS CC 3.1 and FORTRAN 5.4. \
+ - Alpha VMS DEC C 1.3 and DEC FORTRAN 6.0. \
+ - Alpha OSF DEC C and DEC Fortran for OSF/1 AXP Version 1.2 \
+ - Apollo DomainOS 10.2 (sys5.3) with f77 10.7 and cc 6.7. \
+ - CRAY \
+ - NEC SX-4 SUPER-UX \
+ - CONVEX \
+ - Sun \
+ - PowerStation Fortran with Visual C++ \
+ - HP9000s300/s700/s800 Latest test with: HP-UX A.08.07 A 9000/730 \
+ - LynxOS: cc or gcc with f2c. \
+ - VAXUltrix: vcc,cc or gcc with f2c. gcc or cc with f77. \
+ - f77 with vcc works; but missing link magic for f77 I/O. \
+ - NO fort. None of gcc, cc or vcc generate required names.\
+ - f2c/g77: Use #define f2cFortran, or cc -Df2cFortran \
+ - gfortran: Use #define gFortran, or cc -DgFortran \
+ (also necessary for g77 with -fno-f2c option) \
+ - NAG f90: Use #define NAGf90Fortran, or cc -DNAGf90Fortran \
+ - Absoft UNIX F77: Use #define AbsoftUNIXFortran or cc -DAbsoftUNIXFortran \
+ - Absoft Pro Fortran: Use #define AbsoftProFortran \
+ - Portland Group Fortran: Use #define pgiFortran \
+ - Intel Fortran: Use #define INTEL_COMPILER"
+/* Compiler must throw us out at this point! */
+#endif
+#endif
+
+
+#if defined(VAXC) && !defined(__VAXC)
+#define OLD_VAXC
+#pragma nostandard /* Prevent %CC-I-PARAMNOTUSED. */
+#endif
+
+/* Throughout cfortran.h we use: UN = Uppercase Name. LN = Lowercase Name. */
+
+/* "extname" changed to "appendus" below (CFITSIO) */
+#if defined(f2cFortran) || defined(NAGf90Fortran) || defined(DECFortran) || defined(mipsFortran) || defined(apolloFortran) || defined(sunFortran) || defined(CONVEXFortran) || defined(SXFortran) || defined(appendus)
+#define CFC_(UN,LN) _(LN,_) /* Lowercase FORTRAN symbols. */
+#define orig_fcallsc(UN,LN) CFC_(UN,LN)
+#else
+#if defined(CRAYFortran) || defined(PowerStationFortran) || defined(AbsoftProFortran)
+#ifdef _CRAY /* (UN), not UN, circumvents CRAY preprocessor bug. */
+#define CFC_(UN,LN) (UN) /* Uppercase FORTRAN symbols. */
+#else /* At least VISUAL_CPLUSPLUS barfs on (UN), so need UN. */
+#define CFC_(UN,LN) UN /* Uppercase FORTRAN symbols. */
+#endif
+#define orig_fcallsc(UN,LN) CFC_(UN,LN) /* CRAY insists on arg.'s here. */
+#else /* For following machines one may wish to change the fcallsc default. */
+#define CF_SAME_NAMESPACE
+#ifdef vmsFortran
+#define CFC_(UN,LN) LN /* Either case FORTRAN symbols. */
+ /* BUT we usually use UN for C macro to FORTRAN routines, so use LN here,*/
+ /* because VAX/VMS doesn't do recursive macros. */
+#define orig_fcallsc(UN,LN) UN
+#else /* HP-UX without +ppu or IBMR2 without -qextname. NOT reccomended. */
+#define CFC_(UN,LN) LN /* Lowercase FORTRAN symbols. */
+#define orig_fcallsc(UN,LN) CFC_(UN,LN)
+#endif /* vmsFortran */
+#endif /* CRAYFortran PowerStationFortran */
+#endif /* ....Fortran */
+
+#define fcallsc(UN,LN) orig_fcallsc(UN,LN)
+#define preface_fcallsc(P,p,UN,LN) CFC_(_(P,UN),_(p,LN))
+#define append_fcallsc(P,p,UN,LN) CFC_(_(UN,P),_(LN,p))
+
+#define C_FUNCTION(UN,LN) fcallsc(UN,LN)
+#define FORTRAN_FUNCTION(UN,LN) CFC_(UN,LN)
+
+#ifndef COMMON_BLOCK
+#ifndef CONVEXFortran
+#ifndef CLIPPERFortran
+#if !(defined(AbsoftUNIXFortran)||defined(AbsoftProFortran))
+#define COMMON_BLOCK(UN,LN) CFC_(UN,LN)
+#else
+#define COMMON_BLOCK(UN,LN) _(_C,LN)
+#endif /* AbsoftUNIXFortran or AbsoftProFortran */
+#else
+#define COMMON_BLOCK(UN,LN) _(LN,__)
+#endif /* CLIPPERFortran */
+#else
+#define COMMON_BLOCK(UN,LN) _3(_,LN,_)
+#endif /* CONVEXFortran */
+#endif /* COMMON_BLOCK */
+
+#ifndef DOUBLE_PRECISION
+#if defined(CRAYFortran) && !defined(_CRAYT3E)
+#define DOUBLE_PRECISION long double
+#else
+#define DOUBLE_PRECISION double
+#endif
+#endif
+
+#ifndef FORTRAN_REAL
+#if defined(CRAYFortran) && defined(_CRAYT3E)
+#define FORTRAN_REAL double
+#else
+#define FORTRAN_REAL float
+#endif
+#endif
+
+#ifdef CRAYFortran
+#ifdef _CRAY
+#include <fortran.h>
+#else
+#include "fortran.h" /* i.e. if crosscompiling assume user has file. */
+#endif
+#define FLOATVVVVVVV_cfPP (FORTRAN_REAL *) /* Used for C calls FORTRAN. */
+/* CRAY's double==float but CRAY says pointers to doubles and floats are diff.*/
+#define VOIDP (void *) /* When FORTRAN calls C, we don't know if C routine
+ arg.'s have been declared float *, or double *. */
+#else
+#define FLOATVVVVVVV_cfPP
+#define VOIDP
+#endif
+
+#ifdef vmsFortran
+#if defined(vms) || defined(__vms)
+#include <descrip.h>
+#else
+#include "descrip.h" /* i.e. if crosscompiling assume user has file. */
+#endif
+#endif
+
+#ifdef sunFortran
+#if defined(sun) || defined(__sun)
+#include <math.h> /* Sun's FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT. */
+#else
+#include "math.h" /* i.e. if crosscompiling assume user has file. */
+#endif
+/* At least starting with the default C compiler SC3.0.1 of SunOS 5.3,
+ * FLOATFUNCTIONTYPE, ASSIGNFLOAT, RETURNFLOAT are not required and not in
+ * <math.h>, since sun C no longer promotes C float return values to doubles.
+ * Therefore, only use them if defined.
+ * Even if gcc is being used, assume that it exhibits the Sun C compiler
+ * behavior in order to be able to use *.o from the Sun C compiler.
+ * i.e. If FLOATFUNCTIONTYPE, etc. are in math.h, they required by gcc.
+ */
+#endif
+
+#ifndef apolloFortran
+#define COMMON_BLOCK_DEF(DEFINITION, NAME) extern DEFINITION NAME
+#define CF_NULL_PROTO
+#else /* HP doesn't understand #elif. */
+/* Without ANSI prototyping, Apollo promotes float functions to double. */
+/* Note that VAX/VMS, IBM, Mips choke on 'type function(...);' prototypes. */
+#define CF_NULL_PROTO ...
+#ifndef __CF__APOLLO67
+#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
+ DEFINITION NAME __attribute((__section(NAME)))
+#else
+#define COMMON_BLOCK_DEF(DEFINITION, NAME) \
+ DEFINITION NAME #attribute[section(NAME)]
+#endif
+#endif
+
+#ifdef __cplusplus
+#undef CF_NULL_PROTO
+#define CF_NULL_PROTO ...
+#endif
+
+
+#ifndef USE_NEW_DELETE
+#ifdef __cplusplus
+#define USE_NEW_DELETE 1
+#else
+#define USE_NEW_DELETE 0
+#endif
+#endif
+#if USE_NEW_DELETE
+#define _cf_malloc(N) new char[N]
+#define _cf_free(P) delete[] P
+#else
+#define _cf_malloc(N) (char *)malloc(N)
+#define _cf_free(P) free(P)
+#endif
+
+#ifdef mipsFortran
+#define CF_DECLARE_GETARG int f77argc; char **f77argv
+#define CF_SET_GETARG(ARGC,ARGV) f77argc = ARGC; f77argv = ARGV
+#else
+#define CF_DECLARE_GETARG
+#define CF_SET_GETARG(ARGC,ARGV)
+#endif
+
+#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
+#pragma standard
+#endif
+
+#define AcfCOMMA ,
+#define AcfCOLON ;
+
+/*-------------------------------------------------------------------------*/
+
+/* UTILITIES USED WITHIN CFORTRAN.H */
+
+#define _cfMIN(A,B) (A<B?A:B)
+
+/* 970211 - XIX.145:
+ firstindexlength - better name is all_but_last_index_lengths
+ secondindexlength - better name is last_index_length
+ */
+#define firstindexlength(A) (sizeof(A[0])==1 ? 1 : (sizeof(A) / sizeof(A[0])) )
+#define secondindexlength(A) (sizeof(A[0])==1 ? sizeof(A) : sizeof(A[0]) )
+
+/* Behavior of FORTRAN LOGICAL. All machines' LOGICAL is same size as C's int.
+Conversion is automatic except for arrays which require F2CLOGICALV/C2FLOGICALV.
+f2c, MIPS f77 [DECstation, SGI], VAX Ultrix f77,
+HP-UX f77 : as in C.
+VAX/VMS FORTRAN, VAX Ultrix fort,
+Absoft Unix Fortran, IBM RS/6000 xlf : LS Bit = 0/1 = TRUE/FALSE.
+Apollo : neg. = TRUE, else FALSE.
+[Apollo accepts -1 as TRUE for function values, but NOT all other neg. values.]
+[DECFortran for Ultrix RISC is also called f77 but is the same as VAX/VMS.]
+[MIPS f77 treats .eqv./.neqv. as .eq./.ne. and hence requires LOGICAL_STRICT.]*/
+
+#if defined(NAGf90Fortran) || defined(f2cFortran) || defined(mipsFortran) || defined(PowerStationFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran) || defined(SXFortran)
+/* SX/PowerStationFortran have 0 and 1 defined, others are neither T nor F. */
+/* hpuxFortran800 has 0 and 0x01000000 defined. Others are unknown. */
+#define LOGICAL_STRICT /* Other Fortran have .eqv./.neqv. == .eq./.ne. */
+#endif
+
+#define C2FLOGICALV(A,I) \
+ do {int __i; for(__i=0;__i<I;__i++) A[__i]=C2FLOGICAL(A[__i]); } while (0)
+#define F2CLOGICALV(A,I) \
+ do {int __i; for(__i=0;__i<I;__i++) A[__i]=F2CLOGICAL(A[__i]); } while (0)
+
+#if defined(apolloFortran)
+#define C2FLOGICAL(L) ((L)?-1:(L)&~((unsigned)1<<sizeof(int)*8-1))
+#define F2CLOGICAL(L) ((L)<0?(L):0)
+#else
+#if defined(CRAYFortran)
+#define C2FLOGICAL(L) _btol(L)
+#define F2CLOGICAL(L) _ltob(&(L)) /* Strangely _ltob() expects a pointer. */
+#else
+#if defined(IBMR2Fortran) || defined(vmsFortran) || defined(DECFortran) || defined(AbsoftUNIXFortran)
+/* How come no AbsoftProFortran ? */
+#define C2FLOGICAL(L) ((L)?(L)|1:(L)&~(int)1)
+#define F2CLOGICAL(L) ((L)&1?(L):0)
+#else
+#if defined(CONVEXFortran)
+#define C2FLOGICAL(L) ((L) ? ~0 : 0 )
+#define F2CLOGICAL(L) (L)
+#else /* others evaluate LOGICALs as for C. */
+#define C2FLOGICAL(L) (L)
+#define F2CLOGICAL(L) (L)
+#ifndef LOGICAL_STRICT
+#undef C2FLOGICALV
+#undef F2CLOGICALV
+#define C2FLOGICALV(A,I)
+#define F2CLOGICALV(A,I)
+#endif /* LOGICAL_STRICT */
+#endif /* CONVEXFortran || All Others */
+#endif /* IBMR2Fortran vmsFortran DECFortran AbsoftUNIXFortran */
+#endif /* CRAYFortran */
+#endif /* apolloFortran */
+
+/* 970514 - In addition to CRAY, there may be other machines
+ for which LOGICAL_STRICT makes no sense. */
+#if defined(LOGICAL_STRICT) && !defined(CRAYFortran)
+/* Force C2FLOGICAL to generate only the values for either .TRUE. or .FALSE.
+ SX/PowerStationFortran only have 0 and 1 defined.
+ Elsewhere, only needed if you want to do:
+ logical lvariable
+ if (lvariable .eq. .true.) then ! (1)
+ instead of
+ if (lvariable .eqv. .true.) then ! (2)
+ - (1) may not even be FORTRAN/77 and that Apollo's f77 and IBM's xlf
+ refuse to compile (1), so you are probably well advised to stay away from
+ (1) and from LOGICAL_STRICT.
+ - You pay a (slight) performance penalty for using LOGICAL_STRICT. */
+#undef C2FLOGICAL
+#ifdef hpuxFortran800
+#define C2FLOGICAL(L) ((L)?0x01000000:0)
+#else
+#if defined(apolloFortran) || defined(vmsFortran) || defined(DECFortran)
+#define C2FLOGICAL(L) ((L)?-1:0) /* These machines use -1/0 for .true./.false.*/
+#else
+#define C2FLOGICAL(L) ((L)? 1:0) /* All others use +1/0 for .true./.false.*/
+#endif
+#endif
+#endif /* LOGICAL_STRICT */
+
+/* Convert a vector of C strings into FORTRAN strings. */
+#ifndef __CF__KnR
+static char *c2fstrv(char* cstr, char *fstr, int elem_len, int sizeofcstr)
+#else
+static char *c2fstrv( cstr, fstr, elem_len, sizeofcstr)
+ char* cstr; char *fstr; int elem_len; int sizeofcstr;
+#endif
+{ int i,j;
+/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
+ Useful size of string must be the same in both languages. */
+for (i=0; i<sizeofcstr/elem_len; i++) {
+ for (j=1; j<elem_len && *cstr; j++) *fstr++ = *cstr++;
+ cstr += 1+elem_len-j;
+ for (; j<elem_len; j++) *fstr++ = ' ';
+} /* 95109 - Seems to be returning the original fstr. */
+return fstr-sizeofcstr+sizeofcstr/elem_len; }
+
+/* Convert a vector of FORTRAN strings into C strings. */
+#ifndef __CF__KnR
+static char *f2cstrv(char *fstr, char* cstr, int elem_len, int sizeofcstr)
+#else
+static char *f2cstrv( fstr, cstr, elem_len, sizeofcstr)
+ char *fstr; char* cstr; int elem_len; int sizeofcstr;
+#endif
+{ int i,j;
+/* elem_len includes \0 for C strings. Fortran strings don't have term. \0.
+ Useful size of string must be the same in both languages. */
+cstr += sizeofcstr;
+fstr += sizeofcstr - sizeofcstr/elem_len;
+for (i=0; i<sizeofcstr/elem_len; i++) {
+ *--cstr = '\0';
+ for (j=1; j<elem_len; j++) *--cstr = *--fstr;
+} return cstr; }
+
+/* kill the trailing char t's in string s. */
+#ifndef __CF__KnR
+static char *kill_trailing(char *s, char t)
+#else
+static char *kill_trailing( s, t) char *s; char t;
+#endif
+{char *e;
+e = s + strlen(s);
+if (e>s) { /* Need this to handle NULL string.*/
+ while (e>s && *--e==t) {;} /* Don't follow t's past beginning. */
+ e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
+} return s; }
+
+/* kill_trailingn(s,t,e) will kill the trailing t's in string s. e normally
+points to the terminating '\0' of s, but may actually point to anywhere in s.
+s's new '\0' will be placed at e or earlier in order to remove any trailing t's.
+If e<s string s is left unchanged. */
+#ifndef __CF__KnR
+static char *kill_trailingn(char *s, char t, char *e)
+#else
+static char *kill_trailingn( s, t, e) char *s; char t; char *e;
+#endif
+{
+if (e==s) *e = '\0'; /* Kill the string makes sense here.*/
+else if (e>s) { /* Watch out for neg. length string.*/
+ while (e>s && *--e==t){;} /* Don't follow t's past beginning. */
+ e[*e==t?0:1] = '\0'; /* Handle s[0]=t correctly. */
+} return s; }
+
+/* Note the following assumes that any element which has t's to be chopped off,
+does indeed fill the entire element. */
+#ifndef __CF__KnR
+static char *vkill_trailing(char* cstr, int elem_len, int sizeofcstr, char t)
+#else
+static char *vkill_trailing( cstr, elem_len, sizeofcstr, t)
+ char* cstr; int elem_len; int sizeofcstr; char t;
+#endif
+{ int i;
+for (i=0; i<sizeofcstr/elem_len; i++) /* elem_len includes \0 for C strings. */
+ kill_trailingn(cstr+elem_len*i,t,cstr+elem_len*(i+1)-1);
+return cstr; }
+
+#ifdef vmsFortran
+typedef struct dsc$descriptor_s fstring;
+#define DSC$DESCRIPTOR_A(DIMCT) \
+struct { \
+ unsigned short dsc$w_length; unsigned char dsc$b_dtype; \
+ unsigned char dsc$b_class; char *dsc$a_pointer; \
+ char dsc$b_scale; unsigned char dsc$b_digits; \
+ struct { \
+ unsigned : 3; unsigned dsc$v_fl_binscale : 1; \
+ unsigned dsc$v_fl_redim : 1; unsigned dsc$v_fl_column : 1; \
+ unsigned dsc$v_fl_coeff : 1; unsigned dsc$v_fl_bounds : 1; \
+ } dsc$b_aflags; \
+ unsigned char dsc$b_dimct; unsigned long dsc$l_arsize; \
+ char *dsc$a_a0; long dsc$l_m [DIMCT]; \
+ struct { \
+ long dsc$l_l; long dsc$l_u; \
+ } dsc$bounds [DIMCT]; \
+}
+typedef DSC$DESCRIPTOR_A(1) fstringvector;
+/*typedef DSC$DESCRIPTOR_A(2) fstringarrarr;
+ typedef DSC$DESCRIPTOR_A(3) fstringarrarrarr;*/
+#define initfstr(F,C,ELEMNO,ELEMLEN) \
+( (F).dsc$l_arsize= ( (F).dsc$w_length =(ELEMLEN) ) \
+ *( (F).dsc$l_m[0]=(F).dsc$bounds[0].dsc$l_u=(ELEMNO) ), \
+ (F).dsc$a_a0 = ( (F).dsc$a_pointer=(C) ) - (F).dsc$w_length ,(F))
+
+#endif /* PDW: 2/10/98 (CFITSIO) -- Let VMS see NUM_ELEMS definitions */
+#define _NUM_ELEMS -1
+#define _NUM_ELEM_ARG -2
+#define NUM_ELEMS(A) A,_NUM_ELEMS
+#define NUM_ELEM_ARG(B) *_2(A,B),_NUM_ELEM_ARG
+#define TERM_CHARS(A,B) A,B
+#ifndef __CF__KnR
+static int num_elem(char *strv, unsigned elem_len, int term_char, int num_term)
+#else
+static int num_elem( strv, elem_len, term_char, num_term)
+ char *strv; unsigned elem_len; int term_char; int num_term;
+#endif
+/* elem_len is the number of characters in each element of strv, the FORTRAN
+vector of strings. The last element of the vector must begin with at least
+num_term term_char characters, so that this routine can determine how
+many elements are in the vector. */
+{
+unsigned num,i;
+if (num_term == _NUM_ELEMS || num_term == _NUM_ELEM_ARG)
+ return term_char;
+if (num_term <=0) num_term = (int)elem_len;
+for (num=0; ; num++) {
+ for (i=0; i<(unsigned)num_term && *strv==term_char; i++,strv++){;}
+ if (i==(unsigned)num_term) break;
+ else strv += elem_len-i;
+}
+if (0) { /* to prevent not used warnings in gcc (added by ROOT) */
+ c2fstrv(0, 0, 0, 0); f2cstrv(0, 0, 0, 0); kill_trailing(0, 0);
+ vkill_trailing(0, 0, 0, 0); num_elem(0, 0, 0, 0);
+}
+return (int)num;
+}
+/* #endif removed 2/10/98 (CFITSIO) */
+
+/*-------------------------------------------------------------------------*/
+
+/* UTILITIES FOR C TO USE STRINGS IN FORTRAN COMMON BLOCKS */
+
+/* C string TO Fortran Common Block STRing. */
+/* DIM is the number of DIMensions of the array in terms of strings, not
+ characters. e.g. char a[12] has DIM = 0, char a[12][4] has DIM = 1, etc. */
+#define C2FCBSTR(CSTR,FSTR,DIM) \
+ c2fstrv((char *)CSTR, (char *)FSTR, sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
+ sizeof(FSTR)+cfelementsof(FSTR,DIM))
+
+/* Fortran Common Block string TO C STRing. */
+#define FCB2CSTR(FSTR,CSTR,DIM) \
+ vkill_trailing(f2cstrv((char *)FSTR, (char *)CSTR, \
+ sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
+ sizeof(FSTR)+cfelementsof(FSTR,DIM)), \
+ sizeof(FSTR)/cfelementsof(FSTR,DIM)+1, \
+ sizeof(FSTR)+cfelementsof(FSTR,DIM), ' ')
+
+#define cfDEREFERENCE0
+#define cfDEREFERENCE1 *
+#define cfDEREFERENCE2 **
+#define cfDEREFERENCE3 ***
+#define cfDEREFERENCE4 ****
+#define cfDEREFERENCE5 *****
+#define cfelementsof(A,D) (sizeof(A)/sizeof(_(cfDEREFERENCE,D)(A)))
+
+/*-------------------------------------------------------------------------*/
+
+/* UTILITIES FOR C TO CALL FORTRAN SUBROUTINES */
+
+/* Define lookup tables for how to handle the various types of variables. */
+
+#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
+#pragma nostandard
+#endif
+
+#define ZTRINGV_NUM(I) I
+#define ZTRINGV_ARGFP(I) (*(_2(A,I))) /* Undocumented. For PINT, etc. */
+#define ZTRINGV_ARGF(I) _2(A,I)
+#ifdef CFSUBASFUN
+#define ZTRINGV_ARGS(I) ZTRINGV_ARGF(I)
+#else
+#define ZTRINGV_ARGS(I) _2(B,I)
+#endif
+
+#define PBYTE_cfVP(A,B) PINT_cfVP(A,B)
+#define PDOUBLE_cfVP(A,B)
+#define PFLOAT_cfVP(A,B)
+#ifdef ZTRINGV_ARGS_allows_Pvariables
+/* This allows Pvariables for ARGS. ARGF machinery is above ARGFP.
+ * B is not needed because the variable may be changed by the Fortran routine,
+ * but because B is the only way to access an arbitrary macro argument. */
+#define PINT_cfVP(A,B) int B = (int)A; /* For ZSTRINGV_ARGS */
+#else
+#define PINT_cfVP(A,B)
+#endif
+#define PLOGICAL_cfVP(A,B) int *B; /* Returning LOGICAL in FUNn and SUBn */
+#define PLONG_cfVP(A,B) PINT_cfVP(A,B)
+#define PSHORT_cfVP(A,B) PINT_cfVP(A,B)
+
+#define VCF_INT_S(T,A,B) _(T,VVVVVVV_cfTYPE) B = A;
+#define VCF_INT_F(T,A,B) _(T,_cfVCF)(A,B)
+/* _cfVCF table is directly mapped to _cfCCC table. */
+#define BYTE_cfVCF(A,B)
+#define DOUBLE_cfVCF(A,B)
+#if !defined(__CF__KnR)
+#define FLOAT_cfVCF(A,B)
+#else
+#define FLOAT_cfVCF(A,B) FORTRAN_REAL B = A;
+#endif
+#define INT_cfVCF(A,B)
+#define LOGICAL_cfVCF(A,B)
+#define LONG_cfVCF(A,B)
+#define SHORT_cfVCF(A,B)
+
+/* 980416
+ Cast (void (*)(CF_NULL_PROTO)) causes SunOS CC 4.2 occasionally to barf,
+ while the following equivalent typedef is fine.
+ For consistency use the typedef on all machines.
+ */
+typedef void (*cfCAST_FUNCTION)(CF_NULL_PROTO);
+
+#define VCF(TN,I) _Icf4(4,V,TN,_(A,I),_(B,I),F)
+#define VVCF(TN,AI,BI) _Icf4(4,V,TN,AI,BI,S)
+#define INT_cfV(T,A,B,F) _(VCF_INT_,F)(T,A,B)
+#define INTV_cfV(T,A,B,F)
+#define INTVV_cfV(T,A,B,F)
+#define INTVVV_cfV(T,A,B,F)
+#define INTVVVV_cfV(T,A,B,F)
+#define INTVVVVV_cfV(T,A,B,F)
+#define INTVVVVVV_cfV(T,A,B,F)
+#define INTVVVVVVV_cfV(T,A,B,F)
+#define PINT_cfV( T,A,B,F) _(T,_cfVP)(A,B)
+#define PVOID_cfV( T,A,B,F)
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
+#define ROUTINE_cfV(T,A,B,F) void (*B)(CF_NULL_PROTO) = (cfCAST_FUNCTION)A;
+#else
+#define ROUTINE_cfV(T,A,B,F)
+#endif
+#define SIMPLE_cfV(T,A,B,F)
+#ifdef vmsFortran
+#define STRING_cfV(T,A,B,F) static struct {fstring f; unsigned clen;} B = \
+ {{0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL},0};
+#define PSTRING_cfV(T,A,B,F) static fstring B={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,NULL};
+#define STRINGV_cfV(T,A,B,F) static fstringvector B = \
+ {sizeof(A),DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
+#define PSTRINGV_cfV(T,A,B,F) static fstringvector B = \
+ {0,DSC$K_DTYPE_T,DSC$K_CLASS_A,NULL,0,0,{0,0,1,1,1},1,0,NULL,0,{1,0}};
+#else
+#define STRING_cfV(T,A,B,F) struct {unsigned int clen, flen; char *nombre;} B;
+#define STRINGV_cfV(T,A,B,F) struct {char *s, *fs; unsigned flen; char *nombre;} B;
+#define PSTRING_cfV(T,A,B,F) int B;
+#define PSTRINGV_cfV(T,A,B,F) struct{char *fs; unsigned int sizeofA,flen;}B;
+#endif
+#define ZTRINGV_cfV(T,A,B,F) STRINGV_cfV(T,A,B,F)
+#define PZTRINGV_cfV(T,A,B,F) PSTRINGV_cfV(T,A,B,F)
+
+/* Note that the actions of the A table were performed inside the AA table.
+ VAX Ultrix vcc, and HP-UX cc, didn't evaluate arguments to functions left to
+ right, so we had to split the original table into the current robust two. */
+#define ACF(NAME,TN,AI,I) _(TN,_cfSTR)(4,A,NAME,I,AI,_(B,I),0)
+#define DEFAULT_cfA(M,I,A,B)
+#define LOGICAL_cfA(M,I,A,B) B=C2FLOGICAL(B);
+#define PLOGICAL_cfA(M,I,A,B) A=C2FLOGICAL(A);
+#define STRING_cfA(M,I,A,B) STRING_cfC(M,I,A,B,sizeof(A))
+#define PSTRING_cfA(M,I,A,B) PSTRING_cfC(M,I,A,B,sizeof(A))
+#ifdef vmsFortran
+#define AATRINGV_cfA( A,B, sA,filA,silA) \
+ initfstr(B,_cf_malloc((sA)-(filA)),(filA),(silA)-1), \
+ c2fstrv(A,B.dsc$a_pointer,(silA),(sA));
+#define APATRINGV_cfA( A,B, sA,filA,silA) \
+ initfstr(B,A,(filA),(silA)-1),c2fstrv(A,A,(silA),(sA));
+#else
+#define AATRINGV_cfA( A,B, sA,filA,silA) \
+ (B.s=_cf_malloc((sA)-(filA)),B.fs=c2fstrv(A,B.s,(B.flen=(silA)-1)+1,(sA)));
+#define APATRINGV_cfA( A,B, sA,filA,silA) \
+ B.fs=c2fstrv(A,A,(B.flen=(silA)-1)+1,B.sizeofA=(sA));
+#endif
+#define STRINGV_cfA(M,I,A,B) \
+ AATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
+#define PSTRINGV_cfA(M,I,A,B) \
+ APATRINGV_cfA((char *)A,B,sizeof(A),firstindexlength(A),secondindexlength(A))
+#define ZTRINGV_cfA(M,I,A,B) AATRINGV_cfA( (char *)A,B, \
+ (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \
+ (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
+#define PZTRINGV_cfA(M,I,A,B) APATRINGV_cfA( (char *)A,B, \
+ (_3(M,_ELEMS_,I))*(( _3(M,_ELEMLEN_,I))+1), \
+ (_3(M,_ELEMS_,I)),(_3(M,_ELEMLEN_,I))+1)
+
+#define PBYTE_cfAAP(A,B) &A
+#define PDOUBLE_cfAAP(A,B) &A
+#define PFLOAT_cfAAP(A,B) FLOATVVVVVVV_cfPP &A
+#define PINT_cfAAP(A,B) &A
+#define PLOGICAL_cfAAP(A,B) B= &A /* B used to keep a common W table. */
+#define PLONG_cfAAP(A,B) &A
+#define PSHORT_cfAAP(A,B) &A
+
+#define AACF(TN,AI,I,C) _SEP_(TN,C,cfCOMMA) _Icf(3,AA,TN,AI,_(B,I))
+#define INT_cfAA(T,A,B) &B
+#define INTV_cfAA(T,A,B) _(T,VVVVVV_cfPP) A
+#define INTVV_cfAA(T,A,B) _(T,VVVVV_cfPP) A[0]
+#define INTVVV_cfAA(T,A,B) _(T,VVVV_cfPP) A[0][0]
+#define INTVVVV_cfAA(T,A,B) _(T,VVV_cfPP) A[0][0][0]
+#define INTVVVVV_cfAA(T,A,B) _(T,VV_cfPP) A[0][0][0][0]
+#define INTVVVVVV_cfAA(T,A,B) _(T,V_cfPP) A[0][0][0][0][0]
+#define INTVVVVVVV_cfAA(T,A,B) _(T,_cfPP) A[0][0][0][0][0][0]
+#define PINT_cfAA(T,A,B) _(T,_cfAAP)(A,B)
+#define PVOID_cfAA(T,A,B) (void *) A
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
+#define ROUTINE_cfAA(T,A,B) &B
+#else
+#define ROUTINE_cfAA(T,A,B) (cfCAST_FUNCTION)A
+#endif
+#define STRING_cfAA(T,A,B) STRING_cfCC(T,A,B)
+#define PSTRING_cfAA(T,A,B) PSTRING_cfCC(T,A,B)
+#ifdef vmsFortran
+#define STRINGV_cfAA(T,A,B) &B
+#else
+#ifdef CRAYFortran
+#define STRINGV_cfAA(T,A,B) _cptofcd(B.fs,B.flen)
+#else
+#define STRINGV_cfAA(T,A,B) B.fs
+#endif
+#endif
+#define PSTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
+#define ZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
+#define PZTRINGV_cfAA(T,A,B) STRINGV_cfAA(T,A,B)
+
+#if defined(vmsFortran) || defined(CRAYFortran)
+#define JCF(TN,I)
+#define KCF(TN,I)
+#else
+#define JCF(TN,I) _(TN,_cfSTR)(1,J,_(B,I), 0,0,0,0)
+#if defined(AbsoftUNIXFortran)
+#define DEFAULT_cfJ(B) ,0
+#else
+#define DEFAULT_cfJ(B)
+#endif
+#define LOGICAL_cfJ(B) DEFAULT_cfJ(B)
+#define PLOGICAL_cfJ(B) DEFAULT_cfJ(B)
+#define STRING_cfJ(B) ,B.flen
+#define PSTRING_cfJ(B) ,B
+#define STRINGV_cfJ(B) STRING_cfJ(B)
+#define PSTRINGV_cfJ(B) STRING_cfJ(B)
+#define ZTRINGV_cfJ(B) STRING_cfJ(B)
+#define PZTRINGV_cfJ(B) STRING_cfJ(B)
+
+/* KCF is identical to DCF, except that KCF ZTRING is not empty. */
+#define KCF(TN,I) _(TN,_cfSTR)(1,KK,_(B,I), 0,0,0,0)
+#if defined(AbsoftUNIXFortran)
+#define DEFAULT_cfKK(B) , unsigned B
+#else
+#define DEFAULT_cfKK(B)
+#endif
+#define LOGICAL_cfKK(B) DEFAULT_cfKK(B)
+#define PLOGICAL_cfKK(B) DEFAULT_cfKK(B)
+#define STRING_cfKK(B) , unsigned B
+#define PSTRING_cfKK(B) STRING_cfKK(B)
+#define STRINGV_cfKK(B) STRING_cfKK(B)
+#define PSTRINGV_cfKK(B) STRING_cfKK(B)
+#define ZTRINGV_cfKK(B) STRING_cfKK(B)
+#define PZTRINGV_cfKK(B) STRING_cfKK(B)
+#endif
+
+#define WCF(TN,AN,I) _(TN,_cfSTR)(2,W,AN,_(B,I), 0,0,0)
+#define DEFAULT_cfW(A,B)
+#define LOGICAL_cfW(A,B)
+#define PLOGICAL_cfW(A,B) *B=F2CLOGICAL(*B);
+#define STRING_cfW(A,B) (B.nombre=A,B.nombre[B.clen]!='\0'?B.nombre[B.clen]='\0':0); /* A?="constnt"*/
+#define PSTRING_cfW(A,B) kill_trailing(A,' ');
+#ifdef vmsFortran
+#define STRINGV_cfW(A,B) _cf_free(B.dsc$a_pointer);
+#define PSTRINGV_cfW(A,B) \
+ vkill_trailing(f2cstrv((char*)A, (char*)A, \
+ B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0]), \
+ B.dsc$w_length+1, B.dsc$l_arsize+B.dsc$l_m[0], ' ');
+#else
+#define STRINGV_cfW(A,B) _cf_free(B.s);
+#define PSTRINGV_cfW(A,B) vkill_trailing( \
+ f2cstrv((char*)A,(char*)A,B.flen+1,B.sizeofA), B.flen+1,B.sizeofA,' ');
+#endif
+#define ZTRINGV_cfW(A,B) STRINGV_cfW(A,B)
+#define PZTRINGV_cfW(A,B) PSTRINGV_cfW(A,B)
+
+#define NCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,N,TN,_(A,I),0)
+#define NNCF(TN,I,C) UUCF(TN,I,C)
+#define NNNCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,N,TN,_(A,I),0)
+#define INT_cfN(T,A) _(T,VVVVVVV_cfTYPE) * A
+#define INTV_cfN(T,A) _(T,VVVVVV_cfTYPE) * A
+#define INTVV_cfN(T,A) _(T,VVVVV_cfTYPE) * A
+#define INTVVV_cfN(T,A) _(T,VVVV_cfTYPE) * A
+#define INTVVVV_cfN(T,A) _(T,VVV_cfTYPE) * A
+#define INTVVVVV_cfN(T,A) _(T,VV_cfTYPE) * A
+#define INTVVVVVV_cfN(T,A) _(T,V_cfTYPE) * A
+#define INTVVVVVVV_cfN(T,A) _(T,_cfTYPE) * A
+#define PINT_cfN(T,A) _(T,_cfTYPE) * A
+#define PVOID_cfN(T,A) void * A
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
+#define ROUTINE_cfN(T,A) void (**A)(CF_NULL_PROTO)
+#else
+#define ROUTINE_cfN(T,A) void ( *A)(CF_NULL_PROTO)
+#endif
+#ifdef vmsFortran
+#define STRING_cfN(T,A) fstring * A
+#define STRINGV_cfN(T,A) fstringvector * A
+#else
+#ifdef CRAYFortran
+#define STRING_cfN(T,A) _fcd A
+#define STRINGV_cfN(T,A) _fcd A
+#else
+#define STRING_cfN(T,A) char * A
+#define STRINGV_cfN(T,A) char * A
+#endif
+#endif
+#define PSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
+#define PNSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
+#define PPSTRING_cfN(T,A) STRING_cfN(T,A) /* CRAY insists on arg.'s here. */
+#define PSTRINGV_cfN(T,A) STRINGV_cfN(T,A)
+#define ZTRINGV_cfN(T,A) STRINGV_cfN(T,A)
+#define PZTRINGV_cfN(T,A) PSTRINGV_cfN(T,A)
+
+
+/* Apollo 6.7, CRAY, old Sun, VAX/Ultrix vcc/cc and new ultrix
+ can't hack more than 31 arg's.
+ e.g. ultrix >= 4.3 gives message:
+ zow35> cc -c -DDECFortran cfortest.c
+ cfe: Fatal: Out of memory: cfortest.c
+ zow35>
+ Old __hpux had the problem, but new 'HP-UX A.09.03 A 9000/735' is fine
+ if using -Aa, otherwise we have a problem.
+ */
+#ifndef MAX_PREPRO_ARGS
+#if !defined(__GNUC__) && (defined(VAXUltrix) || defined(__CF__APOLLO67) || (defined(sun)&&!defined(__sun)) || defined(_CRAY) || defined(__ultrix__) || (defined(__hpux)&&defined(__CF__KnR)))
+#define MAX_PREPRO_ARGS 31
+#else
+#define MAX_PREPRO_ARGS 99
+#endif
+#endif
+
+#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
+/* In addition to explicit Absoft stuff, only Absoft requires:
+ - DEFAULT coming from _cfSTR.
+ DEFAULT could have been called e.g. INT, but keep it for clarity.
+ - M term in CFARGT14 and CFARGT14FS.
+ */
+#define ABSOFT_cf1(T0) _(T0,_cfSTR)(0,ABSOFT1,0,0,0,0,0)
+#define ABSOFT_cf2(T0) _(T0,_cfSTR)(0,ABSOFT2,0,0,0,0,0)
+#define ABSOFT_cf3(T0) _(T0,_cfSTR)(0,ABSOFT3,0,0,0,0,0)
+#define DEFAULT_cfABSOFT1
+#define LOGICAL_cfABSOFT1
+#define STRING_cfABSOFT1 ,MAX_LEN_FORTRAN_FUNCTION_STRING
+#define DEFAULT_cfABSOFT2
+#define LOGICAL_cfABSOFT2
+#define STRING_cfABSOFT2 ,unsigned D0
+#define DEFAULT_cfABSOFT3
+#define LOGICAL_cfABSOFT3
+#define STRING_cfABSOFT3 ,D0
+#else
+#define ABSOFT_cf1(T0)
+#define ABSOFT_cf2(T0)
+#define ABSOFT_cf3(T0)
+#endif
+
+/* _Z introduced to cicumvent IBM and HP silly preprocessor warning.
+ e.g. "Macro CFARGT14 invoked with a null argument."
+ */
+#define _Z
+
+#define CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
+ S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14)
+#define CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
+ S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \
+ S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \
+ S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27)
+
+#define CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
+ F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
+ M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define CFARGT27FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
+ F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
+ F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \
+ F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \
+ M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
+
+#if !(defined(PowerStationFortran)||defined(hpuxFortran800))
+/* Old CFARGT14 -> CFARGT14FS as seen below, for Absoft cross-compile yields:
+ SunOS> cc -c -Xa -DAbsoftUNIXFortran c.c
+ "c.c", line 406: warning: argument mismatch
+ Haven't checked if this is ANSI C or a SunOS bug. SunOS -Xs works ok.
+ Behavior is most clearly seen in example:
+ #define A 1 , 2
+ #define C(X,Y,Z) x=X. y=Y. z=Z.
+ #define D(X,Y,Z) C(X,Y,Z)
+ D(x,A,z)
+ Output from preprocessor is: x = x . y = 1 . z = 2 .
+ #define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ CFARGT14FS(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+*/
+#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
+ F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
+ M CFARGT14S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
+ F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
+ F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) F(TL,21,1) \
+ F(TM,22,1) F(TN,23,1) F(TO,24,1) F(TP,25,1) F(TQ,26,1) F(TR,27,1) \
+ M CFARGT27S(S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
+
+#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+ F(T1,1,0) F(T2,2,1) F(T3,3,1) F(T4,4,1) F(T5,5,1) F(T6,6,1) F(T7,7,1) \
+ F(T8,8,1) F(T9,9,1) F(TA,10,1) F(TB,11,1) F(TC,12,1) F(TD,13,1) F(TE,14,1) \
+ F(TF,15,1) F(TG,16,1) F(TH,17,1) F(TI,18,1) F(TJ,19,1) F(TK,20,1) \
+ S(T1,1) S(T2,2) S(T3,3) S(T4,4) S(T5,5) S(T6,6) S(T7,7) \
+ S(T8,8) S(T9,9) S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) \
+ S(TF,15) S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20)
+#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
+ F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
+ F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
+ F(TD,AD,13,1) F(TE,AE,14,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \
+ S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \
+ S(TB,11) S(TC,12) S(TD,13) S(TE,14)
+#if MAX_PREPRO_ARGS>31
+#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
+ F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
+ F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
+ F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \
+ F(TJ,AJ,19,1) F(TK,AK,20,1) S(T1,1) S(T2,2) S(T3,3) S(T4,4) \
+ S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) S(TA,10) \
+ S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) S(TG,16) \
+ S(TH,17) S(TI,18) S(TJ,19) S(TK,20)
+#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
+ F(T1,A1,1,0) F(T2,A2,2,1) F(T3,A3,3,1) F(T4,A4,4,1) F(T5,A5,5,1) F(T6,A6,6,1) \
+ F(T7,A7,7,1) F(T8,A8,8,1) F(T9,A9,9,1) F(TA,AA,10,1) F(TB,AB,11,1) F(TC,AC,12,1) \
+ F(TD,AD,13,1) F(TE,AE,14,1) F(TF,AF,15,1) F(TG,AG,16,1) F(TH,AH,17,1) F(TI,AI,18,1) \
+ F(TJ,AJ,19,1) F(TK,AK,20,1) F(TL,AL,21,1) F(TM,AM,22,1) F(TN,AN,23,1) F(TO,AO,24,1) \
+ F(TP,AP,25,1) F(TQ,AQ,26,1) F(TR,AR,27,1) S(T1,1) S(T2,2) S(T3,3) \
+ S(T4,4) S(T5,5) S(T6,6) S(T7,7) S(T8,8) S(T9,9) \
+ S(TA,10) S(TB,11) S(TC,12) S(TD,13) S(TE,14) S(TF,15) \
+ S(TG,16) S(TH,17) S(TI,18) S(TJ,19) S(TK,20) S(TL,21) \
+ S(TM,22) S(TN,23) S(TO,24) S(TP,25) S(TQ,26) S(TR,27)
+#endif
+#else
+#define CFARGT14(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \
+ F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \
+ F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
+ F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14)
+#define CFARGT27(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \
+ F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \
+ F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
+ F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
+ F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20) \
+ F(TL,21,1) S(TL,21) F(TM,22,1) S(TM,22) F(TN,23,1) S(TN,23) F(TO,24,1) S(TO,24) \
+ F(TP,25,1) S(TP,25) F(TQ,26,1) S(TQ,26) F(TR,27,1) S(TR,27)
+
+#define CFARGT20(F,S,M,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+ F(T1,1,0) S(T1,1) F(T2,2,1) S(T2,2) F(T3,3,1) S(T3,3) F(T4,4,1) S(T4,4) \
+ F(T5,5,1) S(T5,5) F(T6,6,1) S(T6,6) F(T7,7,1) S(T7,7) F(T8,8,1) S(T8,8) \
+ F(T9,9,1) S(T9,9) F(TA,10,1) S(TA,10) F(TB,11,1) S(TB,11) F(TC,12,1) S(TC,12) \
+ F(TD,13,1) S(TD,13) F(TE,14,1) S(TE,14) F(TF,15,1) S(TF,15) F(TG,16,1) S(TG,16) \
+ F(TH,17,1) S(TH,17) F(TI,18,1) S(TI,18) F(TJ,19,1) S(TJ,19) F(TK,20,1) S(TK,20)
+#define CFARGTA14(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) \
+ F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
+ F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
+ F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
+ F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
+ F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14)
+#if MAX_PREPRO_ARGS>31
+#define CFARGTA20(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
+ F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
+ F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
+ F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
+ F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
+ F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \
+ F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \
+ F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20)
+#define CFARGTA27(F,S,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
+ F(T1,A1,1,0) S(T1,1) F(T2,A2,2,1) S(T2,2) F(T3,A3,3,1) S(T3,3) \
+ F(T4,A4,4,1) S(T4,4) F(T5,A5,5,1) S(T5,5) F(T6,A6,6,1) S(T6,6) \
+ F(T7,A7,7,1) S(T7,7) F(T8,A8,8,1) S(T8,8) F(T9,A9,9,1) S(T9,9) \
+ F(TA,AA,10,1) S(TA,10) F(TB,AB,11,1) S(TB,11) F(TC,AC,12,1) S(TC,12) \
+ F(TD,AD,13,1) S(TD,13) F(TE,AE,14,1) S(TE,14) F(TF,AF,15,1) S(TF,15) \
+ F(TG,AG,16,1) S(TG,16) F(TH,AH,17,1) S(TH,17) F(TI,AI,18,1) S(TI,18) \
+ F(TJ,AJ,19,1) S(TJ,19) F(TK,AK,20,1) S(TK,20) F(TL,AL,21,1) S(TL,21) \
+ F(TM,AM,22,1) S(TM,22) F(TN,AN,23,1) S(TN,23) F(TO,AO,24,1) S(TO,24) \
+ F(TP,AP,25,1) S(TP,25) F(TQ,AQ,26,1) S(TQ,26) F(TR,AR,27,1) S(TR,27)
+#endif
+#endif
+
+
+#define PROTOCCALLSFSUB1( UN,LN,T1) \
+ PROTOCCALLSFSUB14(UN,LN,T1,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB2( UN,LN,T1,T2) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB3( UN,LN,T1,T2,T3) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB4( UN,LN,T1,T2,T3,T4) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
+#define PROTOCCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
+
+
+#define PROTOCCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
+ PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
+ PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
+ PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
+ PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
+#define PROTOCCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
+ PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
+
+#define PROTOCCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
+ PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
+ PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
+ PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
+ PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
+ PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0)
+#define PROTOCCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
+ PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0)
+
+
+#ifndef FCALLSC_QUALIFIER
+#ifdef VISUAL_CPLUSPLUS
+#define FCALLSC_QUALIFIER __stdcall
+#else
+#define FCALLSC_QUALIFIER
+#endif
+#endif
+
+#ifdef __cplusplus
+#define CFextern extern "C"
+#else
+#define CFextern extern
+#endif
+
+
+#ifdef CFSUBASFUN
+#define PROTOCCALLSFSUB0(UN,LN) \
+ PROTOCCALLSFFUN0( VOID,UN,LN)
+#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ PROTOCCALLSFFUN14(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
+ PROTOCCALLSFFUN20(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
+#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\
+ PROTOCCALLSFFUN27(VOID,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
+#else
+/* Note: Prevent compiler warnings, null #define PROTOCCALLSFSUB14/20 after
+ #include-ing cfortran.h if calling the FORTRAN wrapper within the same
+ source code where the wrapper is created. */
+#define PROTOCCALLSFSUB0(UN,LN) _(VOID,_cfPU)(CFC_(UN,LN))();
+#ifndef __CF__KnR
+#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT14(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) );
+#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)\
+ _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT20(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) );
+#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)\
+ _(VOID,_cfPU)(CFC_(UN,LN))( CFARGT27(NCF,KCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) );
+#else
+#define PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ PROTOCCALLSFSUB0(UN,LN)
+#define PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+ PROTOCCALLSFSUB0(UN,LN)
+#define PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ PROTOCCALLSFSUB0(UN,LN)
+#endif
+#endif
+
+
+#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
+#pragma standard
+#endif
+
+
+#define CCALLSFSUB1( UN,LN,T1, A1) \
+ CCALLSFSUB5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
+#define CCALLSFSUB2( UN,LN,T1,T2, A1,A2) \
+ CCALLSFSUB5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
+#define CCALLSFSUB3( UN,LN,T1,T2,T3, A1,A2,A3) \
+ CCALLSFSUB5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
+#define CCALLSFSUB4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
+ CCALLSFSUB5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
+#define CCALLSFSUB5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
+ CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
+#define CCALLSFSUB6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
+ CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
+#define CCALLSFSUB7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
+ CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
+#define CCALLSFSUB8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
+ CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
+#define CCALLSFSUB9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
+ CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
+#define CCALLSFSUB10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
+ CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
+#define CCALLSFSUB11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
+ CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
+#define CCALLSFSUB12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
+ CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
+#define CCALLSFSUB13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
+ CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
+
+#ifdef __cplusplus
+#define CPPPROTOCLSFSUB0( UN,LN)
+#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
+#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
+#else
+#define CPPPROTOCLSFSUB0(UN,LN) \
+ PROTOCCALLSFSUB0(UN,LN)
+#define CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ PROTOCCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+ PROTOCCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
+#define CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ PROTOCCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
+#endif
+
+#ifdef CFSUBASFUN
+#define CCALLSFSUB0(UN,LN) CCALLSFFUN0(UN,LN)
+#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
+ CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)
+#else
+/* do{...}while(0) allows if(a==b) FORT(); else BORT(); */
+#define CCALLSFSUB0( UN,LN) do{CPPPROTOCLSFSUB0(UN,LN) CFC_(UN,LN)();}while(0)
+#define CCALLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
+do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
+ VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
+ VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) \
+ CPPPROTOCLSFSUB14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) \
+ ACF(LN,T4,A4,4) ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) \
+ ACF(LN,T8,A8,8) ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) \
+ ACF(LN,TC,AC,12) ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) \
+ CFC_(UN,LN)( CFARGTA14(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE) );\
+ WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
+ WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) \
+ WCF(TB,AB,11) WCF(TC,AC,12) WCF(TD,AD,13) WCF(TE,AE,14) }while(0)
+#endif
+
+
+#if MAX_PREPRO_ARGS>31
+#define CCALLSFSUB15(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF)\
+ CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,0,0,0,0,0)
+#define CCALLSFSUB16(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG)\
+ CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,0,0,0,0)
+#define CCALLSFSUB17(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH)\
+ CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,0,0,0)
+#define CCALLSFSUB18(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI)\
+ CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,0,0)
+#define CCALLSFSUB19(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ)\
+ CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,0)
+
+#ifdef CFSUBASFUN
+#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
+ TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
+ CCALLSFFUN20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
+ TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK)
+#else
+#define CCALLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH, \
+ TI,TJ,TK, A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) \
+do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
+ VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
+ VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \
+ VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \
+ CPPPROTOCLSFSUB20(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+ ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
+ ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
+ ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \
+ ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \
+ ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \
+ CFC_(UN,LN)( CFARGTA20(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK) ); \
+ WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
+ WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
+ WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
+ WCF(TJ,AJ,19) WCF(TK,AK,20) }while(0)
+#endif
+#endif /* MAX_PREPRO_ARGS */
+
+#if MAX_PREPRO_ARGS>31
+#define CCALLSFSUB21(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL)\
+ CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,0,0,0,0,0,0)
+#define CCALLSFSUB22(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM)\
+ CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,0,0,0,0,0)
+#define CCALLSFSUB23(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN)\
+ CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,0,0,0,0)
+#define CCALLSFSUB24(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO)\
+ CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,0,0,0)
+#define CCALLSFSUB25(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP)\
+ CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,0,0)
+#define CCALLSFSUB26(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ)\
+ CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,0)
+
+#ifdef CFSUBASFUN
+#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
+ A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
+ CCALLSFFUN27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
+ A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR)
+#else
+#define CCALLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR, \
+ A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) \
+do{VVCF(T1,A1,B1) VVCF(T2,A2,B2) VVCF(T3,A3,B3) VVCF(T4,A4,B4) VVCF(T5,A5,B5) \
+ VVCF(T6,A6,B6) VVCF(T7,A7,B7) VVCF(T8,A8,B8) VVCF(T9,A9,B9) VVCF(TA,AA,B10) \
+ VVCF(TB,AB,B11) VVCF(TC,AC,B12) VVCF(TD,AD,B13) VVCF(TE,AE,B14) VVCF(TF,AF,B15) \
+ VVCF(TG,AG,B16) VVCF(TH,AH,B17) VVCF(TI,AI,B18) VVCF(TJ,AJ,B19) VVCF(TK,AK,B20) \
+ VVCF(TL,AL,B21) VVCF(TM,AM,B22) VVCF(TN,AN,B23) VVCF(TO,AO,B24) VVCF(TP,AP,B25) \
+ VVCF(TQ,AQ,B26) VVCF(TR,AR,B27) \
+ CPPPROTOCLSFSUB27(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ ACF(LN,T1,A1,1) ACF(LN,T2,A2,2) ACF(LN,T3,A3,3) ACF(LN,T4,A4,4) \
+ ACF(LN,T5,A5,5) ACF(LN,T6,A6,6) ACF(LN,T7,A7,7) ACF(LN,T8,A8,8) \
+ ACF(LN,T9,A9,9) ACF(LN,TA,AA,10) ACF(LN,TB,AB,11) ACF(LN,TC,AC,12) \
+ ACF(LN,TD,AD,13) ACF(LN,TE,AE,14) ACF(LN,TF,AF,15) ACF(LN,TG,AG,16) \
+ ACF(LN,TH,AH,17) ACF(LN,TI,AI,18) ACF(LN,TJ,AJ,19) ACF(LN,TK,AK,20) \
+ ACF(LN,TL,AL,21) ACF(LN,TM,AM,22) ACF(LN,TN,AN,23) ACF(LN,TO,AO,24) \
+ ACF(LN,TP,AP,25) ACF(LN,TQ,AQ,26) ACF(LN,TR,AR,27) \
+ CFC_(UN,LN)( CFARGTA27(AACF,JCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR,\
+ A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR) ); \
+ WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) WCF(T6,A6,6) \
+ WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,AA,10) WCF(TB,AB,11) WCF(TC,AC,12) \
+ WCF(TD,AD,13) WCF(TE,AE,14) WCF(TF,AF,15) WCF(TG,AG,16) WCF(TH,AH,17) WCF(TI,AI,18) \
+ WCF(TJ,AJ,19) WCF(TK,AK,20) WCF(TL,AL,21) WCF(TM,AM,22) WCF(TN,AN,23) WCF(TO,AO,24) \
+ WCF(TP,AP,25) WCF(TQ,AQ,26) WCF(TR,AR,27) }while(0)
+#endif
+#endif /* MAX_PREPRO_ARGS */
+
+/*-------------------------------------------------------------------------*/
+
+/* UTILITIES FOR C TO CALL FORTRAN FUNCTIONS */
+
+/*N.B. PROTOCCALLSFFUNn(..) generates code, whether or not the FORTRAN
+ function is called. Therefore, especially for creator's of C header files
+ for large FORTRAN libraries which include many functions, to reduce
+ compile time and object code size, it may be desirable to create
+ preprocessor directives to allow users to create code for only those
+ functions which they use. */
+
+/* The following defines the maximum length string that a function can return.
+ Of course it may be undefine-d and re-define-d before individual
+ PROTOCCALLSFFUNn(..) as required. It would also be nice to have this derived
+ from the individual machines' limits. */
+#define MAX_LEN_FORTRAN_FUNCTION_STRING 0x4FE
+
+/* The following defines a character used by CFORTRAN.H to flag the end of a
+ string coming out of a FORTRAN routine. */
+#define CFORTRAN_NON_CHAR 0x7F
+
+#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
+#pragma nostandard
+#endif
+
+#define _SEP_(TN,C,cfCOMMA) _(__SEP_,C)(TN,cfCOMMA)
+#define __SEP_0(TN,cfCOMMA)
+#define __SEP_1(TN,cfCOMMA) _Icf(2,SEP,TN,cfCOMMA,0)
+#define INT_cfSEP(T,B) _(A,B)
+#define INTV_cfSEP(T,B) INT_cfSEP(T,B)
+#define INTVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define INTVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define INTVVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define INTVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define INTVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define INTVVVVVVV_cfSEP(T,B) INT_cfSEP(T,B)
+#define PINT_cfSEP(T,B) INT_cfSEP(T,B)
+#define PVOID_cfSEP(T,B) INT_cfSEP(T,B)
+#define ROUTINE_cfSEP(T,B) INT_cfSEP(T,B)
+#define SIMPLE_cfSEP(T,B) INT_cfSEP(T,B)
+#define VOID_cfSEP(T,B) INT_cfSEP(T,B) /* For FORTRAN calls C subr.s.*/
+#define STRING_cfSEP(T,B) INT_cfSEP(T,B)
+#define STRINGV_cfSEP(T,B) INT_cfSEP(T,B)
+#define PSTRING_cfSEP(T,B) INT_cfSEP(T,B)
+#define PSTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
+#define PNSTRING_cfSEP(T,B) INT_cfSEP(T,B)
+#define PPSTRING_cfSEP(T,B) INT_cfSEP(T,B)
+#define ZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
+#define PZTRINGV_cfSEP(T,B) INT_cfSEP(T,B)
+
+#if defined(SIGNED_BYTE) || !defined(UNSIGNED_BYTE)
+#ifdef OLD_VAXC
+#define INTEGER_BYTE char /* Old VAXC barfs on 'signed char' */
+#else
+#define INTEGER_BYTE signed char /* default */
+#endif
+#else
+#define INTEGER_BYTE unsigned char
+#endif
+#define BYTEVVVVVVV_cfTYPE INTEGER_BYTE
+#define DOUBLEVVVVVVV_cfTYPE DOUBLE_PRECISION
+#define FLOATVVVVVVV_cfTYPE FORTRAN_REAL
+#define INTVVVVVVV_cfTYPE int
+#define LOGICALVVVVVVV_cfTYPE int
+#define LONGVVVVVVV_cfTYPE long
+#define LONGLONGVVVVVVV_cfTYPE LONGLONG /* added by MR December 2005 */
+#define SHORTVVVVVVV_cfTYPE short
+#define PBYTE_cfTYPE INTEGER_BYTE
+#define PDOUBLE_cfTYPE DOUBLE_PRECISION
+#define PFLOAT_cfTYPE FORTRAN_REAL
+#define PINT_cfTYPE int
+#define PLOGICAL_cfTYPE int
+#define PLONG_cfTYPE long
+#define PLONGLONG_cfTYPE LONGLONG /* added by MR December 2005 */
+#define PSHORT_cfTYPE short
+
+#define CFARGS0(A,T,V,W,X,Y,Z) _3(T,_cf,A)
+#define CFARGS1(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V)
+#define CFARGS2(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W)
+#define CFARGS3(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X)
+#define CFARGS4(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y)
+#define CFARGS5(A,T,V,W,X,Y,Z) _3(T,_cf,A)(V,W,X,Y,Z)
+
+#define _Icf(N,T,I,X,Y) _(I,_cfINT)(N,T,I,X,Y,0)
+#define _Icf4(N,T,I,X,Y,Z) _(I,_cfINT)(N,T,I,X,Y,Z)
+#define BYTE_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define DOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INT,B,X,Y,Z,0)
+#define FLOAT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define INT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define LOGICAL_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define LONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define LONGLONG_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
+#define SHORT_cfINT(N,A,B,X,Y,Z) DOUBLE_cfINT(N,A,B,X,Y,Z)
+#define PBYTE_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define PDOUBLE_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,PINT,B,X,Y,Z,0)
+#define PFLOAT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define PINT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define PLOGICAL_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define PLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define PLONGLONG_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
+#define PSHORT_cfINT(N,A,B,X,Y,Z) PDOUBLE_cfINT(N,A,B,X,Y,Z)
+#define BYTEV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define BYTEVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define BYTEVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define BYTEVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define BYTEVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define BYTEVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define BYTEVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define DOUBLEV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTV,B,X,Y,Z,0)
+#define DOUBLEVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVV,B,X,Y,Z,0)
+#define DOUBLEVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVV,B,X,Y,Z,0)
+#define DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVV,B,X,Y,Z,0)
+#define DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVV,B,X,Y,Z,0)
+#define DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVV,B,X,Y,Z,0)
+#define DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,INTVVVVVVV,B,X,Y,Z,0)
+#define FLOATV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define FLOATVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define FLOATVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define FLOATVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define FLOATVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define FLOATVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define FLOATVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define INTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define INTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define INTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define INTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define INTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define INTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define INTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define LOGICALV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define LOGICALVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define LOGICALVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define LOGICALVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define LOGICALVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define LOGICALVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define LOGICALVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define LONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define LONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define LONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define LONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define LONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define LONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define LONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define LONGLONGV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
+#define LONGLONGVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
+#define LONGLONGVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
+#define LONGLONGVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
+#define LONGLONGVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
+#define LONGLONGVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
+#define LONGLONGVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z) /* added by MR December 2005 */
+#define SHORTV_cfINT(N,A,B,X,Y,Z) DOUBLEV_cfINT(N,A,B,X,Y,Z)
+#define SHORTVV_cfINT(N,A,B,X,Y,Z) DOUBLEVV_cfINT(N,A,B,X,Y,Z)
+#define SHORTVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVV_cfINT(N,A,B,X,Y,Z)
+#define SHORTVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVV_cfINT(N,A,B,X,Y,Z)
+#define SHORTVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVV_cfINT(N,A,B,X,Y,Z)
+#define SHORTVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define SHORTVVVVVVV_cfINT(N,A,B,X,Y,Z) DOUBLEVVVVVVV_cfINT(N,A,B,X,Y,Z)
+#define PVOID_cfINT(N,A,B,X,Y,Z) _(CFARGS,N)(A,B,B,X,Y,Z,0)
+#define ROUTINE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+/*CRAY coughs on the first,
+ i.e. the usual trouble of not being able to
+ define macros to macros with arguments.
+ New ultrix is worse, it coughs on all such uses.
+ */
+/*#define SIMPLE_cfINT PVOID_cfINT*/
+#define SIMPLE_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define VOID_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define STRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define STRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define PSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define PSTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define PNSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define PPSTRING_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define ZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define PZTRINGV_cfINT(N,A,B,X,Y,Z) PVOID_cfINT(N,A,B,X,Y,Z)
+#define CF_0_cfINT(N,A,B,X,Y,Z)
+
+
+#define UCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _Icf(2,U,TN,_(A,I),0)
+#define UUCF(TN,I,C) _SEP_(TN,C,cfCOMMA) _SEP_(TN,1,I)
+#define UUUCF(TN,I,C) _SEP_(TN,C,cfCOLON) _Icf(2,U,TN,_(A,I),0)
+#define INT_cfU(T,A) _(T,VVVVVVV_cfTYPE) A
+#define INTV_cfU(T,A) _(T,VVVVVV_cfTYPE) * A
+#define INTVV_cfU(T,A) _(T,VVVVV_cfTYPE) * A
+#define INTVVV_cfU(T,A) _(T,VVVV_cfTYPE) * A
+#define INTVVVV_cfU(T,A) _(T,VVV_cfTYPE) * A
+#define INTVVVVV_cfU(T,A) _(T,VV_cfTYPE) * A
+#define INTVVVVVV_cfU(T,A) _(T,V_cfTYPE) * A
+#define INTVVVVVVV_cfU(T,A) _(T,_cfTYPE) * A
+#define PINT_cfU(T,A) _(T,_cfTYPE) * A
+#define PVOID_cfU(T,A) void *A
+#define ROUTINE_cfU(T,A) void (*A)(CF_NULL_PROTO)
+#define VOID_cfU(T,A) void A /* Needed for C calls FORTRAN sub.s. */
+#define STRING_cfU(T,A) char *A /* via VOID and wrapper. */
+#define STRINGV_cfU(T,A) char *A
+#define PSTRING_cfU(T,A) char *A
+#define PSTRINGV_cfU(T,A) char *A
+#define ZTRINGV_cfU(T,A) char *A
+#define PZTRINGV_cfU(T,A) char *A
+
+/* VOID breaks U into U and UU. */
+#define INT_cfUU(T,A) _(T,VVVVVVV_cfTYPE) A
+#define VOID_cfUU(T,A) /* Needed for FORTRAN calls C sub.s. */
+#define STRING_cfUU(T,A) char *A
+
+
+#define BYTE_cfPU(A) CFextern INTEGER_BYTE FCALLSC_QUALIFIER A
+#define DOUBLE_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#if defined (f2cFortran) && ! defined (gFortran)
+/* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
+#define FLOAT_cfPU(A) CFextern DOUBLE_PRECISION FCALLSC_QUALIFIER A
+#else
+#define FLOAT_cfPU(A) CFextern FORTRAN_REAL FCALLSC_QUALIFIER A
+#endif
+#else
+#define FLOAT_cfPU(A) CFextern FLOATFUNCTIONTYPE FCALLSC_QUALIFIER A
+#endif
+#define INT_cfPU(A) CFextern int FCALLSC_QUALIFIER A
+#define LOGICAL_cfPU(A) CFextern int FCALLSC_QUALIFIER A
+#define LONG_cfPU(A) CFextern long FCALLSC_QUALIFIER A
+#define SHORT_cfPU(A) CFextern short FCALLSC_QUALIFIER A
+#define STRING_cfPU(A) CFextern void FCALLSC_QUALIFIER A
+#define VOID_cfPU(A) CFextern void FCALLSC_QUALIFIER A
+
+#define BYTE_cfE INTEGER_BYTE A0;
+#define DOUBLE_cfE DOUBLE_PRECISION A0;
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#define FLOAT_cfE FORTRAN_REAL A0;
+#else
+#define FLOAT_cfE FORTRAN_REAL AA0; FLOATFUNCTIONTYPE A0;
+#endif
+#define INT_cfE int A0;
+#define LOGICAL_cfE int A0;
+#define LONG_cfE long A0;
+#define SHORT_cfE short A0;
+#define VOID_cfE
+#ifdef vmsFortran
+#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
+ static fstring A0 = \
+ {MAX_LEN_FORTRAN_FUNCTION_STRING,DSC$K_DTYPE_T,DSC$K_CLASS_S,AA0};\
+ memset(AA0, CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
+ *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
+#else
+#ifdef CRAYFortran
+#define STRING_cfE static char AA0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
+ static _fcd A0; *(AA0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';\
+ memset(AA0,CFORTRAN_NON_CHAR, MAX_LEN_FORTRAN_FUNCTION_STRING);\
+ A0 = _cptofcd(AA0,MAX_LEN_FORTRAN_FUNCTION_STRING);
+#else
+/* 'cc: SC3.0.1 13 Jul 1994' barfs on char A0[0x4FE+1];
+ * char A0[0x4FE +1]; char A0[1+0x4FE]; are both OK. */
+#define STRING_cfE static char A0[1+MAX_LEN_FORTRAN_FUNCTION_STRING]; \
+ memset(A0, CFORTRAN_NON_CHAR, \
+ MAX_LEN_FORTRAN_FUNCTION_STRING); \
+ *(A0+MAX_LEN_FORTRAN_FUNCTION_STRING)='\0';
+#endif
+#endif
+/* ESTRING must use static char. array which is guaranteed to exist after
+ function returns. */
+
+/* N.B.i) The diff. for 0 (Zero) and >=1 arguments.
+ ii)That the following create an unmatched bracket, i.e. '(', which
+ must of course be matched in the call.
+ iii)Commas must be handled very carefully */
+#define INT_cfGZ(T,UN,LN) A0=CFC_(UN,LN)(
+#define VOID_cfGZ(T,UN,LN) CFC_(UN,LN)(
+#ifdef vmsFortran
+#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)(&A0
+#else
+#if defined(CRAYFortran) || defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
+#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0
+#else
+#define STRING_cfGZ(T,UN,LN) CFC_(UN,LN)( A0,MAX_LEN_FORTRAN_FUNCTION_STRING
+#endif
+#endif
+
+#define INT_cfG(T,UN,LN) INT_cfGZ(T,UN,LN)
+#define VOID_cfG(T,UN,LN) VOID_cfGZ(T,UN,LN)
+#define STRING_cfG(T,UN,LN) STRING_cfGZ(T,UN,LN), /*, is only diff. from _cfG*/
+
+#define BYTEVVVVVVV_cfPP
+#define INTVVVVVVV_cfPP /* These complement FLOATVVVVVVV_cfPP. */
+#define DOUBLEVVVVVVV_cfPP
+#define LOGICALVVVVVVV_cfPP
+#define LONGVVVVVVV_cfPP
+#define SHORTVVVVVVV_cfPP
+#define PBYTE_cfPP
+#define PINT_cfPP
+#define PDOUBLE_cfPP
+#define PLOGICAL_cfPP
+#define PLONG_cfPP
+#define PSHORT_cfPP
+#define PFLOAT_cfPP FLOATVVVVVVV_cfPP
+
+#define BCF(TN,AN,C) _SEP_(TN,C,cfCOMMA) _Icf(2,B,TN,AN,0)
+#define INT_cfB(T,A) (_(T,VVVVVVV_cfTYPE)) A
+#define INTV_cfB(T,A) A
+#define INTVV_cfB(T,A) (A)[0]
+#define INTVVV_cfB(T,A) (A)[0][0]
+#define INTVVVV_cfB(T,A) (A)[0][0][0]
+#define INTVVVVV_cfB(T,A) (A)[0][0][0][0]
+#define INTVVVVVV_cfB(T,A) (A)[0][0][0][0][0]
+#define INTVVVVVVV_cfB(T,A) (A)[0][0][0][0][0][0]
+#define PINT_cfB(T,A) _(T,_cfPP)&A
+#define STRING_cfB(T,A) (char *) A
+#define STRINGV_cfB(T,A) (char *) A
+#define PSTRING_cfB(T,A) (char *) A
+#define PSTRINGV_cfB(T,A) (char *) A
+#define PVOID_cfB(T,A) (void *) A
+#define ROUTINE_cfB(T,A) (cfCAST_FUNCTION)A
+#define ZTRINGV_cfB(T,A) (char *) A
+#define PZTRINGV_cfB(T,A) (char *) A
+
+#define SCF(TN,NAME,I,A) _(TN,_cfSTR)(3,S,NAME,I,A,0,0)
+#define DEFAULT_cfS(M,I,A)
+#define LOGICAL_cfS(M,I,A)
+#define PLOGICAL_cfS(M,I,A)
+#define STRING_cfS(M,I,A) ,sizeof(A)
+#define STRINGV_cfS(M,I,A) ,( (unsigned)0xFFFF*firstindexlength(A) \
+ +secondindexlength(A))
+#define PSTRING_cfS(M,I,A) ,sizeof(A)
+#define PSTRINGV_cfS(M,I,A) STRINGV_cfS(M,I,A)
+#define ZTRINGV_cfS(M,I,A)
+#define PZTRINGV_cfS(M,I,A)
+
+#define HCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA, H,_(C,I),0,0)
+#define HHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOMMA,HH,_(C,I),0,0)
+#define HHHCF(TN,I) _(TN,_cfSTR)(3,H,cfCOLON, H,_(C,I),0,0)
+#define H_CF_SPECIAL unsigned
+#define HH_CF_SPECIAL
+#define DEFAULT_cfH(M,I,A)
+#define LOGICAL_cfH(S,U,B)
+#define PLOGICAL_cfH(S,U,B)
+#define STRING_cfH(S,U,B) _(A,S) _(U,_CF_SPECIAL) B
+#define STRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
+#define PSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
+#define PSTRINGV_cfH(S,U,B) STRING_cfH(S,U,B)
+#define PNSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
+#define PPSTRING_cfH(S,U,B) STRING_cfH(S,U,B)
+#define ZTRINGV_cfH(S,U,B)
+#define PZTRINGV_cfH(S,U,B)
+
+/* Need VOID_cfSTR because Absoft forced function types go through _cfSTR. */
+/* No spaces inside expansion. They screws up macro catenation kludge. */
+#define VOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define BYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define DOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define FLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define INT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,LOGICAL,A,B,C,D,E)
+#define LONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LONGLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
+#define SHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define BYTEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define BYTEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define BYTEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define BYTEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define BYTEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define BYTEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define BYTEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define DOUBLEV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define DOUBLEVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define DOUBLEVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define DOUBLEVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define DOUBLEVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define DOUBLEVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define DOUBLEVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define FLOATV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define FLOATVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define FLOATVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define FLOATVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define FLOATVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define FLOATVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define FLOATVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define INTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define INTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define INTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define INTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define INTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define INTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define INTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LOGICALV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LOGICALVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LOGICALVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LOGICALVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LOGICALVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LOGICALVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LOGICALVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define LONGLONGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
+#define LONGLONGVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
+#define LONGLONGVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
+#define LONGLONGVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
+#define LONGLONGVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
+#define LONGLONGVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
+#define LONGLONGVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
+#define SHORTV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define SHORTVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define SHORTVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define SHORTVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define SHORTVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define SHORTVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define SHORTVVVVVVV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define PBYTE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define PDOUBLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define PFLOAT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define PINT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define PLOGICAL_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PLOGICAL,A,B,C,D,E)
+#define PLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define PLONGLONG_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E) /* added by MR December 2005 */
+#define PSHORT_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define STRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRING,A,B,C,D,E)
+#define PSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRING,A,B,C,D,E)
+#define STRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,STRINGV,A,B,C,D,E)
+#define PSTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PSTRINGV,A,B,C,D,E)
+#define PNSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PNSTRING,A,B,C,D,E)
+#define PPSTRING_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PPSTRING,A,B,C,D,E)
+#define PVOID_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define ROUTINE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define SIMPLE_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,DEFAULT,A,B,C,D,E)
+#define ZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,ZTRINGV,A,B,C,D,E)
+#define PZTRINGV_cfSTR(N,T,A,B,C,D,E) _(CFARGS,N)(T,PZTRINGV,A,B,C,D,E)
+#define CF_0_cfSTR(N,T,A,B,C,D,E)
+
+/* See ACF table comments, which explain why CCF was split into two. */
+#define CCF(NAME,TN,I) _(TN,_cfSTR)(5,C,NAME,I,_(A,I),_(B,I),_(C,I))
+#define DEFAULT_cfC(M,I,A,B,C)
+#define LOGICAL_cfC(M,I,A,B,C) A=C2FLOGICAL( A);
+#define PLOGICAL_cfC(M,I,A,B,C) *A=C2FLOGICAL(*A);
+#ifdef vmsFortran
+#define STRING_cfC(M,I,A,B,C) (B.clen=strlen(A),B.f.dsc$a_pointer=A, \
+ C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.f.dsc$w_length=B.clen: \
+ (memset((A)+B.clen,' ',C-B.clen-1),A[B.f.dsc$w_length=C-1]='\0'));
+ /* PSTRING_cfC to beware of array A which does not contain any \0. */
+#define PSTRING_cfC(M,I,A,B,C) (B.dsc$a_pointer=A, C==sizeof(char*) ? \
+ B.dsc$w_length=strlen(A): (A[C-1]='\0',B.dsc$w_length=strlen(A), \
+ memset((A)+B.dsc$w_length,' ',C-B.dsc$w_length-1), B.dsc$w_length=C-1));
+#else
+#define STRING_cfC(M,I,A,B,C) (B.nombre=A,B.clen=strlen(A), \
+ C==sizeof(char*)||C==(unsigned)(B.clen+1)?B.flen=B.clen: \
+ (memset(B.nombre+B.clen,' ',C-B.clen-1),B.nombre[B.flen=C-1]='\0'));
+#define PSTRING_cfC(M,I,A,B,C) (C==sizeof(char*)? B=strlen(A): \
+ (A[C-1]='\0',B=strlen(A),memset((A)+B,' ',C-B-1),B=C-1));
+#endif
+ /* For CRAYFortran for (P)STRINGV_cfC, B.fs is set, but irrelevant. */
+#define STRINGV_cfC(M,I,A,B,C) \
+ AATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
+#define PSTRINGV_cfC(M,I,A,B,C) \
+ APATRINGV_cfA( A,B,(C/0xFFFF)*(C%0xFFFF),C/0xFFFF,C%0xFFFF)
+#define ZTRINGV_cfC(M,I,A,B,C) \
+ AATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \
+ (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 )
+#define PZTRINGV_cfC(M,I,A,B,C) \
+ APATRINGV_cfA( A,B, (_3(M,_ELEMS_,I))*((_3(M,_ELEMLEN_,I))+1), \
+ (_3(M,_ELEMS_,I)), (_3(M,_ELEMLEN_,I))+1 )
+
+#define BYTE_cfCCC(A,B) &A
+#define DOUBLE_cfCCC(A,B) &A
+#if !defined(__CF__KnR)
+#define FLOAT_cfCCC(A,B) &A
+ /* Although the VAX doesn't, at least the */
+#else /* HP and K&R mips promote float arg.'s of */
+#define FLOAT_cfCCC(A,B) &B /* unprototyped functions to double. Cannot */
+#endif /* use A here to pass the argument to FORTRAN. */
+#define INT_cfCCC(A,B) &A
+#define LOGICAL_cfCCC(A,B) &A
+#define LONG_cfCCC(A,B) &A
+#define SHORT_cfCCC(A,B) &A
+#define PBYTE_cfCCC(A,B) A
+#define PDOUBLE_cfCCC(A,B) A
+#define PFLOAT_cfCCC(A,B) A
+#define PINT_cfCCC(A,B) A
+#define PLOGICAL_cfCCC(A,B) B=A /* B used to keep a common W table. */
+#define PLONG_cfCCC(A,B) A
+#define PSHORT_cfCCC(A,B) A
+
+#define CCCF(TN,I,M) _SEP_(TN,M,cfCOMMA) _Icf(3,CC,TN,_(A,I),_(B,I))
+#define INT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
+#define INTV_cfCC(T,A,B) A
+#define INTVV_cfCC(T,A,B) A
+#define INTVVV_cfCC(T,A,B) A
+#define INTVVVV_cfCC(T,A,B) A
+#define INTVVVVV_cfCC(T,A,B) A
+#define INTVVVVVV_cfCC(T,A,B) A
+#define INTVVVVVVV_cfCC(T,A,B) A
+#define PINT_cfCC(T,A,B) _(T,_cfCCC)(A,B)
+#define PVOID_cfCC(T,A,B) A
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
+#define ROUTINE_cfCC(T,A,B) &A
+#else
+#define ROUTINE_cfCC(T,A,B) A
+#endif
+#define SIMPLE_cfCC(T,A,B) A
+#ifdef vmsFortran
+#define STRING_cfCC(T,A,B) &B.f
+#define STRINGV_cfCC(T,A,B) &B
+#define PSTRING_cfCC(T,A,B) &B
+#define PSTRINGV_cfCC(T,A,B) &B
+#else
+#ifdef CRAYFortran
+#define STRING_cfCC(T,A,B) _cptofcd(A,B.flen)
+#define STRINGV_cfCC(T,A,B) _cptofcd(B.s,B.flen)
+#define PSTRING_cfCC(T,A,B) _cptofcd(A,B)
+#define PSTRINGV_cfCC(T,A,B) _cptofcd(A,B.flen)
+#else
+#define STRING_cfCC(T,A,B) A
+#define STRINGV_cfCC(T,A,B) B.fs
+#define PSTRING_cfCC(T,A,B) A
+#define PSTRINGV_cfCC(T,A,B) B.fs
+#endif
+#endif
+#define ZTRINGV_cfCC(T,A,B) STRINGV_cfCC(T,A,B)
+#define PZTRINGV_cfCC(T,A,B) PSTRINGV_cfCC(T,A,B)
+
+#define BYTE_cfX return A0;
+#define DOUBLE_cfX return A0;
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#define FLOAT_cfX return A0;
+#else
+#define FLOAT_cfX ASSIGNFLOAT(AA0,A0); return AA0;
+#endif
+#define INT_cfX return A0;
+#define LOGICAL_cfX return F2CLOGICAL(A0);
+#define LONG_cfX return A0;
+#define SHORT_cfX return A0;
+#define VOID_cfX return ;
+#if defined(vmsFortran) || defined(CRAYFortran)
+#define STRING_cfX return kill_trailing( \
+ kill_trailing(AA0,CFORTRAN_NON_CHAR),' ');
+#else
+#define STRING_cfX return kill_trailing( \
+ kill_trailing( A0,CFORTRAN_NON_CHAR),' ');
+#endif
+
+#define CFFUN(NAME) _(__cf__,NAME)
+
+/* Note that we don't use LN here, but we keep it for consistency. */
+#define CCALLSFFUN0(UN,LN) CFFUN(UN)()
+
+#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
+#pragma standard
+#endif
+
+#define CCALLSFFUN1( UN,LN,T1, A1) \
+ CCALLSFFUN5 (UN,LN,T1,CF_0,CF_0,CF_0,CF_0,A1,0,0,0,0)
+#define CCALLSFFUN2( UN,LN,T1,T2, A1,A2) \
+ CCALLSFFUN5 (UN,LN,T1,T2,CF_0,CF_0,CF_0,A1,A2,0,0,0)
+#define CCALLSFFUN3( UN,LN,T1,T2,T3, A1,A2,A3) \
+ CCALLSFFUN5 (UN,LN,T1,T2,T3,CF_0,CF_0,A1,A2,A3,0,0)
+#define CCALLSFFUN4( UN,LN,T1,T2,T3,T4, A1,A2,A3,A4)\
+ CCALLSFFUN5 (UN,LN,T1,T2,T3,T4,CF_0,A1,A2,A3,A4,0)
+#define CCALLSFFUN5( UN,LN,T1,T2,T3,T4,T5, A1,A2,A3,A4,A5) \
+ CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,0,0,0,0,0)
+#define CCALLSFFUN6( UN,LN,T1,T2,T3,T4,T5,T6, A1,A2,A3,A4,A5,A6) \
+ CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,0,0,0,0)
+#define CCALLSFFUN7( UN,LN,T1,T2,T3,T4,T5,T6,T7, A1,A2,A3,A4,A5,A6,A7) \
+ CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,0,0,0)
+#define CCALLSFFUN8( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8, A1,A2,A3,A4,A5,A6,A7,A8) \
+ CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,0,0)
+#define CCALLSFFUN9( UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,A1,A2,A3,A4,A5,A6,A7,A8,A9)\
+ CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,0)
+#define CCALLSFFUN10(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA)\
+ CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,0,0,0,0)
+#define CCALLSFFUN11(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB)\
+ CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,0,0,0)
+#define CCALLSFFUN12(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC)\
+ CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,0,0)
+#define CCALLSFFUN13(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD)\
+ CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,0)
+
+#define CCALLSFFUN14(UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE)\
+((CFFUN(UN)( BCF(T1,A1,0) BCF(T2,A2,1) BCF(T3,A3,1) BCF(T4,A4,1) BCF(T5,A5,1) \
+ BCF(T6,A6,1) BCF(T7,A7,1) BCF(T8,A8,1) BCF(T9,A9,1) BCF(TA,AA,1) \
+ BCF(TB,AB,1) BCF(TC,AC,1) BCF(TD,AD,1) BCF(TE,AE,1) \
+ SCF(T1,LN,1,A1) SCF(T2,LN,2,A2) SCF(T3,LN,3,A3) SCF(T4,LN,4,A4) \
+ SCF(T5,LN,5,A5) SCF(T6,LN,6,A6) SCF(T7,LN,7,A7) SCF(T8,LN,8,A8) \
+ SCF(T9,LN,9,A9) SCF(TA,LN,10,AA) SCF(TB,LN,11,AB) SCF(TC,LN,12,AC) \
+ SCF(TD,LN,13,AD) SCF(TE,LN,14,AE))))
+
+/* N.B. Create a separate function instead of using (call function, function
+value here) because in order to create the variables needed for the input
+arg.'s which may be const.'s one has to do the creation within {}, but these
+can never be placed within ()'s. Therefore one must create wrapper functions.
+gcc, on the other hand may be able to avoid the wrapper functions. */
+
+/* Prototypes are needed to correctly handle the value returned correctly. N.B.
+Can only have prototype arg.'s with difficulty, a la G... table since FORTRAN
+functions returning strings have extra arg.'s. Don't bother, since this only
+causes a compiler warning to come up when one uses FCALLSCFUNn and CCALLSFFUNn
+for the same function in the same source code. Something done by the experts in
+debugging only.*/
+
+#define PROTOCCALLSFFUN0(F,UN,LN) \
+_(F,_cfPU)( CFC_(UN,LN))(CF_NULL_PROTO); \
+static _Icf(2,U,F,CFFUN(UN),0)() {_(F,_cfE) _Icf(3,GZ,F,UN,LN) ABSOFT_cf1(F));_(F,_cfX)}
+
+#define PROTOCCALLSFFUN1( T0,UN,LN,T1) \
+ PROTOCCALLSFFUN5 (T0,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN2( T0,UN,LN,T1,T2) \
+ PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN3( T0,UN,LN,T1,T2,T3) \
+ PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,CF_0,CF_0)
+#define PROTOCCALLSFFUN4( T0,UN,LN,T1,T2,T3,T4) \
+ PROTOCCALLSFFUN5 (T0,UN,LN,T1,T2,T3,T4,CF_0)
+#define PROTOCCALLSFFUN5( T0,UN,LN,T1,T2,T3,T4,T5) \
+ PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN6( T0,UN,LN,T1,T2,T3,T4,T5,T6) \
+ PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN7( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
+ PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN8( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
+ PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
+#define PROTOCCALLSFFUN9( T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
+ PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
+#define PROTOCCALLSFFUN10(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
+ PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN11(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
+ PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
+#define PROTOCCALLSFFUN12(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
+ PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
+#define PROTOCCALLSFFUN13(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
+ PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
+
+/* HP/UX 9.01 cc requires the blank between '_Icf(3,G,T0,UN,LN) CCCF(T1,1,0)' */
+
+#ifndef __CF__KnR
+#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \
+ CFARGT14FS(UCF,HCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
+{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \
+ CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \
+ CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \
+ CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \
+ CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
+ WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
+ WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \
+ WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
+#else
+#define PROTOCCALLSFFUN14(T0,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ _(T0,_cfPU)(CFC_(UN,LN))(CF_NULL_PROTO); static _Icf(2,U,T0,CFFUN(UN),0)( \
+ CFARGT14FS(UUCF,HHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ) \
+ CFARGT14FS(UUUCF,HHHCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) ; \
+{ CFARGT14S(VCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) _(T0,_cfE) \
+ CCF(LN,T1,1) CCF(LN,T2,2) CCF(LN,T3,3) CCF(LN,T4,4) CCF(LN,T5,5) \
+ CCF(LN,T6,6) CCF(LN,T7,7) CCF(LN,T8,8) CCF(LN,T9,9) CCF(LN,TA,10) \
+ CCF(LN,TB,11) CCF(LN,TC,12) CCF(LN,TD,13) CCF(LN,TE,14) _Icf(3,G,T0,UN,LN) \
+ CFARGT14(CCCF,JCF,ABSOFT_cf1(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)); \
+ WCF(T1,A1,1) WCF(T2,A2,2) WCF(T3,A3,3) WCF(T4,A4,4) WCF(T5,A5,5) \
+ WCF(T6,A6,6) WCF(T7,A7,7) WCF(T8,A8,8) WCF(T9,A9,9) WCF(TA,A10,10) \
+ WCF(TB,A11,11) WCF(TC,A12,12) WCF(TD,A13,13) WCF(TE,A14,14) _(T0,_cfX)}
+#endif
+
+/*-------------------------------------------------------------------------*/
+
+/* UTILITIES FOR FORTRAN TO CALL C ROUTINES */
+
+#ifdef OLD_VAXC /* Prevent %CC-I-PARAMNOTUSED. */
+#pragma nostandard
+#endif
+
+#if defined(vmsFortran) || defined(CRAYFortran)
+#define DCF(TN,I)
+#define DDCF(TN,I)
+#define DDDCF(TN,I)
+#else
+#define DCF(TN,I) HCF(TN,I)
+#define DDCF(TN,I) HHCF(TN,I)
+#define DDDCF(TN,I) HHHCF(TN,I)
+#endif
+
+#define QCF(TN,I) _(TN,_cfSTR)(1,Q,_(B,I), 0,0,0,0)
+#define DEFAULT_cfQ(B)
+#define LOGICAL_cfQ(B)
+#define PLOGICAL_cfQ(B)
+#define STRINGV_cfQ(B) char *B; unsigned int _(B,N);
+#define STRING_cfQ(B) char *B=NULL;
+#define PSTRING_cfQ(B) char *B=NULL;
+#define PSTRINGV_cfQ(B) STRINGV_cfQ(B)
+#define PNSTRING_cfQ(B) char *B=NULL;
+#define PPSTRING_cfQ(B)
+
+#ifdef __sgi /* Else SGI gives warning 182 contrary to its C LRM A.17.7 */
+#define ROUTINE_orig *(void**)&
+#else
+#define ROUTINE_orig (void *)
+#endif
+
+#define ROUTINE_1 ROUTINE_orig
+#define ROUTINE_2 ROUTINE_orig
+#define ROUTINE_3 ROUTINE_orig
+#define ROUTINE_4 ROUTINE_orig
+#define ROUTINE_5 ROUTINE_orig
+#define ROUTINE_6 ROUTINE_orig
+#define ROUTINE_7 ROUTINE_orig
+#define ROUTINE_8 ROUTINE_orig
+#define ROUTINE_9 ROUTINE_orig
+#define ROUTINE_10 ROUTINE_orig
+#define ROUTINE_11 ROUTINE_orig
+#define ROUTINE_12 ROUTINE_orig
+#define ROUTINE_13 ROUTINE_orig
+#define ROUTINE_14 ROUTINE_orig
+#define ROUTINE_15 ROUTINE_orig
+#define ROUTINE_16 ROUTINE_orig
+#define ROUTINE_17 ROUTINE_orig
+#define ROUTINE_18 ROUTINE_orig
+#define ROUTINE_19 ROUTINE_orig
+#define ROUTINE_20 ROUTINE_orig
+#define ROUTINE_21 ROUTINE_orig
+#define ROUTINE_22 ROUTINE_orig
+#define ROUTINE_23 ROUTINE_orig
+#define ROUTINE_24 ROUTINE_orig
+#define ROUTINE_25 ROUTINE_orig
+#define ROUTINE_26 ROUTINE_orig
+#define ROUTINE_27 ROUTINE_orig
+
+#define TCF(NAME,TN,I,M) _SEP_(TN,M,cfCOMMA) _(TN,_cfT)(NAME,I,_(A,I),_(B,I),_(C,I))
+#define BYTE_cfT(M,I,A,B,D) *A
+#define DOUBLE_cfT(M,I,A,B,D) *A
+#define FLOAT_cfT(M,I,A,B,D) *A
+#define INT_cfT(M,I,A,B,D) *A
+#define LOGICAL_cfT(M,I,A,B,D) F2CLOGICAL(*A)
+#define LONG_cfT(M,I,A,B,D) *A
+#define LONGLONG_cfT(M,I,A,B,D) *A /* added by MR December 2005 */
+#define SHORT_cfT(M,I,A,B,D) *A
+#define BYTEV_cfT(M,I,A,B,D) A
+#define DOUBLEV_cfT(M,I,A,B,D) A
+#define FLOATV_cfT(M,I,A,B,D) VOIDP A
+#define INTV_cfT(M,I,A,B,D) A
+#define LOGICALV_cfT(M,I,A,B,D) A
+#define LONGV_cfT(M,I,A,B,D) A
+#define LONGLONGV_cfT(M,I,A,B,D) A /* added by MR December 2005 */
+#define SHORTV_cfT(M,I,A,B,D) A
+#define BYTEVV_cfT(M,I,A,B,D) (void *)A /* We have to cast to void *,*/
+#define BYTEVVV_cfT(M,I,A,B,D) (void *)A /* since we don't know the */
+#define BYTEVVVV_cfT(M,I,A,B,D) (void *)A /* dimensions of the array. */
+#define BYTEVVVVV_cfT(M,I,A,B,D) (void *)A /* i.e. Unfortunately, can't */
+#define BYTEVVVVVV_cfT(M,I,A,B,D) (void *)A /* check that the type */
+#define BYTEVVVVVVV_cfT(M,I,A,B,D) (void *)A /* matches the prototype. */
+#define DOUBLEVV_cfT(M,I,A,B,D) (void *)A
+#define DOUBLEVVV_cfT(M,I,A,B,D) (void *)A
+#define DOUBLEVVVV_cfT(M,I,A,B,D) (void *)A
+#define DOUBLEVVVVV_cfT(M,I,A,B,D) (void *)A
+#define DOUBLEVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define DOUBLEVVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define FLOATVV_cfT(M,I,A,B,D) (void *)A
+#define FLOATVVV_cfT(M,I,A,B,D) (void *)A
+#define FLOATVVVV_cfT(M,I,A,B,D) (void *)A
+#define FLOATVVVVV_cfT(M,I,A,B,D) (void *)A
+#define FLOATVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define FLOATVVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define INTVV_cfT(M,I,A,B,D) (void *)A
+#define INTVVV_cfT(M,I,A,B,D) (void *)A
+#define INTVVVV_cfT(M,I,A,B,D) (void *)A
+#define INTVVVVV_cfT(M,I,A,B,D) (void *)A
+#define INTVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define INTVVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define LOGICALVV_cfT(M,I,A,B,D) (void *)A
+#define LOGICALVVV_cfT(M,I,A,B,D) (void *)A
+#define LOGICALVVVV_cfT(M,I,A,B,D) (void *)A
+#define LOGICALVVVVV_cfT(M,I,A,B,D) (void *)A
+#define LOGICALVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define LOGICALVVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define LONGVV_cfT(M,I,A,B,D) (void *)A
+#define LONGVVV_cfT(M,I,A,B,D) (void *)A
+#define LONGVVVV_cfT(M,I,A,B,D) (void *)A
+#define LONGVVVVV_cfT(M,I,A,B,D) (void *)A
+#define LONGVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define LONGVVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define LONGLONGVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
+#define LONGLONGVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
+#define LONGLONGVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
+#define LONGLONGVVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
+#define LONGLONGVVVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
+#define LONGLONGVVVVVVV_cfT(M,I,A,B,D) (void *)A /* added by MR December 2005 */
+#define SHORTVV_cfT(M,I,A,B,D) (void *)A
+#define SHORTVVV_cfT(M,I,A,B,D) (void *)A
+#define SHORTVVVV_cfT(M,I,A,B,D) (void *)A
+#define SHORTVVVVV_cfT(M,I,A,B,D) (void *)A
+#define SHORTVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define SHORTVVVVVVV_cfT(M,I,A,B,D) (void *)A
+#define PBYTE_cfT(M,I,A,B,D) A
+#define PDOUBLE_cfT(M,I,A,B,D) A
+#define PFLOAT_cfT(M,I,A,B,D) VOIDP A
+#define PINT_cfT(M,I,A,B,D) A
+#define PLOGICAL_cfT(M,I,A,B,D) ((*A=F2CLOGICAL(*A)),A)
+#define PLONG_cfT(M,I,A,B,D) A
+#define PLONGLONG_cfT(M,I,A,B,D) A /* added by MR December 2005 */
+#define PSHORT_cfT(M,I,A,B,D) A
+#define PVOID_cfT(M,I,A,B,D) A
+#if defined(apolloFortran) || defined(hpuxFortran800) || defined(AbsoftUNIXFortran)
+#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) (*A)
+#else
+#define ROUTINE_cfT(M,I,A,B,D) _(ROUTINE_,I) A
+#endif
+/* A == pointer to the characters
+ D == length of the string, or of an element in an array of strings
+ E == number of elements in an array of strings */
+#define TTSTR( A,B,D) \
+ ((B=_cf_malloc(D+1))[D]='\0', memcpy(B,A,D), kill_trailing(B,' '))
+#define TTTTSTR( A,B,D) (!(D<4||A[0]||A[1]||A[2]||A[3]))?NULL: \
+ memchr(A,'\0',D) ?A : TTSTR(A,B,D)
+#define TTTTSTRV( A,B,D,E) (_(B,N)=E,B=_cf_malloc(_(B,N)*(D+1)), (void *) \
+ vkill_trailing(f2cstrv(A,B,D+1, _(B,N)*(D+1)), D+1,_(B,N)*(D+1),' '))
+#ifdef vmsFortran
+#define STRING_cfT(M,I,A,B,D) TTTTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
+#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A->dsc$a_pointer, B, \
+ A->dsc$w_length , A->dsc$l_m[0])
+#define PSTRING_cfT(M,I,A,B,D) TTSTR( A->dsc$a_pointer,B,A->dsc$w_length)
+#define PPSTRING_cfT(M,I,A,B,D) A->dsc$a_pointer
+#else
+#ifdef CRAYFortran
+#define STRING_cfT(M,I,A,B,D) TTTTSTR( _fcdtocp(A),B,_fcdlen(A))
+#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(_fcdtocp(A),B,_fcdlen(A), \
+ num_elem(_fcdtocp(A),_fcdlen(A),_3(M,_STRV_A,I)))
+#define PSTRING_cfT(M,I,A,B,D) TTSTR( _fcdtocp(A),B,_fcdlen(A))
+#define PPSTRING_cfT(M,I,A,B,D) _fcdtocp(A)
+#else
+#define STRING_cfT(M,I,A,B,D) TTTTSTR( A,B,D)
+#define STRINGV_cfT(M,I,A,B,D) TTTTSTRV(A,B,D, num_elem(A,D,_3(M,_STRV_A,I)))
+#define PSTRING_cfT(M,I,A,B,D) TTSTR( A,B,D)
+#define PPSTRING_cfT(M,I,A,B,D) A
+#endif
+#endif
+#define PNSTRING_cfT(M,I,A,B,D) STRING_cfT(M,I,A,B,D)
+#define PSTRINGV_cfT(M,I,A,B,D) STRINGV_cfT(M,I,A,B,D)
+#define CF_0_cfT(M,I,A,B,D)
+
+#define RCF(TN,I) _(TN,_cfSTR)(3,R,_(A,I),_(B,I),_(C,I),0,0)
+#define DEFAULT_cfR(A,B,D)
+#define LOGICAL_cfR(A,B,D)
+#define PLOGICAL_cfR(A,B,D) *A=C2FLOGICAL(*A);
+#define STRING_cfR(A,B,D) if (B) _cf_free(B);
+#define STRINGV_cfR(A,B,D) _cf_free(B);
+/* A and D as defined above for TSTRING(V) */
+#define RRRRPSTR( A,B,D) if (B) memcpy(A,B, _cfMIN(strlen(B),D)), \
+ (D>strlen(B)?memset(A+strlen(B),' ', D-strlen(B)):0), _cf_free(B);
+#define RRRRPSTRV(A,B,D) c2fstrv(B,A,D+1,(D+1)*_(B,N)), _cf_free(B);
+#ifdef vmsFortran
+#define PSTRING_cfR(A,B,D) RRRRPSTR( A->dsc$a_pointer,B,A->dsc$w_length)
+#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A->dsc$a_pointer,B,A->dsc$w_length)
+#else
+#ifdef CRAYFortran
+#define PSTRING_cfR(A,B,D) RRRRPSTR( _fcdtocp(A),B,_fcdlen(A))
+#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(_fcdtocp(A),B,_fcdlen(A))
+#else
+#define PSTRING_cfR(A,B,D) RRRRPSTR( A,B,D)
+#define PSTRINGV_cfR(A,B,D) RRRRPSTRV(A,B,D)
+#endif
+#endif
+#define PNSTRING_cfR(A,B,D) PSTRING_cfR(A,B,D)
+#define PPSTRING_cfR(A,B,D)
+
+#define BYTE_cfFZ(UN,LN) INTEGER_BYTE FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define DOUBLE_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define INT_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define LOGICAL_cfFZ(UN,LN) int FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define LONG_cfFZ(UN,LN) long FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define LONGLONG_cfFZ(UN,LN) LONGLONG FCALLSC_QUALIFIER fcallsc(UN,LN)( /* added by MR December 2005 */
+#define SHORT_cfFZ(UN,LN) short FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#define VOID_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#ifndef __CF__KnR
+/* The void is req'd by the Apollo, to make this an ANSI function declaration.
+ The Apollo promotes K&R float functions to double. */
+#if defined (f2cFortran) && ! defined (gFortran)
+/* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
+#define FLOAT_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(void
+#else
+#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(void
+#endif
+#ifdef vmsFortran
+#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(fstring *AS
+#else
+#ifdef CRAYFortran
+#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(_fcd AS
+#else
+#if defined(AbsoftUNIXFortran) || defined(AbsoftProFortran)
+#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS
+#else
+#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(char *AS, unsigned D0
+#endif
+#endif
+#endif
+#else
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#if defined (f2cFortran) && ! defined (gFortran)
+/* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
+#define FLOAT_cfFZ(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#else
+#define FLOAT_cfFZ(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#endif
+#else
+#define FLOAT_cfFZ(UN,LN) FLOATFUNCTIONTYPE FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#endif
+#if defined(vmsFortran) || defined(CRAYFortran) || defined(AbsoftUNIXFortran)
+#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS
+#else
+#define STRING_cfFZ(UN,LN) void FCALLSC_QUALIFIER fcallsc(UN,LN)(AS, D0
+#endif
+#endif
+
+#define BYTE_cfF(UN,LN) BYTE_cfFZ(UN,LN)
+#define DOUBLE_cfF(UN,LN) DOUBLE_cfFZ(UN,LN)
+#ifndef __CF_KnR
+#if defined (f2cFortran) && ! defined (gFortran)
+/* f2c/g77 return double from FORTRAN REAL functions. (KMCCARTY, 2005/12/09) */
+#define FLOAT_cfF(UN,LN) DOUBLE_PRECISION FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#else
+#define FLOAT_cfF(UN,LN) FORTRAN_REAL FCALLSC_QUALIFIER fcallsc(UN,LN)(
+#endif
+#else
+#define FLOAT_cfF(UN,LN) FLOAT_cfFZ(UN,LN)
+#endif
+#define INT_cfF(UN,LN) INT_cfFZ(UN,LN)
+#define LOGICAL_cfF(UN,LN) LOGICAL_cfFZ(UN,LN)
+#define LONG_cfF(UN,LN) LONG_cfFZ(UN,LN)
+#define LONGLONG_cfF(UN,LN) LONGLONG_cfFZ(UN,LN) /* added by MR December 2005 */
+#define SHORT_cfF(UN,LN) SHORT_cfFZ(UN,LN)
+#define VOID_cfF(UN,LN) VOID_cfFZ(UN,LN)
+#define STRING_cfF(UN,LN) STRING_cfFZ(UN,LN),
+
+#define INT_cfFF
+#define VOID_cfFF
+#ifdef vmsFortran
+#define STRING_cfFF fstring *AS;
+#else
+#ifdef CRAYFortran
+#define STRING_cfFF _fcd AS;
+#else
+#define STRING_cfFF char *AS; unsigned D0;
+#endif
+#endif
+
+#define INT_cfL A0=
+#define STRING_cfL A0=
+#define VOID_cfL
+
+#define INT_cfK
+#define VOID_cfK
+/* KSTRING copies the string into the position provided by the caller. */
+#ifdef vmsFortran
+#define STRING_cfK \
+ memcpy(AS->dsc$a_pointer,A0,_cfMIN(AS->dsc$w_length,(A0==NULL?0:strlen(A0))));\
+ AS->dsc$w_length>(A0==NULL?0:strlen(A0))? \
+ memset(AS->dsc$a_pointer+(A0==NULL?0:strlen(A0)),' ', \
+ AS->dsc$w_length-(A0==NULL?0:strlen(A0))):0;
+#else
+#ifdef CRAYFortran
+#define STRING_cfK \
+ memcpy(_fcdtocp(AS),A0, _cfMIN(_fcdlen(AS),(A0==NULL?0:strlen(A0))) ); \
+ _fcdlen(AS)>(A0==NULL?0:strlen(A0))? \
+ memset(_fcdtocp(AS)+(A0==NULL?0:strlen(A0)),' ', \
+ _fcdlen(AS)-(A0==NULL?0:strlen(A0))):0;
+#else
+#define STRING_cfK memcpy(AS,A0, _cfMIN(D0,(A0==NULL?0:strlen(A0))) ); \
+ D0>(A0==NULL?0:strlen(A0))?memset(AS+(A0==NULL?0:strlen(A0)), \
+ ' ', D0-(A0==NULL?0:strlen(A0))):0;
+#endif
+#endif
+
+/* Note that K.. and I.. can't be combined since K.. has to access data before
+R.., in order for functions returning strings which are also passed in as
+arguments to work correctly. Note that R.. frees and hence may corrupt the
+string. */
+#define BYTE_cfI return A0;
+#define DOUBLE_cfI return A0;
+#if ! (defined(FLOATFUNCTIONTYPE)&&defined(ASSIGNFLOAT)&&defined(RETURNFLOAT))
+#define FLOAT_cfI return A0;
+#else
+#define FLOAT_cfI RETURNFLOAT(A0);
+#endif
+#define INT_cfI return A0;
+#ifdef hpuxFortran800
+/* Incredibly, functions must return true as 1, elsewhere .true.==0x01000000. */
+#define LOGICAL_cfI return ((A0)?1:0);
+#else
+#define LOGICAL_cfI return C2FLOGICAL(A0);
+#endif
+#define LONG_cfI return A0;
+#define LONGLONG_cfI return A0; /* added by MR December 2005 */
+#define SHORT_cfI return A0;
+#define STRING_cfI return ;
+#define VOID_cfI return ;
+
+#ifdef OLD_VAXC /* Allow %CC-I-PARAMNOTUSED. */
+#pragma standard
+#endif
+
+#define FCALLSCSUB0( CN,UN,LN) FCALLSCFUN0(VOID,CN,UN,LN)
+#define FCALLSCSUB1( CN,UN,LN,T1) FCALLSCFUN1(VOID,CN,UN,LN,T1)
+#define FCALLSCSUB2( CN,UN,LN,T1,T2) FCALLSCFUN2(VOID,CN,UN,LN,T1,T2)
+#define FCALLSCSUB3( CN,UN,LN,T1,T2,T3) FCALLSCFUN3(VOID,CN,UN,LN,T1,T2,T3)
+#define FCALLSCSUB4( CN,UN,LN,T1,T2,T3,T4) \
+ FCALLSCFUN4(VOID,CN,UN,LN,T1,T2,T3,T4)
+#define FCALLSCSUB5( CN,UN,LN,T1,T2,T3,T4,T5) \
+ FCALLSCFUN5(VOID,CN,UN,LN,T1,T2,T3,T4,T5)
+#define FCALLSCSUB6( CN,UN,LN,T1,T2,T3,T4,T5,T6) \
+ FCALLSCFUN6(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6)
+#define FCALLSCSUB7( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
+ FCALLSCFUN7(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7)
+#define FCALLSCSUB8( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
+ FCALLSCFUN8(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8)
+#define FCALLSCSUB9( CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
+ FCALLSCFUN9(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9)
+#define FCALLSCSUB10(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
+ FCALLSCFUN10(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA)
+#define FCALLSCSUB11(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
+ FCALLSCFUN11(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB)
+#define FCALLSCSUB12(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
+ FCALLSCFUN12(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC)
+#define FCALLSCSUB13(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
+ FCALLSCFUN13(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD)
+#define FCALLSCSUB14(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE) \
+ FCALLSCFUN14(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)
+#define FCALLSCSUB15(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
+ FCALLSCFUN15(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF)
+#define FCALLSCSUB16(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
+ FCALLSCFUN16(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG)
+#define FCALLSCSUB17(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
+ FCALLSCFUN17(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH)
+#define FCALLSCSUB18(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
+ FCALLSCFUN18(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI)
+#define FCALLSCSUB19(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
+ FCALLSCFUN19(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ)
+#define FCALLSCSUB20(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+ FCALLSCFUN20(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK)
+#define FCALLSCSUB21(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
+ FCALLSCFUN21(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL)
+#define FCALLSCSUB22(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
+ FCALLSCFUN22(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM)
+#define FCALLSCSUB23(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
+ FCALLSCFUN23(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN)
+#define FCALLSCSUB24(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
+ FCALLSCFUN24(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO)
+#define FCALLSCSUB25(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
+ FCALLSCFUN25(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP)
+#define FCALLSCSUB26(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
+ FCALLSCFUN26(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ)
+#define FCALLSCSUB27(CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ FCALLSCFUN27(VOID,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)
+
+
+#define FCALLSCFUN1( T0,CN,UN,LN,T1) \
+ FCALLSCFUN5 (T0,CN,UN,LN,T1,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN2( T0,CN,UN,LN,T1,T2) \
+ FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,CF_0,CF_0,CF_0)
+#define FCALLSCFUN3( T0,CN,UN,LN,T1,T2,T3) \
+ FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,CF_0,CF_0)
+#define FCALLSCFUN4( T0,CN,UN,LN,T1,T2,T3,T4) \
+ FCALLSCFUN5 (T0,CN,UN,LN,T1,T2,T3,T4,CF_0)
+#define FCALLSCFUN5( T0,CN,UN,LN,T1,T2,T3,T4,T5) \
+ FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN6( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6) \
+ FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN7( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7) \
+ FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,CF_0,CF_0,CF_0)
+#define FCALLSCFUN8( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8) \
+ FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,CF_0,CF_0)
+#define FCALLSCFUN9( T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9) \
+ FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,CF_0)
+#define FCALLSCFUN10(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA) \
+ FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN11(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB) \
+ FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,CF_0,CF_0,CF_0)
+#define FCALLSCFUN12(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC) \
+ FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,CF_0,CF_0)
+#define FCALLSCFUN13(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD) \
+ FCALLSCFUN14(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,CF_0)
+
+
+#define FCALLSCFUN15(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF) \
+ FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN16(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG) \
+ FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN17(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH) \
+ FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,CF_0,CF_0,CF_0)
+#define FCALLSCFUN18(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI) \
+ FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,CF_0,CF_0)
+#define FCALLSCFUN19(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ) \
+ FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,CF_0)
+#define FCALLSCFUN20(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK) \
+ FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN21(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL) \
+ FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,CF_0,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN22(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM) \
+ FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,CF_0,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN23(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN) \
+ FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,CF_0,CF_0,CF_0,CF_0)
+#define FCALLSCFUN24(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO) \
+ FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,CF_0,CF_0,CF_0)
+#define FCALLSCFUN25(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP) \
+ FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,CF_0,CF_0)
+#define FCALLSCFUN26(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ) \
+ FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,CF_0)
+
+
+#ifndef __CF__KnR
+#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) 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) ) \
+ { 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) }
+
+#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ CFextern _(T0,_cfF)(UN,LN) \
+ CFARGT27(NCF,DCF,ABSOFT_cf2(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) ) \
+ { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ _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) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
+ TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
+ TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
+ CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI) }
+
+#else
+#define FCALLSCFUN0(T0,CN,UN,LN) CFextern _(T0,_cfFZ)(UN,LN) ABSOFT_cf3(T0)) _Icf(0,FF,T0,0,0)\
+ {_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(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE)) _Icf(0,FF,T0,0,0) \
+ CFARGT14FS(NNNCF,DDDCF,_Z,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)}
+
+#define FCALLSCFUN27(T0,CN,UN,LN,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ CFextern _(T0,_cfF)(UN,LN) \
+ CFARGT27(NNCF,DDCF,ABSOFT_cf3(T0),T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR)) _Icf(0,FF,T0,0,0) \
+ CFARGT27FS(NNNCF,DDDCF,_Z,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR); \
+ { CFARGT27S(QCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) \
+ _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) TCF(LN,TF,15,1) TCF(LN,TG,16,1) TCF(LN,TH,17,1) \
+ TCF(LN,TI,18,1) TCF(LN,TJ,19,1) TCF(LN,TK,20,1) TCF(LN,TL,21,1) TCF(LN,TM,22,1) \
+ TCF(LN,TN,23,1) TCF(LN,TO,24,1) TCF(LN,TP,25,1) TCF(LN,TQ,26,1) TCF(LN,TR,27,1) ); _Icf(0,K,T0,0,0) \
+ CFARGT27S(RCF,T1,T2,T3,T4,T5,T6,T7,T8,T9,TA,TB,TC,TD,TE,TF,TG,TH,TI,TJ,TK,TL,TM,TN,TO,TP,TQ,TR) _(T0,_cfI)}
+
+#endif
+
+
+#endif /* __CFORTRAN_LOADED */
diff --git a/src/plugins/cfitsio/checksum.c b/src/plugins/cfitsio/checksum.c
new file mode 100644
index 0000000..c52b9ef
--- /dev/null
+++ b/src/plugins/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);
+}
+
diff --git a/src/plugins/cfitsio/crc32.c b/src/plugins/cfitsio/crc32.c
new file mode 100644
index 0000000..08843ff
--- /dev/null
+++ b/src/plugins/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);
+}
diff --git a/src/plugins/cfitsio/crc32.h b/src/plugins/cfitsio/crc32.h
new file mode 100644
index 0000000..8053b61
--- /dev/null
+++ b/src/plugins/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
+ }
+};
diff --git a/src/plugins/cfitsio/deflate.c b/src/plugins/cfitsio/deflate.c
new file mode 100644
index 0000000..1c6a00c
--- /dev/null
+++ b/src/plugins/cfitsio/deflate.c
@@ -0,0 +1,1832 @@
+/* deflate.c -- compress data using the deflation algorithm
+ * Copyright (C) 1995-2010 Jean-loup Gailly and Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/*
+ * ALGORITHM
+ *
+ * The "deflation" process depends on being able to identify portions
+ * of the input text which are identical to earlier input (within a
+ * sliding window trailing behind the input currently being processed).
+ *
+ * The most straightforward technique turns out to be the fastest for
+ * most input files: try all possible matches and select the longest.
+ * The key feature of this algorithm is that insertions into the string
+ * dictionary are very simple and thus fast, and deletions are avoided
+ * completely. Insertions are performed at each input character, whereas
+ * string matches are performed only when the previous match ends. So it
+ * is preferable to spend more time in matches to allow very fast string
+ * insertions and avoid deletions. The matching algorithm for small
+ * strings is inspired from that of Rabin & Karp. A brute force approach
+ * is used to find longer strings when a small match has been found.
+ * A similar algorithm is used in comic (by Jan-Mark Wams) and freeze
+ * (by Leonid Broukhis).
+ * A previous version of this file used a more sophisticated algorithm
+ * (by Fiala and Greene) which is guaranteed to run in linear amortized
+ * time, but has a larger average cost, uses more memory and is patented.
+ * However the F&G algorithm may be faster for some highly redundant
+ * files if the parameter max_chain_length (described below) is too large.
+ *
+ * ACKNOWLEDGEMENTS
+ *
+ * The idea of lazy evaluation of matches is due to Jan-Mark Wams, and
+ * I found it in 'freeze' written by Leonid Broukhis.
+ * Thanks to many people for bug reports and testing.
+ *
+ * REFERENCES
+ *
+ * Deutsch, L.P.,"DEFLATE Compressed Data Format Specification".
+ * Available in http://www.ietf.org/rfc/rfc1951.txt
+ *
+ * A description of the Rabin and Karp algorithm is given in the book
+ * "Algorithms" by R. Sedgewick, Addison-Wesley, p252.
+ *
+ * Fiala,E.R., and Greene,D.H.
+ * Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595
+ *
+ */
+
+#include "deflate.h"
+
+const char deflate_copyright[] =
+ " deflate 1.2.5 Copyright 1995-2010 Jean-loup Gailly and 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.
+ */
+
+/* ===========================================================================
+ * Function prototypes.
+ */
+typedef enum {
+ need_more, /* block not completed, need more input or more output */
+ block_done, /* block flush performed */
+ finish_started, /* finish started, need only more output at next deflate */
+ finish_done /* finish done, accept no more input or output */
+} block_state;
+
+typedef block_state (*compress_func) OF((deflate_state *s, int flush));
+/* Compression function. Returns the block state after the call. */
+
+local void fill_window OF((deflate_state *s));
+local block_state deflate_stored OF((deflate_state *s, int flush));
+local block_state deflate_fast OF((deflate_state *s, int flush));
+#ifndef FASTEST
+local block_state deflate_slow OF((deflate_state *s, int flush));
+#endif
+local block_state deflate_rle OF((deflate_state *s, int flush));
+local block_state deflate_huff OF((deflate_state *s, int flush));
+local void lm_init OF((deflate_state *s));
+local void putShortMSB OF((deflate_state *s, uInt b));
+local void flush_pending OF((z_streamp strm));
+local int read_buf OF((z_streamp strm, Bytef *buf, unsigned size));
+#ifdef ASMV
+ void match_init OF((void)); /* asm code initialization */
+ uInt longest_match OF((deflate_state *s, IPos cur_match));
+#else
+local uInt longest_match OF((deflate_state *s, IPos cur_match));
+#endif
+
+#ifdef DEBUG
+local void check_match OF((deflate_state *s, IPos start, IPos match,
+ int length));
+#endif
+
+/* ===========================================================================
+ * Local data
+ */
+
+#define NIL 0
+/* Tail of hash chains */
+
+#ifndef TOO_FAR
+# define TOO_FAR 4096
+#endif
+/* Matches of length 3 are discarded if their distance exceeds TOO_FAR */
+
+/* Values for max_lazy_match, good_match and max_chain_length, depending on
+ * the desired pack level (0..9). The values given below have been tuned to
+ * exclude worst case performance for pathological files. Better values may be
+ * found for specific files.
+ */
+typedef struct config_s {
+ ush good_length; /* reduce lazy search above this match length */
+ ush max_lazy; /* do not perform lazy search above this match length */
+ ush nice_length; /* quit search above this match length */
+ ush max_chain;
+ compress_func func;
+} config;
+
+#ifdef FASTEST
+local const config configuration_table[2] = {
+/* good lazy nice chain */
+/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */
+/* 1 */ {4, 4, 8, 4, deflate_fast}}; /* max speed, no lazy matches */
+#else
+local const config configuration_table[10] = {
+/* good lazy nice chain */
+/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */
+/* 1 */ {4, 4, 8, 4, deflate_fast}, /* max speed, no lazy matches */
+/* 2 */ {4, 5, 16, 8, deflate_fast},
+/* 3 */ {4, 6, 32, 32, deflate_fast},
+
+/* 4 */ {4, 4, 16, 16, deflate_slow}, /* lazy matches */
+/* 5 */ {8, 16, 32, 32, deflate_slow},
+/* 6 */ {8, 16, 128, 128, deflate_slow},
+/* 7 */ {8, 32, 128, 256, deflate_slow},
+/* 8 */ {32, 128, 258, 1024, deflate_slow},
+/* 9 */ {32, 258, 258, 4096, deflate_slow}}; /* max compression */
+#endif
+
+/* Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4
+ * For deflate_fast() (levels <= 3) good is ignored and lazy has a different
+ * meaning.
+ */
+
+#define EQUAL 0
+/* result of memcmp for equal strings */
+
+#ifndef NO_DUMMY_DECL
+struct static_tree_desc_s {int dummy;}; /* for buggy compilers */
+#endif
+
+/* ===========================================================================
+ * Update a hash value with the given input byte
+ * IN assertion: all calls to to UPDATE_HASH are made with consecutive
+ * input characters, so that a running hash key can be computed from the
+ * previous key instead of complete recalculation each time.
+ */
+#define UPDATE_HASH(s,h,c) (h = (((h)<<s->hash_shift) ^ (c)) & s->hash_mask)
+
+
+/* ===========================================================================
+ * Insert string str in the dictionary and set match_head to the previous head
+ * of the hash chain (the most recent string with same hash key). Return
+ * the previous length of the hash chain.
+ * If this file is compiled with -DFASTEST, the compression level is forced
+ * to 1, and no hash chains are maintained.
+ * IN assertion: all calls to to INSERT_STRING are made with consecutive
+ * input characters and the first MIN_MATCH bytes of str are valid
+ * (except for the last MIN_MATCH-1 bytes of the input file).
+ */
+#ifdef FASTEST
+#define INSERT_STRING(s, str, match_head) \
+ (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \
+ match_head = s->head[s->ins_h], \
+ s->head[s->ins_h] = (Pos)(str))
+#else
+#define INSERT_STRING(s, str, match_head) \
+ (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \
+ match_head = s->prev[(str) & s->w_mask] = s->head[s->ins_h], \
+ s->head[s->ins_h] = (Pos)(str))
+#endif
+
+/* ===========================================================================
+ * Initialize the hash table (avoiding 64K overflow for 16 bit systems).
+ * prev[] will be initialized on the fly.
+ */
+#define CLEAR_HASH(s) \
+ s->head[s->hash_size-1] = NIL; \
+ zmemzero((Bytef *)s->head, (unsigned)(s->hash_size-1)*sizeof(*s->head));
+
+/* ========================================================================= */
+int ZEXPORT deflateInit_(strm, level, version, stream_size)
+ z_streamp strm;
+ int level;
+ const char *version;
+ int stream_size;
+{
+ return deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL,
+ Z_DEFAULT_STRATEGY, version, stream_size);
+ /* To do: ignore strm->next_in if we use it as window */
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateInit2_(strm, level, method, windowBits, memLevel, strategy,
+ version, stream_size)
+ z_streamp strm;
+ int level;
+ int method;
+ int windowBits;
+ int memLevel;
+ int strategy;
+ const char *version;
+ int stream_size;
+{
+ deflate_state *s;
+ int wrap = 1;
+ static const char my_version[] = ZLIB_VERSION;
+
+ ushf *overlay;
+ /* We overlay pending_buf and d_buf+l_buf. This works since the average
+ * output size for (length,distance) codes is <= 24 bits.
+ */
+
+ if (version == Z_NULL || version[0] != my_version[0] ||
+ stream_size != sizeof(z_stream)) {
+ return Z_VERSION_ERROR;
+ }
+ if (strm == Z_NULL) return Z_STREAM_ERROR;
+
+ strm->msg = Z_NULL;
+ if (strm->zalloc == (alloc_func)0) {
+ strm->zalloc = zcalloc;
+ strm->opaque = (voidpf)0;
+ }
+ if (strm->zfree == (free_func)0) strm->zfree = zcfree;
+
+#ifdef FASTEST
+ if (level != 0) level = 1;
+#else
+ if (level == Z_DEFAULT_COMPRESSION) level = 6;
+#endif
+
+ if (windowBits < 0) { /* suppress zlib wrapper */
+ wrap = 0;
+ windowBits = -windowBits;
+ }
+#ifdef GZIP
+ else if (windowBits > 15) {
+ wrap = 2; /* write gzip wrapper instead */
+ windowBits -= 16;
+ }
+#endif
+ if (memLevel < 1 || memLevel > MAX_MEM_LEVEL || method != Z_DEFLATED ||
+ windowBits < 8 || windowBits > 15 || level < 0 || level > 9 ||
+ strategy < 0 || strategy > Z_FIXED) {
+ return Z_STREAM_ERROR;
+ }
+ if (windowBits == 8) windowBits = 9; /* until 256-byte window bug fixed */
+ s = (deflate_state *) ZALLOC(strm, 1, sizeof(deflate_state));
+ if (s == Z_NULL) return Z_MEM_ERROR;
+ strm->state = (struct internal_state FAR *)s;
+ s->strm = strm;
+
+ s->wrap = wrap;
+ s->gzhead = Z_NULL;
+ s->w_bits = windowBits;
+ s->w_size = 1 << s->w_bits;
+ s->w_mask = s->w_size - 1;
+
+ s->hash_bits = memLevel + 7;
+ s->hash_size = 1 << s->hash_bits;
+ s->hash_mask = s->hash_size - 1;
+ s->hash_shift = ((s->hash_bits+MIN_MATCH-1)/MIN_MATCH);
+
+ s->window = (Bytef *) ZALLOC(strm, s->w_size, 2*sizeof(Byte));
+ s->prev = (Posf *) ZALLOC(strm, s->w_size, sizeof(Pos));
+ s->head = (Posf *) ZALLOC(strm, s->hash_size, sizeof(Pos));
+
+ s->high_water = 0; /* nothing written to s->window yet */
+
+ s->lit_bufsize = 1 << (memLevel + 6); /* 16K elements by default */
+
+ overlay = (ushf *) ZALLOC(strm, s->lit_bufsize, sizeof(ush)+2);
+ s->pending_buf = (uchf *) overlay;
+ s->pending_buf_size = (ulg)s->lit_bufsize * (sizeof(ush)+2L);
+
+ if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL ||
+ s->pending_buf == Z_NULL) {
+ s->status = FINISH_STATE;
+ strm->msg = (char*)ERR_MSG(Z_MEM_ERROR);
+ deflateEnd (strm);
+ return Z_MEM_ERROR;
+ }
+ s->d_buf = overlay + s->lit_bufsize/sizeof(ush);
+ s->l_buf = s->pending_buf + (1+sizeof(ush))*s->lit_bufsize;
+
+ s->level = level;
+ s->strategy = strategy;
+ s->method = (Byte)method;
+
+ return deflateReset(strm);
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateSetDictionary (strm, dictionary, dictLength)
+ z_streamp strm;
+ const Bytef *dictionary;
+ uInt dictLength;
+{
+ deflate_state *s;
+ uInt length = dictLength;
+ uInt n;
+ IPos hash_head = 0;
+
+ if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL ||
+ strm->state->wrap == 2 ||
+ (strm->state->wrap == 1 && strm->state->status != INIT_STATE))
+ return Z_STREAM_ERROR;
+
+ s = strm->state;
+ if (s->wrap)
+ strm->adler = adler32(strm->adler, dictionary, dictLength);
+
+ if (length < MIN_MATCH) return Z_OK;
+ if (length > s->w_size) {
+ length = s->w_size;
+ dictionary += dictLength - length; /* use the tail of the dictionary */
+ }
+ zmemcpy(s->window, dictionary, length);
+ s->strstart = length;
+ s->block_start = (long)length;
+
+ /* Insert all strings in the hash table (except for the last two bytes).
+ * s->lookahead stays null, so s->ins_h will be recomputed at the next
+ * call of fill_window.
+ */
+ s->ins_h = s->window[0];
+ UPDATE_HASH(s, s->ins_h, s->window[1]);
+ for (n = 0; n <= length - MIN_MATCH; n++) {
+ INSERT_STRING(s, n, hash_head);
+ }
+ if (hash_head) hash_head = 0; /* to make compiler happy */
+ return Z_OK;
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateReset (strm)
+ z_streamp strm;
+{
+ deflate_state *s;
+
+ if (strm == Z_NULL || strm->state == Z_NULL ||
+ strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0) {
+ return Z_STREAM_ERROR;
+ }
+
+ strm->total_in = strm->total_out = 0;
+ strm->msg = Z_NULL; /* use zfree if we ever allocate msg dynamically */
+ strm->data_type = Z_UNKNOWN;
+
+ s = (deflate_state *)strm->state;
+ s->pending = 0;
+ s->pending_out = s->pending_buf;
+
+ if (s->wrap < 0) {
+ s->wrap = -s->wrap; /* was made negative by deflate(..., Z_FINISH); */
+ }
+ s->status = s->wrap ? INIT_STATE : BUSY_STATE;
+ strm->adler =
+#ifdef GZIP
+ s->wrap == 2 ? crc32(0L, Z_NULL, 0) :
+#endif
+ adler32(0L, Z_NULL, 0);
+ s->last_flush = Z_NO_FLUSH;
+
+ _tr_init(s);
+ lm_init(s);
+
+ return Z_OK;
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateSetHeader (strm, head)
+ z_streamp strm;
+ gz_headerp head;
+{
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ if (strm->state->wrap != 2) return Z_STREAM_ERROR;
+ strm->state->gzhead = head;
+ return Z_OK;
+}
+
+/* ========================================================================= */
+int ZEXPORT deflatePrime (strm, bits, value)
+ z_streamp strm;
+ int bits;
+ int value;
+{
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ strm->state->bi_valid = bits;
+ strm->state->bi_buf = (ush)(value & ((1 << bits) - 1));
+ return Z_OK;
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateParams(strm, level, strategy)
+ z_streamp strm;
+ int level;
+ int strategy;
+{
+ deflate_state *s;
+ compress_func func;
+ int err = Z_OK;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ s = strm->state;
+
+#ifdef FASTEST
+ if (level != 0) level = 1;
+#else
+ if (level == Z_DEFAULT_COMPRESSION) level = 6;
+#endif
+ if (level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED) {
+ return Z_STREAM_ERROR;
+ }
+ func = configuration_table[s->level].func;
+
+ if ((strategy != s->strategy || func != configuration_table[level].func) &&
+ strm->total_in != 0) {
+ /* Flush the last buffer: */
+ err = deflate(strm, Z_BLOCK);
+ }
+ if (s->level != level) {
+ s->level = level;
+ s->max_lazy_match = configuration_table[level].max_lazy;
+ s->good_match = configuration_table[level].good_length;
+ s->nice_match = configuration_table[level].nice_length;
+ s->max_chain_length = configuration_table[level].max_chain;
+ }
+ s->strategy = strategy;
+ return err;
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateTune(strm, good_length, max_lazy, nice_length, max_chain)
+ z_streamp strm;
+ int good_length;
+ int max_lazy;
+ int nice_length;
+ int max_chain;
+{
+ deflate_state *s;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ s = strm->state;
+ s->good_match = good_length;
+ s->max_lazy_match = max_lazy;
+ s->nice_match = nice_length;
+ s->max_chain_length = max_chain;
+ return Z_OK;
+}
+
+/* =========================================================================
+ * For the default windowBits of 15 and memLevel of 8, this function returns
+ * a close to exact, as well as small, upper bound on the compressed size.
+ * They are coded as constants here for a reason--if the #define's are
+ * changed, then this function needs to be changed as well. The return
+ * value for 15 and 8 only works for those exact settings.
+ *
+ * For any setting other than those defaults for windowBits and memLevel,
+ * the value returned is a conservative worst case for the maximum expansion
+ * resulting from using fixed blocks instead of stored blocks, which deflate
+ * can emit on compressed data for some combinations of the parameters.
+ *
+ * This function could be more sophisticated to provide closer upper bounds for
+ * every combination of windowBits and memLevel. But even the conservative
+ * upper bound of about 14% expansion does not seem onerous for output buffer
+ * allocation.
+ */
+uLong ZEXPORT deflateBound(strm, sourceLen)
+ z_streamp strm;
+ uLong sourceLen;
+{
+ deflate_state *s;
+ uLong complen, wraplen;
+ Bytef *str;
+
+ /* conservative upper bound for compressed data */
+ complen = sourceLen +
+ ((sourceLen + 7) >> 3) + ((sourceLen + 63) >> 6) + 5;
+
+ /* if can't get parameters, return conservative bound plus zlib wrapper */
+ if (strm == Z_NULL || strm->state == Z_NULL)
+ return complen + 6;
+
+ /* compute wrapper length */
+ s = strm->state;
+ switch (s->wrap) {
+ case 0: /* raw deflate */
+ wraplen = 0;
+ break;
+ case 1: /* zlib wrapper */
+ wraplen = 6 + (s->strstart ? 4 : 0);
+ break;
+ case 2: /* gzip wrapper */
+ wraplen = 18;
+ if (s->gzhead != Z_NULL) { /* user-supplied gzip header */
+ if (s->gzhead->extra != Z_NULL)
+ wraplen += 2 + s->gzhead->extra_len;
+ str = s->gzhead->name;
+ if (str != Z_NULL)
+ do {
+ wraplen++;
+ } while (*str++);
+ str = s->gzhead->comment;
+ if (str != Z_NULL)
+ do {
+ wraplen++;
+ } while (*str++);
+ if (s->gzhead->hcrc)
+ wraplen += 2;
+ }
+ break;
+ default: /* for compiler happiness */
+ wraplen = 6;
+ }
+
+ /* if not default parameters, return conservative bound */
+ if (s->w_bits != 15 || s->hash_bits != 8 + 7)
+ return complen + wraplen;
+
+ /* default settings: return tight bound for that case */
+ return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) +
+ (sourceLen >> 25) + 13 - 6 + wraplen;
+}
+
+/* =========================================================================
+ * Put a short in the pending buffer. The 16-bit value is put in MSB order.
+ * IN assertion: the stream state is correct and there is enough room in
+ * pending_buf.
+ */
+local void putShortMSB (s, b)
+ deflate_state *s;
+ uInt b;
+{
+ put_byte(s, (Byte)(b >> 8));
+ put_byte(s, (Byte)(b & 0xff));
+}
+
+/* =========================================================================
+ * Flush as much pending output as possible. All deflate() output goes
+ * through this function so some applications may wish to modify it
+ * to avoid allocating a large strm->next_out buffer and copying into it.
+ * (See also read_buf()).
+ */
+local void flush_pending(strm)
+ z_streamp strm;
+{
+ unsigned len = strm->state->pending;
+
+ if (len > strm->avail_out) len = strm->avail_out;
+ if (len == 0) return;
+
+ zmemcpy(strm->next_out, strm->state->pending_out, len);
+ strm->next_out += len;
+ strm->state->pending_out += len;
+ strm->total_out += len;
+ strm->avail_out -= len;
+ strm->state->pending -= len;
+ if (strm->state->pending == 0) {
+ strm->state->pending_out = strm->state->pending_buf;
+ }
+}
+
+/* ========================================================================= */
+int ZEXPORT deflate (strm, flush)
+ z_streamp strm;
+ int flush;
+{
+ int old_flush; /* value of flush param for previous deflate call */
+ deflate_state *s;
+
+ if (strm == Z_NULL || strm->state == Z_NULL ||
+ flush > Z_BLOCK || flush < 0) {
+ return Z_STREAM_ERROR;
+ }
+ s = strm->state;
+
+ if (strm->next_out == Z_NULL ||
+ (strm->next_in == Z_NULL && strm->avail_in != 0) ||
+ (s->status == FINISH_STATE && flush != Z_FINISH)) {
+ ERR_RETURN(strm, Z_STREAM_ERROR);
+ }
+ if (strm->avail_out == 0) ERR_RETURN(strm, Z_BUF_ERROR);
+
+ s->strm = strm; /* just in case */
+ old_flush = s->last_flush;
+ s->last_flush = flush;
+
+ /* Write the header */
+ if (s->status == INIT_STATE) {
+#ifdef GZIP
+ if (s->wrap == 2) {
+ strm->adler = crc32(0L, Z_NULL, 0);
+ put_byte(s, 31);
+ put_byte(s, 139);
+ put_byte(s, 8);
+ if (s->gzhead == Z_NULL) {
+ put_byte(s, 0);
+ put_byte(s, 0);
+ put_byte(s, 0);
+ put_byte(s, 0);
+ put_byte(s, 0);
+ put_byte(s, s->level == 9 ? 2 :
+ (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ?
+ 4 : 0));
+ put_byte(s, OS_CODE);
+ s->status = BUSY_STATE;
+ }
+ else {
+ put_byte(s, (s->gzhead->text ? 1 : 0) +
+ (s->gzhead->hcrc ? 2 : 0) +
+ (s->gzhead->extra == Z_NULL ? 0 : 4) +
+ (s->gzhead->name == Z_NULL ? 0 : 8) +
+ (s->gzhead->comment == Z_NULL ? 0 : 16)
+ );
+ put_byte(s, (Byte)(s->gzhead->time & 0xff));
+ put_byte(s, (Byte)((s->gzhead->time >> 8) & 0xff));
+ put_byte(s, (Byte)((s->gzhead->time >> 16) & 0xff));
+ put_byte(s, (Byte)((s->gzhead->time >> 24) & 0xff));
+ put_byte(s, s->level == 9 ? 2 :
+ (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ?
+ 4 : 0));
+ put_byte(s, s->gzhead->os & 0xff);
+ if (s->gzhead->extra != Z_NULL) {
+ put_byte(s, s->gzhead->extra_len & 0xff);
+ put_byte(s, (s->gzhead->extra_len >> 8) & 0xff);
+ }
+ if (s->gzhead->hcrc)
+ strm->adler = crc32(strm->adler, s->pending_buf,
+ s->pending);
+ s->gzindex = 0;
+ s->status = EXTRA_STATE;
+ }
+ }
+ else
+#endif
+ {
+ uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8;
+ uInt level_flags;
+
+ if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2)
+ level_flags = 0;
+ else if (s->level < 6)
+ level_flags = 1;
+ else if (s->level == 6)
+ level_flags = 2;
+ else
+ level_flags = 3;
+ header |= (level_flags << 6);
+ if (s->strstart != 0) header |= PRESET_DICT;
+ header += 31 - (header % 31);
+
+ s->status = BUSY_STATE;
+ putShortMSB(s, header);
+
+ /* Save the adler32 of the preset dictionary: */
+ if (s->strstart != 0) {
+ putShortMSB(s, (uInt)(strm->adler >> 16));
+ putShortMSB(s, (uInt)(strm->adler & 0xffff));
+ }
+ strm->adler = adler32(0L, Z_NULL, 0);
+ }
+ }
+#ifdef GZIP
+ if (s->status == EXTRA_STATE) {
+ if (s->gzhead->extra != Z_NULL) {
+ uInt beg = s->pending; /* start of bytes to update crc */
+
+ while (s->gzindex < (s->gzhead->extra_len & 0xffff)) {
+ if (s->pending == s->pending_buf_size) {
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ flush_pending(strm);
+ beg = s->pending;
+ if (s->pending == s->pending_buf_size)
+ break;
+ }
+ put_byte(s, s->gzhead->extra[s->gzindex]);
+ s->gzindex++;
+ }
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ if (s->gzindex == s->gzhead->extra_len) {
+ s->gzindex = 0;
+ s->status = NAME_STATE;
+ }
+ }
+ else
+ s->status = NAME_STATE;
+ }
+ if (s->status == NAME_STATE) {
+ if (s->gzhead->name != Z_NULL) {
+ uInt beg = s->pending; /* start of bytes to update crc */
+ int val;
+
+ do {
+ if (s->pending == s->pending_buf_size) {
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ flush_pending(strm);
+ beg = s->pending;
+ if (s->pending == s->pending_buf_size) {
+ val = 1;
+ break;
+ }
+ }
+ val = s->gzhead->name[s->gzindex++];
+ put_byte(s, val);
+ } while (val != 0);
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ if (val == 0) {
+ s->gzindex = 0;
+ s->status = COMMENT_STATE;
+ }
+ }
+ else
+ s->status = COMMENT_STATE;
+ }
+ if (s->status == COMMENT_STATE) {
+ if (s->gzhead->comment != Z_NULL) {
+ uInt beg = s->pending; /* start of bytes to update crc */
+ int val;
+
+ do {
+ if (s->pending == s->pending_buf_size) {
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ flush_pending(strm);
+ beg = s->pending;
+ if (s->pending == s->pending_buf_size) {
+ val = 1;
+ break;
+ }
+ }
+ val = s->gzhead->comment[s->gzindex++];
+ put_byte(s, val);
+ } while (val != 0);
+ if (s->gzhead->hcrc && s->pending > beg)
+ strm->adler = crc32(strm->adler, s->pending_buf + beg,
+ s->pending - beg);
+ if (val == 0)
+ s->status = HCRC_STATE;
+ }
+ else
+ s->status = HCRC_STATE;
+ }
+ if (s->status == HCRC_STATE) {
+ if (s->gzhead->hcrc) {
+ if (s->pending + 2 > s->pending_buf_size)
+ flush_pending(strm);
+ if (s->pending + 2 <= s->pending_buf_size) {
+ put_byte(s, (Byte)(strm->adler & 0xff));
+ put_byte(s, (Byte)((strm->adler >> 8) & 0xff));
+ strm->adler = crc32(0L, Z_NULL, 0);
+ s->status = BUSY_STATE;
+ }
+ }
+ else
+ s->status = BUSY_STATE;
+ }
+#endif
+
+ /* Flush as much pending output as possible */
+ if (s->pending != 0) {
+ flush_pending(strm);
+ if (strm->avail_out == 0) {
+ /* Since avail_out is 0, deflate will be called again with
+ * more output space, but possibly with both pending and
+ * avail_in equal to zero. There won't be anything to do,
+ * but this is not an error situation so make sure we
+ * return OK instead of BUF_ERROR at next call of deflate:
+ */
+ s->last_flush = -1;
+ return Z_OK;
+ }
+
+ /* Make sure there is something to do and avoid duplicate consecutive
+ * flushes. For repeated and useless calls with Z_FINISH, we keep
+ * returning Z_STREAM_END instead of Z_BUF_ERROR.
+ */
+ } else if (strm->avail_in == 0 && flush <= old_flush &&
+ flush != Z_FINISH) {
+ ERR_RETURN(strm, Z_BUF_ERROR);
+ }
+
+ /* User must not provide more input after the first FINISH: */
+ if (s->status == FINISH_STATE && strm->avail_in != 0) {
+ ERR_RETURN(strm, Z_BUF_ERROR);
+ }
+
+ /* Start a new block or continue the current one.
+ */
+ if (strm->avail_in != 0 || s->lookahead != 0 ||
+ (flush != Z_NO_FLUSH && s->status != FINISH_STATE)) {
+ block_state bstate;
+
+ bstate = s->strategy == Z_HUFFMAN_ONLY ? deflate_huff(s, flush) :
+ (s->strategy == Z_RLE ? deflate_rle(s, flush) :
+ (*(configuration_table[s->level].func))(s, flush));
+
+ if (bstate == finish_started || bstate == finish_done) {
+ s->status = FINISH_STATE;
+ }
+ if (bstate == need_more || bstate == finish_started) {
+ if (strm->avail_out == 0) {
+ s->last_flush = -1; /* avoid BUF_ERROR next call, see above */
+ }
+ return Z_OK;
+ /* If flush != Z_NO_FLUSH && avail_out == 0, the next call
+ * of deflate should use the same flush parameter to make sure
+ * that the flush is complete. So we don't have to output an
+ * empty block here, this will be done at next call. This also
+ * ensures that for a very small output buffer, we emit at most
+ * one empty block.
+ */
+ }
+ if (bstate == block_done) {
+ if (flush == Z_PARTIAL_FLUSH) {
+ _tr_align(s);
+ } else if (flush != Z_BLOCK) { /* FULL_FLUSH or SYNC_FLUSH */
+ _tr_stored_block(s, (char*)0, 0L, 0);
+ /* For a full flush, this empty block will be recognized
+ * as a special marker by inflate_sync().
+ */
+ if (flush == Z_FULL_FLUSH) {
+ CLEAR_HASH(s); /* forget history */
+ if (s->lookahead == 0) {
+ s->strstart = 0;
+ s->block_start = 0L;
+ }
+ }
+ }
+ flush_pending(strm);
+ if (strm->avail_out == 0) {
+ s->last_flush = -1; /* avoid BUF_ERROR at next call, see above */
+ return Z_OK;
+ }
+ }
+ }
+ Assert(strm->avail_out > 0, "bug2");
+
+ if (flush != Z_FINISH) return Z_OK;
+ if (s->wrap <= 0) return Z_STREAM_END;
+
+ /* Write the trailer */
+#ifdef GZIP
+ if (s->wrap == 2) {
+ put_byte(s, (Byte)(strm->adler & 0xff));
+ put_byte(s, (Byte)((strm->adler >> 8) & 0xff));
+ put_byte(s, (Byte)((strm->adler >> 16) & 0xff));
+ put_byte(s, (Byte)((strm->adler >> 24) & 0xff));
+ put_byte(s, (Byte)(strm->total_in & 0xff));
+ put_byte(s, (Byte)((strm->total_in >> 8) & 0xff));
+ put_byte(s, (Byte)((strm->total_in >> 16) & 0xff));
+ put_byte(s, (Byte)((strm->total_in >> 24) & 0xff));
+ }
+ else
+#endif
+ {
+ putShortMSB(s, (uInt)(strm->adler >> 16));
+ putShortMSB(s, (uInt)(strm->adler & 0xffff));
+ }
+ flush_pending(strm);
+ /* If avail_out is zero, the application will call deflate again
+ * to flush the rest.
+ */
+ if (s->wrap > 0) s->wrap = -s->wrap; /* write the trailer only once! */
+ return s->pending != 0 ? Z_OK : Z_STREAM_END;
+}
+
+/* ========================================================================= */
+int ZEXPORT deflateEnd (strm)
+ z_streamp strm;
+{
+ int status;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+
+ status = strm->state->status;
+ if (status != INIT_STATE &&
+ status != EXTRA_STATE &&
+ status != NAME_STATE &&
+ status != COMMENT_STATE &&
+ status != HCRC_STATE &&
+ status != BUSY_STATE &&
+ status != FINISH_STATE) {
+ return Z_STREAM_ERROR;
+ }
+
+ /* Deallocate in reverse order of allocations: */
+ TRY_FREE(strm, strm->state->pending_buf);
+ TRY_FREE(strm, strm->state->head);
+ TRY_FREE(strm, strm->state->prev);
+ TRY_FREE(strm, strm->state->window);
+
+ ZFREE(strm, strm->state);
+ strm->state = Z_NULL;
+
+ return status == BUSY_STATE ? Z_DATA_ERROR : Z_OK;
+}
+
+/* =========================================================================
+ * Copy the source state to the destination state.
+ * To simplify the source, this is not supported for 16-bit MSDOS (which
+ * doesn't have enough memory anyway to duplicate compression states).
+ */
+int ZEXPORT deflateCopy (dest, source)
+ z_streamp dest;
+ z_streamp source;
+{
+#ifdef MAXSEG_64K
+ return Z_STREAM_ERROR;
+#else
+ deflate_state *ds;
+ deflate_state *ss;
+ ushf *overlay;
+
+
+ if (source == Z_NULL || dest == Z_NULL || source->state == Z_NULL) {
+ return Z_STREAM_ERROR;
+ }
+
+ ss = source->state;
+
+ zmemcpy(dest, source, sizeof(z_stream));
+
+ ds = (deflate_state *) ZALLOC(dest, 1, sizeof(deflate_state));
+ if (ds == Z_NULL) return Z_MEM_ERROR;
+ dest->state = (struct internal_state FAR *) ds;
+ zmemcpy(ds, ss, sizeof(deflate_state));
+ ds->strm = dest;
+
+ ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte));
+ ds->prev = (Posf *) ZALLOC(dest, ds->w_size, sizeof(Pos));
+ ds->head = (Posf *) ZALLOC(dest, ds->hash_size, sizeof(Pos));
+ overlay = (ushf *) ZALLOC(dest, ds->lit_bufsize, sizeof(ush)+2);
+ ds->pending_buf = (uchf *) overlay;
+
+ if (ds->window == Z_NULL || ds->prev == Z_NULL || ds->head == Z_NULL ||
+ ds->pending_buf == Z_NULL) {
+ deflateEnd (dest);
+ return Z_MEM_ERROR;
+ }
+ /* following zmemcpy do not work for 16-bit MSDOS */
+ zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte));
+ zmemcpy(ds->prev, ss->prev, ds->w_size * sizeof(Pos));
+ zmemcpy(ds->head, ss->head, ds->hash_size * sizeof(Pos));
+ zmemcpy(ds->pending_buf, ss->pending_buf, (uInt)ds->pending_buf_size);
+
+ ds->pending_out = ds->pending_buf + (ss->pending_out - ss->pending_buf);
+ ds->d_buf = overlay + ds->lit_bufsize/sizeof(ush);
+ ds->l_buf = ds->pending_buf + (1+sizeof(ush))*ds->lit_bufsize;
+
+ ds->l_desc.dyn_tree = ds->dyn_ltree;
+ ds->d_desc.dyn_tree = ds->dyn_dtree;
+ ds->bl_desc.dyn_tree = ds->bl_tree;
+
+ return Z_OK;
+#endif /* MAXSEG_64K */
+}
+
+/* ===========================================================================
+ * Read a new buffer from the current input stream, update the adler32
+ * and total number of bytes read. All deflate() input goes through
+ * this function so some applications may wish to modify it to avoid
+ * allocating a large strm->next_in buffer and copying from it.
+ * (See also flush_pending()).
+ */
+local int read_buf(strm, buf, size)
+ z_streamp strm;
+ Bytef *buf;
+ unsigned size;
+{
+ unsigned len = strm->avail_in;
+
+ if (len > size) len = size;
+ if (len == 0) return 0;
+
+ strm->avail_in -= len;
+
+ if (strm->state->wrap == 1) {
+ strm->adler = adler32(strm->adler, strm->next_in, len);
+ }
+#ifdef GZIP
+ else if (strm->state->wrap == 2) {
+ strm->adler = crc32(strm->adler, strm->next_in, len);
+ }
+#endif
+ zmemcpy(buf, strm->next_in, len);
+ strm->next_in += len;
+ strm->total_in += len;
+
+ return (int)len;
+}
+
+/* ===========================================================================
+ * Initialize the "longest match" routines for a new zlib stream
+ */
+local void lm_init (s)
+ deflate_state *s;
+{
+ s->window_size = (ulg)2L*s->w_size;
+
+ CLEAR_HASH(s);
+
+ /* Set the default configuration parameters:
+ */
+ s->max_lazy_match = configuration_table[s->level].max_lazy;
+ s->good_match = configuration_table[s->level].good_length;
+ s->nice_match = configuration_table[s->level].nice_length;
+ s->max_chain_length = configuration_table[s->level].max_chain;
+
+ s->strstart = 0;
+ s->block_start = 0L;
+ s->lookahead = 0;
+ s->match_length = s->prev_length = MIN_MATCH-1;
+ s->match_available = 0;
+ s->ins_h = 0;
+#ifndef FASTEST
+#ifdef ASMV
+ match_init(); /* initialize the asm code */
+#endif
+#endif
+}
+
+#ifndef FASTEST
+/* ===========================================================================
+ * Set match_start to the longest match starting at the given string and
+ * return its length. Matches shorter or equal to prev_length are discarded,
+ * in which case the result is equal to prev_length and match_start is
+ * garbage.
+ * IN assertions: cur_match is the head of the hash chain for the current
+ * string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1
+ * OUT assertion: the match length is not greater than s->lookahead.
+ */
+#ifndef ASMV
+/* For 80x86 and 680x0, an optimized version will be provided in match.asm or
+ * match.S. The code will be functionally equivalent.
+ */
+local uInt longest_match(s, cur_match)
+ deflate_state *s;
+ IPos cur_match; /* current match */
+{
+ unsigned chain_length = s->max_chain_length;/* max hash chain length */
+ register Bytef *scan = s->window + s->strstart; /* current string */
+ register Bytef *match; /* matched string */
+ register int len; /* length of current match */
+ int best_len = s->prev_length; /* best match length so far */
+ int nice_match = s->nice_match; /* stop if match long enough */
+ IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
+ s->strstart - (IPos)MAX_DIST(s) : NIL;
+ /* Stop when cur_match becomes <= limit. To simplify the code,
+ * we prevent matches with the string of window index 0.
+ */
+ Posf *prev = s->prev;
+ uInt wmask = s->w_mask;
+
+#ifdef UNALIGNED_OK
+ /* Compare two bytes at a time. Note: this is not always beneficial.
+ * Try with and without -DUNALIGNED_OK to check.
+ */
+ register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1;
+ register ush scan_start = *(ushf*)scan;
+ register ush scan_end = *(ushf*)(scan+best_len-1);
+#else
+ register Bytef *strend = s->window + s->strstart + MAX_MATCH;
+ register Byte scan_end1 = scan[best_len-1];
+ register Byte scan_end = scan[best_len];
+#endif
+
+ /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
+ * It is easy to get rid of this optimization if necessary.
+ */
+ Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever");
+
+ /* Do not waste too much time if we already have a good match: */
+ if (s->prev_length >= s->good_match) {
+ chain_length >>= 2;
+ }
+ /* Do not look for matches beyond the end of the input. This is necessary
+ * to make deflate deterministic.
+ */
+ if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;
+
+ Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead");
+
+ do {
+ Assert(cur_match < s->strstart, "no future");
+ match = s->window + cur_match;
+
+ /* Skip to next match if the match length cannot increase
+ * or if the match length is less than 2. Note that the checks below
+ * for insufficient lookahead only occur occasionally for performance
+ * reasons. Therefore uninitialized memory will be accessed, and
+ * conditional jumps will be made that depend on those values.
+ * However the length of the match is limited to the lookahead, so
+ * the output of deflate is not affected by the uninitialized values.
+ */
+#if (defined(UNALIGNED_OK) && MAX_MATCH == 258)
+ /* This code assumes sizeof(unsigned short) == 2. Do not use
+ * UNALIGNED_OK if your compiler uses a different size.
+ */
+ if (*(ushf*)(match+best_len-1) != scan_end ||
+ *(ushf*)match != scan_start) continue;
+
+ /* It is not necessary to compare scan[2] and match[2] since they are
+ * always equal when the other bytes match, given that the hash keys
+ * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at
+ * strstart+3, +5, ... up to strstart+257. We check for insufficient
+ * lookahead only every 4th comparison; the 128th check will be made
+ * at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is
+ * necessary to put more guard bytes at the end of the window, or
+ * to check more often for insufficient lookahead.
+ */
+ Assert(scan[2] == match[2], "scan[2]?");
+ scan++, match++;
+ do {
+ } while (*(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+ *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+ *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+ *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+ scan < strend);
+ /* The funny "do {}" generates better code on most compilers */
+
+ /* Here, scan <= window+strstart+257 */
+ Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");
+ if (*scan == *match) scan++;
+
+ len = (MAX_MATCH - 1) - (int)(strend-scan);
+ scan = strend - (MAX_MATCH-1);
+
+#else /* UNALIGNED_OK */
+
+ if (match[best_len] != scan_end ||
+ match[best_len-1] != scan_end1 ||
+ *match != *scan ||
+ *++match != scan[1]) continue;
+
+ /* The check at best_len-1 can be removed because it will be made
+ * again later. (This heuristic is not always a win.)
+ * It is not necessary to compare scan[2] and match[2] since they
+ * are always equal when the other bytes match, given that
+ * the hash keys are equal and that HASH_BITS >= 8.
+ */
+ scan += 2, match++;
+ Assert(*scan == *match, "match[2]?");
+
+ /* We check for insufficient lookahead only every 8th comparison;
+ * the 256th check will be made at strstart+258.
+ */
+ do {
+ } while (*++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ scan < strend);
+
+ Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");
+
+ len = MAX_MATCH - (int)(strend - scan);
+ scan = strend - MAX_MATCH;
+
+#endif /* UNALIGNED_OK */
+
+ if (len > best_len) {
+ s->match_start = cur_match;
+ best_len = len;
+ if (len >= nice_match) break;
+#ifdef UNALIGNED_OK
+ scan_end = *(ushf*)(scan+best_len-1);
+#else
+ scan_end1 = scan[best_len-1];
+ scan_end = scan[best_len];
+#endif
+ }
+ } while ((cur_match = prev[cur_match & wmask]) > limit
+ && --chain_length != 0);
+
+ if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
+ return s->lookahead;
+}
+#endif /* ASMV */
+
+#else /* FASTEST */
+
+/* ---------------------------------------------------------------------------
+ * Optimized version for FASTEST only
+ */
+local uInt longest_match(s, cur_match)
+ deflate_state *s;
+ IPos cur_match; /* current match */
+{
+ register Bytef *scan = s->window + s->strstart; /* current string */
+ register Bytef *match; /* matched string */
+ register int len; /* length of current match */
+ register Bytef *strend = s->window + s->strstart + MAX_MATCH;
+
+ /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
+ * It is easy to get rid of this optimization if necessary.
+ */
+ Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever");
+
+ Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead");
+
+ Assert(cur_match < s->strstart, "no future");
+
+ match = s->window + cur_match;
+
+ /* Return failure if the match length is less than 2:
+ */
+ if (match[0] != scan[0] || match[1] != scan[1]) return MIN_MATCH-1;
+
+ /* The check at best_len-1 can be removed because it will be made
+ * again later. (This heuristic is not always a win.)
+ * It is not necessary to compare scan[2] and match[2] since they
+ * are always equal when the other bytes match, given that
+ * the hash keys are equal and that HASH_BITS >= 8.
+ */
+ scan += 2, match += 2;
+ Assert(*scan == *match, "match[2]?");
+
+ /* We check for insufficient lookahead only every 8th comparison;
+ * the 256th check will be made at strstart+258.
+ */
+ do {
+ } while (*++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ *++scan == *++match && *++scan == *++match &&
+ scan < strend);
+
+ Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");
+
+ len = MAX_MATCH - (int)(strend - scan);
+
+ if (len < MIN_MATCH) return MIN_MATCH - 1;
+
+ s->match_start = cur_match;
+ return (uInt)len <= s->lookahead ? (uInt)len : s->lookahead;
+}
+
+#endif /* FASTEST */
+
+#ifdef DEBUG
+/* ===========================================================================
+ * Check that the match at match_start is indeed a match.
+ */
+local void check_match(s, start, match, length)
+ deflate_state *s;
+ IPos start, match;
+ int length;
+{
+ /* check that the match is indeed a match */
+ if (zmemcmp(s->window + match,
+ s->window + start, length) != EQUAL) {
+ fprintf(stderr, " start %u, match %u, length %d\n",
+ start, match, length);
+ do {
+ fprintf(stderr, "%c%c", s->window[match++], s->window[start++]);
+ } while (--length != 0);
+ z_error("invalid match");
+ }
+ if (z_verbose > 1) {
+ fprintf(stderr,"\\[%d,%d]", start-match, length);
+ do { putc(s->window[start++], stderr); } while (--length != 0);
+ }
+}
+#else
+# define check_match(s, start, match, length)
+#endif /* DEBUG */
+
+/* ===========================================================================
+ * Fill the window when the lookahead becomes insufficient.
+ * Updates strstart and lookahead.
+ *
+ * IN assertion: lookahead < MIN_LOOKAHEAD
+ * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD
+ * At least one byte has been read, or avail_in == 0; reads are
+ * performed for at least two bytes (required for the zip translate_eol
+ * option -- not supported here).
+ */
+local void fill_window(s)
+ deflate_state *s;
+{
+ register unsigned n, m;
+ register Posf *p;
+ unsigned more; /* Amount of free space at the end of the window. */
+ uInt wsize = s->w_size;
+
+ do {
+ more = (unsigned)(s->window_size -(ulg)s->lookahead -(ulg)s->strstart);
+
+ /* Deal with ! #$% 64K limit: */
+ if (sizeof(int) <= 2) {
+ if (more == 0 && s->strstart == 0 && s->lookahead == 0) {
+ more = wsize;
+
+ } else if (more == (unsigned)(-1)) {
+ /* Very unlikely, but possible on 16 bit machine if
+ * strstart == 0 && lookahead == 1 (input done a byte at time)
+ */
+ more--;
+ }
+ }
+
+ /* If the window is almost full and there is insufficient lookahead,
+ * move the upper half to the lower one to make room in the upper half.
+ */
+ if (s->strstart >= wsize+MAX_DIST(s)) {
+
+ zmemcpy(s->window, s->window+wsize, (unsigned)wsize);
+ s->match_start -= wsize;
+ s->strstart -= wsize; /* we now have strstart >= MAX_DIST */
+ s->block_start -= (long) wsize;
+
+ /* Slide the hash table (could be avoided with 32 bit values
+ at the expense of memory usage). We slide even when level == 0
+ to keep the hash table consistent if we switch back to level > 0
+ later. (Using level 0 permanently is not an optimal usage of
+ zlib, so we don't care about this pathological case.)
+ */
+ n = s->hash_size;
+ p = &s->head[n];
+ do {
+ m = *--p;
+ *p = (Pos)(m >= wsize ? m-wsize : NIL);
+ } while (--n);
+
+ n = wsize;
+#ifndef FASTEST
+ p = &s->prev[n];
+ do {
+ m = *--p;
+ *p = (Pos)(m >= wsize ? m-wsize : NIL);
+ /* If n is not on any hash chain, prev[n] is garbage but
+ * its value will never be used.
+ */
+ } while (--n);
+#endif
+ more += wsize;
+ }
+ if (s->strm->avail_in == 0) return;
+
+ /* If there was no sliding:
+ * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 &&
+ * more == window_size - lookahead - strstart
+ * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1)
+ * => more >= window_size - 2*WSIZE + 2
+ * In the BIG_MEM or MMAP case (not yet supported),
+ * window_size == input_size + MIN_LOOKAHEAD &&
+ * strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD.
+ * Otherwise, window_size == 2*WSIZE so more >= 2.
+ * If there was sliding, more >= WSIZE. So in all cases, more >= 2.
+ */
+ Assert(more >= 2, "more < 2");
+
+ n = read_buf(s->strm, s->window + s->strstart + s->lookahead, more);
+ s->lookahead += n;
+
+ /* Initialize the hash value now that we have some input: */
+ if (s->lookahead >= MIN_MATCH) {
+ s->ins_h = s->window[s->strstart];
+ UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]);
+#if MIN_MATCH != 3
+ Call UPDATE_HASH() MIN_MATCH-3 more times
+#endif
+ }
+ /* If the whole input has less than MIN_MATCH bytes, ins_h is garbage,
+ * but this is not important since only literal bytes will be emitted.
+ */
+
+ } while (s->lookahead < MIN_LOOKAHEAD && s->strm->avail_in != 0);
+
+ /* If the WIN_INIT bytes after the end of the current data have never been
+ * written, then zero those bytes in order to avoid memory check reports of
+ * the use of uninitialized (or uninitialised as Julian writes) bytes by
+ * the longest match routines. Update the high water mark for the next
+ * time through here. WIN_INIT is set to MAX_MATCH since the longest match
+ * routines allow scanning to strstart + MAX_MATCH, ignoring lookahead.
+ */
+ if (s->high_water < s->window_size) {
+ ulg curr = s->strstart + (ulg)(s->lookahead);
+ ulg init;
+
+ if (s->high_water < curr) {
+ /* Previous high water mark below current data -- zero WIN_INIT
+ * bytes or up to end of window, whichever is less.
+ */
+ init = s->window_size - curr;
+ if (init > WIN_INIT)
+ init = WIN_INIT;
+ zmemzero(s->window + curr, (unsigned)init);
+ s->high_water = curr + init;
+ }
+ else if (s->high_water < (ulg)curr + WIN_INIT) {
+ /* High water mark at or above current data, but below current data
+ * plus WIN_INIT -- zero out to current data plus WIN_INIT, or up
+ * to end of window, whichever is less.
+ */
+ init = (ulg)curr + WIN_INIT - s->high_water;
+ if (init > s->window_size - s->high_water)
+ init = s->window_size - s->high_water;
+ zmemzero(s->window + s->high_water, (unsigned)init);
+ s->high_water += init;
+ }
+ }
+}
+
+/* ===========================================================================
+ * Flush the current block, with given end-of-file flag.
+ * IN assertion: strstart is set to the end of the current match.
+ */
+#define FLUSH_BLOCK_ONLY(s, last) { \
+ _tr_flush_block(s, (s->block_start >= 0L ? \
+ (charf *)&s->window[(unsigned)s->block_start] : \
+ (charf *)Z_NULL), \
+ (ulg)((long)s->strstart - s->block_start), \
+ (last)); \
+ s->block_start = s->strstart; \
+ flush_pending(s->strm); \
+ Tracev((stderr,"[FLUSH]")); \
+}
+
+/* Same but force premature exit if necessary. */
+#define FLUSH_BLOCK(s, last) { \
+ FLUSH_BLOCK_ONLY(s, last); \
+ if (s->strm->avail_out == 0) return (last) ? finish_started : need_more; \
+}
+
+/* ===========================================================================
+ * Copy without compression as much as possible from the input stream, return
+ * the current block state.
+ * This function does not insert new strings in the dictionary since
+ * uncompressible data is probably not useful. This function is used
+ * only for the level=0 compression option.
+ * NOTE: this function should be optimized to avoid extra copying from
+ * window to pending_buf.
+ */
+local block_state deflate_stored(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ /* Stored blocks are limited to 0xffff bytes, pending_buf is limited
+ * to pending_buf_size, and each stored block has a 5 byte header:
+ */
+ ulg max_block_size = 0xffff;
+ ulg max_start;
+
+ if (max_block_size > s->pending_buf_size - 5) {
+ max_block_size = s->pending_buf_size - 5;
+ }
+
+ /* Copy as much as possible from input to output: */
+ for (;;) {
+ /* Fill the window as much as possible: */
+ if (s->lookahead <= 1) {
+
+ Assert(s->strstart < s->w_size+MAX_DIST(s) ||
+ s->block_start >= (long)s->w_size, "slide too late");
+
+ fill_window(s);
+ if (s->lookahead == 0 && flush == Z_NO_FLUSH) return need_more;
+
+ if (s->lookahead == 0) break; /* flush the current block */
+ }
+ Assert(s->block_start >= 0L, "block gone");
+
+ s->strstart += s->lookahead;
+ s->lookahead = 0;
+
+ /* Emit a stored block if pending_buf will be full: */
+ max_start = s->block_start + max_block_size;
+ if (s->strstart == 0 || (ulg)s->strstart >= max_start) {
+ /* strstart == 0 is possible when wraparound on 16-bit machine */
+ s->lookahead = (uInt)(s->strstart - max_start);
+ s->strstart = (uInt)max_start;
+ FLUSH_BLOCK(s, 0);
+ }
+ /* Flush if we may have to slide, otherwise block_start may become
+ * negative and the data will be gone:
+ */
+ if (s->strstart - (uInt)s->block_start >= MAX_DIST(s)) {
+ FLUSH_BLOCK(s, 0);
+ }
+ }
+ FLUSH_BLOCK(s, flush == Z_FINISH);
+ return flush == Z_FINISH ? finish_done : block_done;
+}
+
+/* ===========================================================================
+ * Compress as much as possible from the input stream, return the current
+ * block state.
+ * This function does not perform lazy evaluation of matches and inserts
+ * new strings in the dictionary only for unmatched strings or for short
+ * matches. It is used only for the fast compression options.
+ */
+local block_state deflate_fast(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ IPos hash_head; /* head of the hash chain */
+ int bflush; /* set if current block must be flushed */
+
+ for (;;) {
+ /* Make sure that we always have enough lookahead, except
+ * at the end of the input file. We need MAX_MATCH bytes
+ * for the next match, plus MIN_MATCH bytes to insert the
+ * string following the next match.
+ */
+ if (s->lookahead < MIN_LOOKAHEAD) {
+ fill_window(s);
+ if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) {
+ return need_more;
+ }
+ if (s->lookahead == 0) break; /* flush the current block */
+ }
+
+ /* Insert the string window[strstart .. strstart+2] in the
+ * dictionary, and set hash_head to the head of the hash chain:
+ */
+ hash_head = NIL;
+ if (s->lookahead >= MIN_MATCH) {
+ INSERT_STRING(s, s->strstart, hash_head);
+ }
+
+ /* Find the longest match, discarding those <= prev_length.
+ * At this point we have always match_length < MIN_MATCH
+ */
+ if (hash_head != NIL && s->strstart - hash_head <= MAX_DIST(s)) {
+ /* To simplify the code, we prevent matches with the string
+ * of window index 0 (in particular we have to avoid a match
+ * of the string with itself at the start of the input file).
+ */
+ s->match_length = longest_match (s, hash_head);
+ /* longest_match() sets match_start */
+ }
+ if (s->match_length >= MIN_MATCH) {
+ check_match(s, s->strstart, s->match_start, s->match_length);
+
+ _tr_tally_dist(s, s->strstart - s->match_start,
+ s->match_length - MIN_MATCH, bflush);
+
+ s->lookahead -= s->match_length;
+
+ /* Insert new strings in the hash table only if the match length
+ * is not too large. This saves time but degrades compression.
+ */
+#ifndef FASTEST
+ if (s->match_length <= s->max_insert_length &&
+ s->lookahead >= MIN_MATCH) {
+ s->match_length--; /* string at strstart already in table */
+ do {
+ s->strstart++;
+ INSERT_STRING(s, s->strstart, hash_head);
+ /* strstart never exceeds WSIZE-MAX_MATCH, so there are
+ * always MIN_MATCH bytes ahead.
+ */
+ } while (--s->match_length != 0);
+ s->strstart++;
+ } else
+#endif
+ {
+ s->strstart += s->match_length;
+ s->match_length = 0;
+ s->ins_h = s->window[s->strstart];
+ UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]);
+#if MIN_MATCH != 3
+ Call UPDATE_HASH() MIN_MATCH-3 more times
+#endif
+ /* If lookahead < MIN_MATCH, ins_h is garbage, but it does not
+ * matter since it will be recomputed at next deflate call.
+ */
+ }
+ } else {
+ /* No match, output a literal byte */
+ Tracevv((stderr,"%c", s->window[s->strstart]));
+ _tr_tally_lit (s, s->window[s->strstart], bflush);
+ s->lookahead--;
+ s->strstart++;
+ }
+ if (bflush) FLUSH_BLOCK(s, 0);
+ }
+ FLUSH_BLOCK(s, flush == Z_FINISH);
+ return flush == Z_FINISH ? finish_done : block_done;
+}
+
+#ifndef FASTEST
+/* ===========================================================================
+ * Same as above, but achieves better compression. We use a lazy
+ * evaluation for matches: a match is finally adopted only if there is
+ * no better match at the next window position.
+ */
+local block_state deflate_slow(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ IPos hash_head; /* head of hash chain */
+ int bflush; /* set if current block must be flushed */
+
+ /* Process the input block. */
+ for (;;) {
+ /* Make sure that we always have enough lookahead, except
+ * at the end of the input file. We need MAX_MATCH bytes
+ * for the next match, plus MIN_MATCH bytes to insert the
+ * string following the next match.
+ */
+ if (s->lookahead < MIN_LOOKAHEAD) {
+ fill_window(s);
+ if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) {
+ return need_more;
+ }
+ if (s->lookahead == 0) break; /* flush the current block */
+ }
+
+ /* Insert the string window[strstart .. strstart+2] in the
+ * dictionary, and set hash_head to the head of the hash chain:
+ */
+ hash_head = NIL;
+ if (s->lookahead >= MIN_MATCH) {
+ INSERT_STRING(s, s->strstart, hash_head);
+ }
+
+ /* Find the longest match, discarding those <= prev_length.
+ */
+ s->prev_length = s->match_length, s->prev_match = s->match_start;
+ s->match_length = MIN_MATCH-1;
+
+ if (hash_head != NIL && s->prev_length < s->max_lazy_match &&
+ s->strstart - hash_head <= MAX_DIST(s)) {
+ /* To simplify the code, we prevent matches with the string
+ * of window index 0 (in particular we have to avoid a match
+ * of the string with itself at the start of the input file).
+ */
+ s->match_length = longest_match (s, hash_head);
+ /* longest_match() sets match_start */
+
+ if (s->match_length <= 5 && (s->strategy == Z_FILTERED
+#if TOO_FAR <= 32767
+ || (s->match_length == MIN_MATCH &&
+ s->strstart - s->match_start > TOO_FAR)
+#endif
+ )) {
+
+ /* If prev_match is also MIN_MATCH, match_start is garbage
+ * but we will ignore the current match anyway.
+ */
+ s->match_length = MIN_MATCH-1;
+ }
+ }
+ /* If there was a match at the previous step and the current
+ * match is not better, output the previous match:
+ */
+ if (s->prev_length >= MIN_MATCH && s->match_length <= s->prev_length) {
+ uInt max_insert = s->strstart + s->lookahead - MIN_MATCH;
+ /* Do not insert strings in hash table beyond this. */
+
+ check_match(s, s->strstart-1, s->prev_match, s->prev_length);
+
+ _tr_tally_dist(s, s->strstart -1 - s->prev_match,
+ s->prev_length - MIN_MATCH, bflush);
+
+ /* Insert in hash table all strings up to the end of the match.
+ * strstart-1 and strstart are already inserted. If there is not
+ * enough lookahead, the last two strings are not inserted in
+ * the hash table.
+ */
+ s->lookahead -= s->prev_length-1;
+ s->prev_length -= 2;
+ do {
+ if (++s->strstart <= max_insert) {
+ INSERT_STRING(s, s->strstart, hash_head);
+ }
+ } while (--s->prev_length != 0);
+ s->match_available = 0;
+ s->match_length = MIN_MATCH-1;
+ s->strstart++;
+
+ if (bflush) FLUSH_BLOCK(s, 0);
+
+ } else if (s->match_available) {
+ /* If there was no match at the previous position, output a
+ * single literal. If there was a match but the current match
+ * is longer, truncate the previous match to a single literal.
+ */
+ Tracevv((stderr,"%c", s->window[s->strstart-1]));
+ _tr_tally_lit(s, s->window[s->strstart-1], bflush);
+ if (bflush) {
+ FLUSH_BLOCK_ONLY(s, 0);
+ }
+ s->strstart++;
+ s->lookahead--;
+ if (s->strm->avail_out == 0) return need_more;
+ } else {
+ /* There is no previous match to compare with, wait for
+ * the next step to decide.
+ */
+ s->match_available = 1;
+ s->strstart++;
+ s->lookahead--;
+ }
+ }
+ Assert (flush != Z_NO_FLUSH, "no flush?");
+ if (s->match_available) {
+ Tracevv((stderr,"%c", s->window[s->strstart-1]));
+ _tr_tally_lit(s, s->window[s->strstart-1], bflush);
+ s->match_available = 0;
+ }
+ FLUSH_BLOCK(s, flush == Z_FINISH);
+ return flush == Z_FINISH ? finish_done : block_done;
+}
+#endif /* FASTEST */
+
+/* ===========================================================================
+ * For Z_RLE, simply look for runs of bytes, generate matches only of distance
+ * one. Do not maintain a hash table. (It will be regenerated if this run of
+ * deflate switches away from Z_RLE.)
+ */
+local block_state deflate_rle(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ int bflush; /* set if current block must be flushed */
+ uInt prev; /* byte at distance one to match */
+ Bytef *scan, *strend; /* scan goes up to strend for length of run */
+
+ for (;;) {
+ /* Make sure that we always have enough lookahead, except
+ * at the end of the input file. We need MAX_MATCH bytes
+ * for the longest encodable run.
+ */
+ if (s->lookahead < MAX_MATCH) {
+ fill_window(s);
+ if (s->lookahead < MAX_MATCH && flush == Z_NO_FLUSH) {
+ return need_more;
+ }
+ if (s->lookahead == 0) break; /* flush the current block */
+ }
+
+ /* See how many times the previous byte repeats */
+ s->match_length = 0;
+ if (s->lookahead >= MIN_MATCH && s->strstart > 0) {
+ scan = s->window + s->strstart - 1;
+ prev = *scan;
+ if (prev == *++scan && prev == *++scan && prev == *++scan) {
+ strend = s->window + s->strstart + MAX_MATCH;
+ do {
+ } while (prev == *++scan && prev == *++scan &&
+ prev == *++scan && prev == *++scan &&
+ prev == *++scan && prev == *++scan &&
+ prev == *++scan && prev == *++scan &&
+ scan < strend);
+ s->match_length = MAX_MATCH - (int)(strend - scan);
+ if (s->match_length > s->lookahead)
+ s->match_length = s->lookahead;
+ }
+ }
+
+ /* Emit match if have run of MIN_MATCH or longer, else emit literal */
+ if (s->match_length >= MIN_MATCH) {
+ check_match(s, s->strstart, s->strstart - 1, s->match_length);
+
+ _tr_tally_dist(s, 1, s->match_length - MIN_MATCH, bflush);
+
+ s->lookahead -= s->match_length;
+ s->strstart += s->match_length;
+ s->match_length = 0;
+ } else {
+ /* No match, output a literal byte */
+ Tracevv((stderr,"%c", s->window[s->strstart]));
+ _tr_tally_lit (s, s->window[s->strstart], bflush);
+ s->lookahead--;
+ s->strstart++;
+ }
+ if (bflush) FLUSH_BLOCK(s, 0);
+ }
+ FLUSH_BLOCK(s, flush == Z_FINISH);
+ return flush == Z_FINISH ? finish_done : block_done;
+}
+
+/* ===========================================================================
+ * For Z_HUFFMAN_ONLY, do not look for matches. Do not maintain a hash table.
+ * (It will be regenerated if this run of deflate switches away from Huffman.)
+ */
+local block_state deflate_huff(s, flush)
+ deflate_state *s;
+ int flush;
+{
+ int bflush; /* set if current block must be flushed */
+
+ for (;;) {
+ /* Make sure that we have a literal to write. */
+ if (s->lookahead == 0) {
+ fill_window(s);
+ if (s->lookahead == 0) {
+ if (flush == Z_NO_FLUSH)
+ return need_more;
+ break; /* flush the current block */
+ }
+ }
+
+ /* Output a literal byte */
+ s->match_length = 0;
+ Tracevv((stderr,"%c", s->window[s->strstart]));
+ _tr_tally_lit (s, s->window[s->strstart], bflush);
+ s->lookahead--;
+ s->strstart++;
+ if (bflush) FLUSH_BLOCK(s, 0);
+ }
+ FLUSH_BLOCK(s, flush == Z_FINISH);
+ return flush == Z_FINISH ? finish_done : block_done;
+}
diff --git a/src/plugins/cfitsio/deflate.h b/src/plugins/cfitsio/deflate.h
new file mode 100644
index 0000000..6ac0a1e
--- /dev/null
+++ b/src/plugins/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 */
diff --git a/src/plugins/cfitsio/drvrfile.c b/src/plugins/cfitsio/drvrfile.c
new file mode 100644
index 0000000..7cfa9c1
--- /dev/null
+++ b/src/plugins/cfitsio/drvrfile.c
@@ -0,0 +1,900 @@
+/* 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];
+
+ *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);
+}
+
+
+
+
diff --git a/src/plugins/cfitsio/drvrgsiftp.c b/src/plugins/cfitsio/drvrgsiftp.c
new file mode 100644
index 0000000..ab9aaed
--- /dev/null
+++ b/src/plugins/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,
+ ¶llelism);
+ }
+
+ 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,
+ ¶llelism);
+ }
+
+ 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
diff --git a/src/plugins/cfitsio/drvrgsiftp.h b/src/plugins/cfitsio/drvrgsiftp.h
new file mode 100644
index 0000000..bd0ec0d
--- /dev/null
+++ b/src/plugins/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
diff --git a/src/plugins/cfitsio/drvrmem.c b/src/plugins/cfitsio/drvrmem.c
new file mode 100644
index 0000000..4ef23b7
--- /dev/null
+++ b/src/plugins/cfitsio/drvrmem.c
@@ -0,0 +1,1184 @@
+/* This file, drvrmem.c, contains driver routines for memory 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 <stddef.h> /* apparently needed to define size_t */
+#include "fitsio2.h"
+
+/* prototype for .Z file uncompression function in zuncompress.c */
+int zuncompress2mem(char *filename,
+ FILE *diskfile,
+ char **buffptr,
+ size_t *buffsize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ size_t *filesize,
+ int *status);
+
+#define RECBUFLEN 1000
+
+static char stdin_outfile[FLEN_FILENAME];
+
+typedef struct /* structure containing mem file structure */
+{
+ char **memaddrptr; /* Pointer to memory address pointer; */
+ /* This may or may not point to memaddr. */
+ char *memaddr; /* Pointer to starting memory address; may */
+ /* not always be used, so use *memaddrptr instead */
+ size_t *memsizeptr; /* Pointer to the size of the memory allocation. */
+ /* This may or may not point to memsize. */
+ size_t memsize; /* Size of the memory allocation; this may not */
+ /* always be used, so use *memsizeptr instead. */
+ size_t deltasize; /* Suggested increment for reallocating memory */
+ void *(*mem_realloc)(void *p, size_t newsize); /* realloc function */
+ LONGLONG currentpos; /* current file position, relative to start */
+ LONGLONG fitsfilesize; /* size of the FITS file (always <= *memsizeptr) */
+ FILE *fileptr; /* pointer to compressed output disk file */
+} memdriver;
+
+static memdriver memTable[NMAXFILES]; /* allocate mem file handle tables */
+
+/*--------------------------------------------------------------------------*/
+int mem_init(void)
+{
+ int ii;
+
+ for (ii = 0; ii < NMAXFILES; ii++) /* initialize all empty slots in table */
+ {
+ memTable[ii].memaddrptr = 0;
+ memTable[ii].memaddr = 0;
+ }
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_setoptions(int options)
+{
+ /* do something with the options argument, to stop compiler warning */
+ options = 0;
+ return(options);
+}
+/*--------------------------------------------------------------------------*/
+int mem_getoptions(int *options)
+{
+ *options = 0;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_getversion(int *version)
+{
+ *version = 10;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_shutdown(void)
+{
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_create(char *filename, int *handle)
+/*
+ Create a new empty memory file for subsequent writes.
+ The file name is ignored in this case.
+*/
+{
+ int status;
+
+ /* initially allocate 1 FITS block = 2880 bytes */
+ status = mem_createmem(2880L, handle);
+
+ if (status)
+ {
+ ffpmsg("failed to create empty memory file (mem_create)");
+ return(status);
+ }
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_create_comp(char *filename, int *handle)
+/*
+ Create a new empty memory file for subsequent writes.
+ Also create an empty compressed .gz file. The memory file
+ will be compressed and written to the disk file when the file is closed.
+*/
+{
+ FILE *diskfile;
+ char mode[4];
+ int status;
+
+ /* first, create disk file for the compressed output */
+
+
+ if ( !strcmp(filename, "-.gz") || !strcmp(filename, "stdout.gz") ||
+ !strcmp(filename, "STDOUT.gz") )
+ {
+ /* special case: create uncompressed FITS file in memory, then
+ compress it an write it out to 'stdout' when it is closed. */
+
+ diskfile = stdout;
+ }
+ else
+ {
+ /* normal case: create disk file for the compressed output */
+
+ strcpy(mode, "w+b"); /* create 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);
+ }
+ }
+
+ /* now create temporary memory file */
+
+ /* initially allocate 1 FITS block = 2880 bytes */
+ status = mem_createmem(2880L, handle);
+
+ if (status)
+ {
+ ffpmsg("failed to create empty memory file (mem_create_comp)");
+ return(status);
+ }
+
+ memTable[*handle].fileptr = diskfile;
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_openmem(void **buffptr, /* I - address of memory pointer */
+ size_t *buffsize, /* I - size of buffer, in bytes */
+ size_t deltasize, /* I - increment for future realloc's */
+ void *(*memrealloc)(void *p, size_t newsize), /* function */
+ int *handle)
+/*
+ lowest level routine to open a pre-existing memory file.
+*/
+{
+ int ii;
+
+ *handle = -1;
+ for (ii = 0; ii < NMAXFILES; ii++) /* find empty slot in handle table */
+ {
+ if (memTable[ii].memaddrptr == 0)
+ {
+ *handle = ii;
+ break;
+ }
+ }
+ if (*handle == -1)
+ return(TOO_MANY_FILES); /* too many files opened */
+
+ memTable[ii].memaddrptr = (char **) buffptr; /* pointer to start addres */
+ memTable[ii].memsizeptr = buffsize; /* allocated size of memory */
+ memTable[ii].deltasize = deltasize; /* suggested realloc increment */
+ memTable[ii].fitsfilesize = *buffsize; /* size of FITS file (upper limit) */
+ memTable[ii].currentpos = 0; /* at beginning of the file */
+ memTable[ii].mem_realloc = memrealloc; /* memory realloc function */
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_createmem(size_t msize, int *handle)
+/*
+ lowest level routine to allocate a memory file.
+*/
+{
+ int ii;
+
+ *handle = -1;
+ for (ii = 0; ii < NMAXFILES; ii++) /* find empty slot in handle table */
+ {
+ if (memTable[ii].memaddrptr == 0)
+ {
+ *handle = ii;
+ break;
+ }
+ }
+ if (*handle == -1)
+ return(TOO_MANY_FILES); /* too many files opened */
+
+ /* use the internally allocated memaddr and memsize variables */
+ memTable[ii].memaddrptr = &memTable[ii].memaddr;
+ memTable[ii].memsizeptr = &memTable[ii].memsize;
+
+ /* allocate initial block of memory for the file */
+ if (msize > 0)
+ {
+ memTable[ii].memaddr = (char *) malloc(msize);
+ if ( !(memTable[ii].memaddr) )
+ {
+ ffpmsg("malloc of initial memory failed (mem_createmem)");
+ return(FILE_NOT_OPENED);
+ }
+ }
+
+ /* set initial state of the file */
+ memTable[ii].memsize = msize;
+ memTable[ii].deltasize = 2880;
+ memTable[ii].fitsfilesize = 0;
+ memTable[ii].currentpos = 0;
+ memTable[ii].mem_realloc = realloc;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_truncate(int handle, LONGLONG filesize)
+/*
+ truncate the file to a new size
+*/
+{
+ char *ptr;
+
+ /* call the memory reallocation function, if defined */
+ if ( memTable[handle].mem_realloc )
+ { /* explicit LONGLONG->size_t cast */
+ ptr = (memTable[handle].mem_realloc)(
+ *(memTable[handle].memaddrptr),
+ (size_t) filesize);
+ if (!ptr)
+ {
+ ffpmsg("Failed to reallocate memory (mem_truncate)");
+ return(MEMORY_ALLOCATION);
+ }
+
+ /* if allocated more memory, initialize it to zero */
+ if ( filesize > *(memTable[handle].memsizeptr) )
+ {
+ memset(ptr + *(memTable[handle].memsizeptr),
+ 0,
+ ((size_t) filesize) - *(memTable[handle].memsizeptr) );
+ }
+
+ *(memTable[handle].memaddrptr) = ptr;
+ *(memTable[handle].memsizeptr) = (size_t) (filesize);
+ }
+
+ memTable[handle].currentpos = filesize;
+ memTable[handle].fitsfilesize = filesize;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int stdin_checkfile(char *urltype, char *infile, char *outfile)
+/*
+ do any special case checking when opening a file on the stdin stream
+*/
+{
+ if (strlen(outfile))
+ {
+ stdin_outfile[0] = '\0';
+ strncat(stdin_outfile,outfile,FLEN_FILENAME-1); /* an output file is specified */
+ strcpy(urltype,"stdinfile://");
+ }
+ else
+ *stdin_outfile = '\0'; /* no output file was specified */
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int stdin_open(char *filename, int rwmode, int *handle)
+/*
+ open a FITS file from the stdin file stream by copying it into memory
+ The file name is ignored in this case.
+*/
+{
+ int status;
+ char cbuff;
+
+ if (*stdin_outfile)
+ {
+ /* copy the stdin stream to the specified disk file then open the file */
+
+ /* Create the output file */
+ status = file_create(stdin_outfile,handle);
+
+ if (status)
+ {
+ ffpmsg("Unable to create output file to copy stdin (stdin_open):");
+ ffpmsg(stdin_outfile);
+ return(status);
+ }
+
+ /* copy the whole stdin stream to the file */
+ status = stdin2file(*handle);
+ file_close(*handle);
+
+ if (status)
+ {
+ ffpmsg("failed to copy stdin to file (stdin_open)");
+ ffpmsg(stdin_outfile);
+ return(status);
+ }
+
+ /* reopen file with proper rwmode attribute */
+ status = file_open(stdin_outfile, rwmode, handle);
+ }
+ else
+ {
+
+ /* get the first character, then put it back */
+ cbuff = fgetc(stdin);
+ ungetc(cbuff, stdin);
+
+ /* compressed files begin with 037 or 'P' */
+ if (cbuff == 31 || cbuff == 75)
+ {
+ /* looks like the input stream is compressed */
+ status = mem_compress_stdin_open(filename, rwmode, handle);
+
+ }
+ else
+ {
+ /* copy the stdin stream into memory then open file in memory */
+
+ if (rwmode != READONLY)
+ {
+ ffpmsg("cannot open stdin with WRITE access");
+ return(READONLY_FILE);
+ }
+
+ status = mem_createmem(2880L, handle);
+
+ if (status)
+ {
+ ffpmsg("failed to create empty memory file (stdin_open)");
+ return(status);
+ }
+
+ /* copy the whole stdin stream into memory */
+ status = stdin2mem(*handle);
+
+ if (status)
+ {
+ ffpmsg("failed to copy stdin into memory (stdin_open)");
+ free(memTable[*handle].memaddr);
+ }
+ }
+ }
+
+ return(status);
+}
+/*--------------------------------------------------------------------------*/
+int stdin2mem(int hd) /* handle number */
+/*
+ Copy the stdin stream into memory. Fill whatever amount of memory
+ has already been allocated, then realloc more memory if necessary.
+*/
+{
+ size_t nread, memsize, delta;
+ LONGLONG filesize;
+ char *memptr;
+ char simple[] = "SIMPLE";
+ int c, ii, jj;
+
+ memptr = *memTable[hd].memaddrptr;
+ memsize = *memTable[hd].memsizeptr;
+ delta = memTable[hd].deltasize;
+
+ filesize = 0;
+ ii = 0;
+
+ for(jj = 0; (c = fgetc(stdin)) != EOF && jj < 2000; jj++)
+ {
+ /* Skip over any garbage at the beginning of the stdin stream by */
+ /* reading 1 char at a time, looking for 'S', 'I', 'M', 'P', 'L', 'E' */
+ /* Give up if not found in the first 2000 characters */
+
+ if (c == simple[ii])
+ {
+ ii++;
+ if (ii == 6) /* found the complete string? */
+ {
+ memcpy(memptr, simple, 6); /* copy "SIMPLE" to buffer */
+ filesize = 6;
+ break;
+ }
+ }
+ else
+ ii = 0; /* reset search to beginning of the string */
+ }
+
+ if (filesize == 0)
+ {
+ ffpmsg("Couldn't find the string 'SIMPLE' in the stdin stream.");
+ ffpmsg("This does not look like a FITS file.");
+ return(FILE_NOT_OPENED);
+ }
+
+ /* fill up the remainder of the initial memory allocation */
+ nread = fread(memptr + 6, 1, memsize - 6, stdin);
+ nread += 6; /* add in the 6 characters in 'SIMPLE' */
+
+ if (nread < memsize) /* reached the end? */
+ {
+ memTable[hd].fitsfilesize = nread;
+ return(0);
+ }
+
+ filesize = nread;
+
+ while (1)
+ {
+ /* allocate memory for another FITS block */
+ memptr = realloc(memptr, memsize + delta);
+
+ if (!memptr)
+ {
+ ffpmsg("realloc failed while copying stdin (stdin2mem)");
+ return(MEMORY_ALLOCATION);
+ }
+ memsize += delta;
+
+ /* read another FITS block */
+ nread = fread(memptr + filesize, 1, delta, stdin);
+
+ filesize += nread;
+
+ if (nread < delta) /* reached the end? */
+ break;
+ }
+
+ memTable[hd].fitsfilesize = filesize;
+ *memTable[hd].memaddrptr = memptr;
+ *memTable[hd].memsizeptr = memsize;
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int stdin2file(int handle) /* handle number */
+/*
+ Copy the stdin stream to a file. .
+*/
+{
+ size_t nread;
+ char simple[] = "SIMPLE";
+ int c, ii, jj, status;
+ char recbuf[RECBUFLEN];
+
+ ii = 0;
+ for(jj = 0; (c = fgetc(stdin)) != EOF && jj < 2000; jj++)
+ {
+ /* Skip over any garbage at the beginning of the stdin stream by */
+ /* reading 1 char at a time, looking for 'S', 'I', 'M', 'P', 'L', 'E' */
+ /* Give up if not found in the first 2000 characters */
+
+ if (c == simple[ii])
+ {
+ ii++;
+ if (ii == 6) /* found the complete string? */
+ {
+ memcpy(recbuf, simple, 6); /* copy "SIMPLE" to buffer */
+ break;
+ }
+ }
+ else
+ ii = 0; /* reset search to beginning of the string */
+ }
+
+ if (ii != 6)
+ {
+ ffpmsg("Couldn't find the string 'SIMPLE' in the stdin stream");
+ return(FILE_NOT_OPENED);
+ }
+
+ /* fill up the remainder of the buffer */
+ nread = fread(recbuf + 6, 1, RECBUFLEN - 6, stdin);
+ nread += 6; /* add in the 6 characters in 'SIMPLE' */
+
+ status = file_write(handle, recbuf, nread);
+ if (status)
+ return(status);
+
+ /* copy the rest of stdin stream */
+ while(0 != (nread = fread(recbuf,1,RECBUFLEN, stdin)))
+ {
+ status = file_write(handle, recbuf, nread);
+ if (status)
+ return(status);
+ }
+
+ return(status);
+}
+/*--------------------------------------------------------------------------*/
+int stdout_close(int handle)
+/*
+ copy the memory file to stdout, then free the memory
+*/
+{
+ int status = 0;
+
+ /* copy from memory to standard out. explicit LONGLONG->size_t cast */
+ if(fwrite(memTable[handle].memaddr, 1,
+ ((size_t) memTable[handle].fitsfilesize), stdout) !=
+ (size_t) memTable[handle].fitsfilesize )
+ {
+ ffpmsg("failed to copy memory file to stdout (stdout_close)");
+ status = WRITE_ERROR;
+ }
+
+ free( memTable[handle].memaddr ); /* free the memory */
+ memTable[handle].memaddrptr = 0;
+ memTable[handle].memaddr = 0;
+ return(status);
+}
+/*--------------------------------------------------------------------------*/
+int mem_compress_openrw(char *filename, int rwmode, int *hdl)
+/*
+ This routine opens the compressed diskfile and creates an empty memory
+ buffer with an appropriate size, then calls mem_uncompress2mem. It allows
+ the memory 'file' to be opened with READWRITE access.
+*/
+{
+ return(mem_compress_open(filename, READONLY, hdl));
+}
+/*--------------------------------------------------------------------------*/
+int mem_compress_open(char *filename, int rwmode, int *hdl)
+/*
+ This routine opens the compressed diskfile and creates an empty memory
+ buffer with an appropriate size, then calls mem_uncompress2mem.
+*/
+{
+ FILE *diskfile;
+ int status, estimated = 1;
+ unsigned char buffer[4];
+ size_t finalsize;
+ char *ptr;
+
+ if (rwmode != READONLY)
+ {
+ ffpmsg(
+ "cannot open compressed file with WRITE access (mem_compress_open)");
+ ffpmsg(filename);
+ return(READONLY_FILE);
+ }
+
+ /* open the compressed disk file */
+ status = file_openfile(filename, READONLY, &diskfile);
+ if (status)
+ {
+ ffpmsg("failed to open compressed disk file (compress_open)");
+ ffpmsg(filename);
+ return(status);
+ }
+
+ if (fread(buffer, 1, 2, diskfile) != 2) /* read 2 bytes */
+ {
+ fclose(diskfile);
+ return(READ_ERROR);
+ }
+
+ if (memcmp(buffer, "\037\213", 2) == 0) /* GZIP */
+ {
+ /* the uncompressed file size is give at the end of the file */
+
+ fseek(diskfile, 0, 2); /* move to end of file */
+ fseek(diskfile, -4L, 1); /* move back 4 bytes */
+ fread(buffer, 1, 4L, diskfile); /* read 4 bytes */
+
+ /* have to worry about integer byte order */
+ finalsize = buffer[0];
+ finalsize |= buffer[1] << 8;
+ finalsize |= buffer[2] << 16;
+ finalsize |= buffer[3] << 24;
+
+ estimated = 0; /* file size is known, not estimated */
+ }
+ else if (memcmp(buffer, "\120\113", 2) == 0) /* PKZIP */
+ {
+ /* the uncompressed file size is give at byte 22 the file */
+
+ fseek(diskfile, 22L, 0); /* move to byte 22 */
+ fread(buffer, 1, 4L, diskfile); /* read 4 bytes */
+
+ /* have to worry about integer byte order */
+ finalsize = buffer[0];
+ finalsize |= buffer[1] << 8;
+ finalsize |= buffer[2] << 16;
+ finalsize |= buffer[3] << 24;
+
+ estimated = 0; /* file size is known, not estimated */
+ }
+ else if (memcmp(buffer, "\037\036", 2) == 0) /* PACK */
+ finalsize = 0; /* for most methods we can't determine final size */
+ else if (memcmp(buffer, "\037\235", 2) == 0) /* LZW */
+ finalsize = 0; /* for most methods we can't determine final size */
+ else if (memcmp(buffer, "\037\240", 2) == 0) /* LZH */
+ finalsize = 0; /* for most methods we can't determine final size */
+ else
+ {
+ /* not a compressed file; this should never happen */
+ fclose(diskfile);
+ return(1);
+ }
+
+ if (finalsize == 0) /* estimate uncompressed file size */
+ {
+ fseek(diskfile, 0, 2); /* move to end of the compressed file */
+ finalsize = ftell(diskfile); /* position = size of file */
+ finalsize = finalsize * 3; /* assume factor of 3 compression */
+ }
+
+ fseek(diskfile, 0, 0); /* move back to beginning of file */
+
+ /* create a memory file big enough (hopefully) for the uncompressed file */
+ status = mem_createmem(finalsize, hdl);
+
+ if (status && estimated)
+ {
+ /* memory allocation failed, so try a smaller estimated size */
+ finalsize = finalsize / 3;
+ status = mem_createmem(finalsize, hdl);
+ }
+
+ if (status)
+ {
+ fclose(diskfile);
+ ffpmsg("failed to create empty memory file (compress_open)");
+ return(status);
+ }
+
+ /* uncompress file into memory */
+ status = mem_uncompress2mem(filename, diskfile, *hdl);
+
+ fclose(diskfile);
+
+ if (status)
+ {
+ mem_close_free(*hdl); /* free up the memory */
+ ffpmsg("failed to uncompress file into memory (compress_open)");
+ return(status);
+ }
+
+ /* if we allocated too much memory initially, then free it */
+ if (*(memTable[*hdl].memsizeptr) >
+ (( (size_t) memTable[*hdl].fitsfilesize) + 256L) )
+ {
+ ptr = realloc(*(memTable[*hdl].memaddrptr),
+ ((size_t) memTable[*hdl].fitsfilesize) );
+ if (!ptr)
+ {
+ ffpmsg("Failed to reduce size of allocated memory (compress_open)");
+ return(MEMORY_ALLOCATION);
+ }
+
+ *(memTable[*hdl].memaddrptr) = ptr;
+ *(memTable[*hdl].memsizeptr) = (size_t) (memTable[*hdl].fitsfilesize);
+ }
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_compress_stdin_open(char *filename, int rwmode, int *hdl)
+/*
+ This routine reads the compressed input stream and creates an empty memory
+ buffer, then calls mem_uncompress2mem.
+*/
+{
+ int status;
+ char *ptr;
+
+ if (rwmode != READONLY)
+ {
+ ffpmsg(
+ "cannot open compressed input stream with WRITE access (mem_compress_stdin_open)");
+ return(READONLY_FILE);
+ }
+
+ /* create a memory file for the uncompressed file */
+ status = mem_createmem(28800, hdl);
+
+ if (status)
+ {
+ ffpmsg("failed to create empty memory file (compress_stdin_open)");
+ return(status);
+ }
+
+ /* uncompress file into memory */
+ status = mem_uncompress2mem(filename, stdin, *hdl);
+
+ if (status)
+ {
+ mem_close_free(*hdl); /* free up the memory */
+ ffpmsg("failed to uncompress stdin into memory (compress_stdin_open)");
+ return(status);
+ }
+
+ /* if we allocated too much memory initially, then free it */
+ if (*(memTable[*hdl].memsizeptr) >
+ (( (size_t) memTable[*hdl].fitsfilesize) + 256L) )
+ {
+ ptr = realloc(*(memTable[*hdl].memaddrptr),
+ ((size_t) memTable[*hdl].fitsfilesize) );
+ if (!ptr)
+ {
+ ffpmsg("Failed to reduce size of allocated memory (compress_stdin_open)");
+ return(MEMORY_ALLOCATION);
+ }
+
+ *(memTable[*hdl].memaddrptr) = ptr;
+ *(memTable[*hdl].memsizeptr) = (size_t) (memTable[*hdl].fitsfilesize);
+ }
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_iraf_open(char *filename, int rwmode, int *hdl)
+/*
+ This routine creates an empty memory buffer, then calls iraf2mem to
+ open the IRAF disk file and convert it to a FITS file in memeory.
+*/
+{
+ int status;
+ size_t filesize = 0;
+
+ /* create a memory file with size = 0 for the FITS converted IRAF file */
+ status = mem_createmem(filesize, hdl);
+ if (status)
+ {
+ ffpmsg("failed to create empty memory file (mem_iraf_open)");
+ return(status);
+ }
+
+ /* convert the iraf file into a FITS file in memory */
+ status = iraf2mem(filename, memTable[*hdl].memaddrptr,
+ memTable[*hdl].memsizeptr, &filesize, &status);
+
+ if (status)
+ {
+ mem_close_free(*hdl); /* free up the memory */
+ ffpmsg("failed to convert IRAF file into memory (mem_iraf_open)");
+ return(status);
+ }
+
+ memTable[*hdl].currentpos = 0; /* save starting position */
+ memTable[*hdl].fitsfilesize=filesize; /* and initial file size */
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_rawfile_open(char *filename, int rwmode, int *hdl)
+/*
+ This routine creates an empty memory buffer, writes a minimal
+ image header, then copies the image data from the raw file into
+ memory. It will byteswap the pixel values if the raw array
+ is in little endian byte order.
+*/
+{
+ FILE *diskfile;
+ fitsfile *fptr;
+ short *sptr;
+ int status, endian, datatype, bytePerPix, naxis;
+ long dim[5] = {1,1,1,1,1}, ii, nvals, offset = 0;
+ size_t filesize = 0, datasize;
+ char rootfile[FLEN_FILENAME], *cptr = 0, *cptr2 = 0;
+ void *ptr;
+
+ if (rwmode != READONLY)
+ {
+ ffpmsg(
+ "cannot open raw binary file with WRITE access (mem_rawfile_open)");
+ ffpmsg(filename);
+ return(READONLY_FILE);
+ }
+
+ cptr = strchr(filename, '['); /* search for opening bracket [ */
+
+ if (!cptr)
+ {
+ ffpmsg("binary file name missing '[' character (mem_rawfile_open)");
+ ffpmsg(filename);
+ return(URL_PARSE_ERROR);
+ }
+
+ *rootfile = '\0';
+ strncat(rootfile, filename, cptr - filename); /* store the rootname */
+
+ cptr++;
+
+ while (*cptr == ' ')
+ cptr++; /* skip leading blanks */
+
+ /* Get the Data Type of the Image */
+
+ if (*cptr == 'b' || *cptr == 'B')
+ {
+ datatype = BYTE_IMG;
+ bytePerPix = 1;
+ }
+ else if (*cptr == 'i' || *cptr == 'I')
+ {
+ datatype = SHORT_IMG;
+ bytePerPix = 2;
+ }
+ else if (*cptr == 'u' || *cptr == 'U')
+ {
+ datatype = USHORT_IMG;
+ bytePerPix = 2;
+
+ }
+ else if (*cptr == 'j' || *cptr == 'J')
+ {
+ datatype = LONG_IMG;
+ bytePerPix = 4;
+ }
+ else if (*cptr == 'r' || *cptr == 'R' || *cptr == 'f' || *cptr == 'F')
+ {
+ datatype = FLOAT_IMG;
+ bytePerPix = 4;
+ }
+ else if (*cptr == 'd' || *cptr == 'D')
+ {
+ datatype = DOUBLE_IMG;
+ bytePerPix = 8;
+ }
+ else
+ {
+ ffpmsg("error in raw binary file datatype (mem_rawfile_open)");
+ ffpmsg(filename);
+ return(URL_PARSE_ERROR);
+ }
+
+ cptr++;
+
+ /* get Endian: Big or Little; default is same as the local machine */
+
+ if (*cptr == 'b' || *cptr == 'B')
+ {
+ endian = 0;
+ cptr++;
+ }
+ else if (*cptr == 'l' || *cptr == 'L')
+ {
+ endian = 1;
+ cptr++;
+ }
+ else
+ endian = BYTESWAPPED; /* byteswapped machines are little endian */
+
+ /* read each dimension (up to 5) */
+
+ naxis = 1;
+ dim[0] = strtol(cptr, &cptr2, 10);
+
+ if (cptr2 && *cptr2 == ',')
+ {
+ naxis = 2;
+ dim[1] = strtol(cptr2+1, &cptr, 10);
+
+ if (cptr && *cptr == ',')
+ {
+ naxis = 3;
+ dim[2] = strtol(cptr+1, &cptr2, 10);
+
+ if (cptr2 && *cptr2 == ',')
+ {
+ naxis = 4;
+ dim[3] = strtol(cptr2+1, &cptr, 10);
+
+ if (cptr && *cptr == ',')
+ naxis = 5;
+ dim[4] = strtol(cptr+1, &cptr2, 10);
+ }
+ }
+ }
+
+ cptr = maxvalue(cptr, cptr2);
+
+ if (*cptr == ':') /* read starting offset value */
+ offset = strtol(cptr+1, 0, 10);
+
+ nvals = dim[0] * dim[1] * dim[2] * dim[3] * dim[4];
+ datasize = nvals * bytePerPix;
+ filesize = nvals * bytePerPix + 2880;
+ filesize = ((filesize - 1) / 2880 + 1) * 2880;
+
+ /* open the raw binary disk file */
+ status = file_openfile(rootfile, READONLY, &diskfile);
+ if (status)
+ {
+ ffpmsg("failed to open raw binary file (mem_rawfile_open)");
+ ffpmsg(rootfile);
+ return(status);
+ }
+
+ /* create a memory file with corrct size for the FITS converted raw file */
+ status = mem_createmem(filesize, hdl);
+ if (status)
+ {
+ ffpmsg("failed to create memory file (mem_rawfile_open)");
+ fclose(diskfile);
+ return(status);
+ }
+
+ /* open this piece of memory as a new FITS file */
+ ffimem(&fptr, (void **) memTable[*hdl].memaddrptr, &filesize, 0, 0, &status);
+
+ /* write the required header keywords */
+ ffcrim(fptr, datatype, naxis, dim, &status);
+
+ /* close the FITS file, but keep the memory allocated */
+ ffclos(fptr, &status);
+
+ if (status > 0)
+ {
+ ffpmsg("failed to write basic image header (mem_rawfile_open)");
+ fclose(diskfile);
+ mem_close_free(*hdl); /* free up the memory */
+ return(status);
+ }
+
+ if (offset > 0)
+ fseek(diskfile, offset, 0); /* offset to start of the data */
+
+ /* read the raw data into memory */
+ ptr = *memTable[*hdl].memaddrptr + 2880;
+
+ if (fread((char *) ptr, 1, datasize, diskfile) != datasize)
+ status = READ_ERROR;
+
+ fclose(diskfile); /* close the raw binary disk file */
+
+ if (status)
+ {
+ mem_close_free(*hdl); /* free up the memory */
+ ffpmsg("failed to copy raw file data into memory (mem_rawfile_open)");
+ return(status);
+ }
+
+ if (datatype == USHORT_IMG) /* have to subtract 32768 from each unsigned */
+ { /* value to conform to FITS convention. More */
+ /* efficient way to do this is to just flip */
+ /* the most significant bit. */
+
+ sptr = (short *) ptr;
+
+ if (endian == BYTESWAPPED) /* working with native format */
+ {
+ for (ii = 0; ii < nvals; ii++, sptr++)
+ {
+ *sptr = ( *sptr ) ^ 0x8000;
+ }
+ }
+ else /* pixels are byteswapped WRT the native format */
+ {
+ for (ii = 0; ii < nvals; ii++, sptr++)
+ {
+ *sptr = ( *sptr ) ^ 0x80;
+ }
+ }
+ }
+
+ if (endian) /* swap the bytes if array is in little endian byte order */
+ {
+ if (datatype == SHORT_IMG || datatype == USHORT_IMG)
+ {
+ ffswap2( (short *) ptr, nvals);
+ }
+ else if (datatype == LONG_IMG || datatype == FLOAT_IMG)
+ {
+ ffswap4( (INT32BIT *) ptr, nvals);
+ }
+
+ else if (datatype == DOUBLE_IMG)
+ {
+ ffswap8( (double *) ptr, nvals);
+ }
+ }
+
+ memTable[*hdl].currentpos = 0; /* save starting position */
+ memTable[*hdl].fitsfilesize=filesize; /* and initial file size */
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_uncompress2mem(char *filename, FILE *diskfile, int hdl)
+{
+/*
+ lower level routine to uncompress a file into memory. The file
+ has already been opened and the memory buffer has been allocated.
+*/
+
+ size_t finalsize;
+ int status;
+ /* uncompress file into memory */
+ status = 0;
+
+ if (strstr(filename, ".Z")) {
+ zuncompress2mem(filename, diskfile,
+ memTable[hdl].memaddrptr, /* pointer to memory address */
+ memTable[hdl].memsizeptr, /* pointer to size of memory */
+ realloc, /* reallocation function */
+ &finalsize, &status); /* returned file size nd status*/
+ } else {
+ uncompress2mem(filename, diskfile,
+ memTable[hdl].memaddrptr, /* pointer to memory address */
+ memTable[hdl].memsizeptr, /* pointer to size of memory */
+ realloc, /* reallocation function */
+ &finalsize, &status); /* returned file size nd status*/
+ }
+
+ memTable[hdl].currentpos = 0; /* save starting position */
+ memTable[hdl].fitsfilesize=finalsize; /* and initial file size */
+ return status;
+}
+/*--------------------------------------------------------------------------*/
+int mem_size(int handle, LONGLONG *filesize)
+/*
+ return the size of the file; only called when the file is first opened
+*/
+{
+ *filesize = memTable[handle].fitsfilesize;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_close_free(int handle)
+/*
+ close the file and free the memory.
+*/
+{
+ free( *(memTable[handle].memaddrptr) );
+
+ memTable[handle].memaddrptr = 0;
+ memTable[handle].memaddr = 0;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_close_keep(int handle)
+/*
+ close the memory file but do not free the memory.
+*/
+{
+ memTable[handle].memaddrptr = 0;
+ memTable[handle].memaddr = 0;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_close_comp(int handle)
+/*
+ compress the memory file, writing it out to the fileptr (which might
+ be stdout)
+*/
+{
+ int status = 0;
+ size_t compsize;
+
+ /* compress file in memory to a .gz disk file */
+
+ if(compress2file_from_mem(memTable[handle].memaddr,
+ (size_t) (memTable[handle].fitsfilesize),
+ memTable[handle].fileptr,
+ &compsize, &status ) )
+ {
+ ffpmsg("failed to copy memory file to file (mem_close_comp)");
+ status = WRITE_ERROR;
+ }
+
+ free( memTable[handle].memaddr ); /* free the memory */
+ memTable[handle].memaddrptr = 0;
+ memTable[handle].memaddr = 0;
+
+ /* close the compressed disk file (except if it is 'stdout' */
+ if (memTable[handle].fileptr != stdout)
+ fclose(memTable[handle].fileptr);
+
+ return(status);
+}
+/*--------------------------------------------------------------------------*/
+int mem_seek(int handle, LONGLONG offset)
+/*
+ seek to position relative to start of the file.
+*/
+{
+ if (offset > memTable[handle].fitsfilesize )
+ return(END_OF_FILE);
+
+ memTable[handle].currentpos = offset;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_read(int hdl, void *buffer, long nbytes)
+/*
+ read bytes from the current position in the file
+*/
+{
+ if (memTable[hdl].currentpos + nbytes > memTable[hdl].fitsfilesize)
+ return(END_OF_FILE);
+
+ memcpy(buffer,
+ *(memTable[hdl].memaddrptr) + memTable[hdl].currentpos,
+ nbytes);
+
+ memTable[hdl].currentpos += nbytes;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int mem_write(int hdl, void *buffer, long nbytes)
+/*
+ write bytes at the current position in the file
+*/
+{
+ size_t newsize;
+ char *ptr;
+
+ if ((size_t) (memTable[hdl].currentpos + nbytes) >
+ *(memTable[hdl].memsizeptr) )
+ {
+
+ if (!(memTable[hdl].mem_realloc))
+ {
+ ffpmsg("realloc function not defined (mem_write)");
+ return(WRITE_ERROR);
+ }
+
+ /*
+ Attempt to reallocate additional memory:
+ the memory buffer size is incremented by the larger of:
+ 1 FITS block (2880 bytes) or
+ the defined 'deltasize' parameter
+ */
+
+ newsize = maxvalue( (size_t)
+ (((memTable[hdl].currentpos + nbytes - 1) / 2880) + 1) * 2880,
+ *(memTable[hdl].memsizeptr) + memTable[hdl].deltasize);
+
+ /* call the realloc function */
+ ptr = (memTable[hdl].mem_realloc)(
+ *(memTable[hdl].memaddrptr),
+ newsize);
+ if (!ptr)
+ {
+ ffpmsg("Failed to reallocate memory (mem_write)");
+ return(MEMORY_ALLOCATION);
+ }
+
+ *(memTable[hdl].memaddrptr) = ptr;
+ *(memTable[hdl].memsizeptr) = newsize;
+ }
+
+ /* now copy the bytes from the buffer into memory */
+ memcpy( *(memTable[hdl].memaddrptr) + memTable[hdl].currentpos,
+ buffer,
+ nbytes);
+
+ memTable[hdl].currentpos += nbytes;
+ memTable[hdl].fitsfilesize =
+ maxvalue(memTable[hdl].fitsfilesize,
+ memTable[hdl].currentpos);
+ return(0);
+}
diff --git a/src/plugins/cfitsio/drvrnet.c b/src/plugins/cfitsio/drvrnet.c
new file mode 100644
index 0000000..f0e1a42
--- /dev/null
+++ b/src/plugins/cfitsio/drvrnet.c
@@ -0,0 +1,2741 @@
+/* This file, drvrhttp.c contains driver routines for http, ftp and root
+ files. */
+
+/* This file was written by Bruce O'Neel at the ISDC, Switzerland */
+/* The FITSIO software is maintained by William Pence at the High Energy */
+/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */
+/* Goddard Space Flight Center. */
+
+
+/* Notes on the drivers:
+
+ The ftp driver uses passive mode exclusivly. If your remote system can't
+ deal with passive mode then it'll fail. Since Netscape Navigator uses
+ passive mode as well there shouldn't be too many ftp servers which have
+ problems.
+
+
+ The http driver works properly with 301 and 302 redirects. For many more
+ gory details see http://www.w3c.org/Protocols/rfc2068/rfc2068. The only
+ catch to the 301/302 redirects is that they have to redirect to another
+ http:// url. If not, things would have to change a lot in cfitsio and this
+ was thought to be too difficult.
+
+ Redirects look like
+
+
+ <HTML><HEAD>
+ <TITLE>301 Moved Permanently</TITLE>
+ </HEAD><BODY>
+ <H1>Moved Permanently</H1>
+ The document has moved <A HREF="http://heasarc.gsfc.nasa.gov/FTP/software/ftools/release/other/image.fits.gz";>here</A>.<P>
+ </BODY></HTML>
+
+ This redirect was from apache 1.2.5 but most of the other servers produce
+ something very similiar. The parser for the redirects finds the first
+ anchor <A> tag in the body and goes there. If that wasn't what was intended
+ by the remote system then hopefully the error stack, which includes notes
+ about the redirect will help the user fix the problem.
+
+
+
+ Root protocal doesn't have any real docs, so, the emperical docs are as
+ follows.
+
+ First, you must use a slightly modified rootd server. The modifications
+ include implimentation of the stat command which returns the size of the
+ remote file. Without that it's impossible for cfitsio to work properly
+ since fitsfiles don't include any information about the size of the files
+ in the headers. The rootd server closes the connections on any errors,
+ including reading beyond the end of the file or seeking beyond the end
+ of the file. The rootd:// driver doesn't reopen a closed connection, if
+ the connection is closed you're pretty much done.
+
+ The messages are of the form
+
+ <len><opcode><optional information>
+
+ All binary information is transfered in network format, so use htonl and
+ ntohl to convert back and forth.
+
+ <len> :== 4 byte length, in network format, the len doesn't include the
+ length of <len>
+ <opcode> :== one of the message opcodes below, 4 bytes, network format
+ <optional info> :== depends on opcode
+
+ The response is of the same form with the same opcode sent. Success is
+ indicated by <optional info> being 0.
+
+ Root is a NFSish protocol where each read/write includes the byte
+ offset to read or write to. As a result, seeks will always succeed
+ in the driver even if they would cause a fatal error when you try
+ to read because you're beyond the end of the file.
+
+ There is file locking on the host such that you need to possibly
+ create /usr/tmp/rootdtab on the host system. There is one file per
+ socket connection, though the rootd daemon can support multiple
+ files open at once.
+
+ The messages are sent in the following order:
+
+ ROOTD_USER - user name, <optional info> is the user name, trailing
+ null is sent though it's not required it seems. A ROOTD_AUTH
+ message is returned with any sort of error meaning that the user
+ name is wrong.
+
+ ROOTD_PASS - password, ones complemented, stored in <optional info>. Once
+ again the trailing null is sent. Once again a ROOTD_AUTH message is
+ returned
+
+ ROOTD_OPEN - <optional info> includes filename and one of
+ {create|update|read} as the file mode. ~ seems to be dealt with
+ as the username's login directory. A ROOTD_OPEN message is
+ returned.
+
+ Once the file is opened any of the following can be sent:
+
+ ROOTD_STAT - file status and size
+ returns a message where <optional info> is the file length in bytes
+
+ ROOTD_FLUSH - flushes the file, not sure this has any real effect
+ on the daemon since the daemon uses open/read/write/close rather
+ than the buffered fopen/fread/fwrite/fclose.
+
+ ROOTD_GET - on send <optional info> includes a text message of
+ offset and length to get. Return is a status message first with a
+ status value, then, the raw bytes for the length that you
+ requested. It's an error to seek or read past the end of the file,
+ and, the rootd daemon exits and won't respond anymore. Ie, don't
+ do this.
+
+ ROOTD_PUT - on send <optional info> includes a text message of
+ offset and length to put. Then send the raw bytes you want to
+ write. Then recieve a status message
+
+
+ When you are finished then you send the message:
+
+ ROOTD_CLOSE - closes the file
+
+ Once the file is closed then the socket is closed.
+
+
+Revision 1.56 2000/01/04 11:58:31 oneel
+Updates so that compressed network files are dealt with regardless of
+their file names and/or mime types.
+
+Revision 1.55 2000/01/04 10:52:40 oneel
+cfitsio 2.034
+
+Revision 1.51 1999/08/10 12:13:40 oneel
+Make the http code a bit less picky about the types of files it
+uncompresses. Now it also uncompresses files which end in .Z or .gz.
+
+Revision 1.50 1999/08/04 12:38:46 oneel
+Don's 2.0.32 patch with dal 1.3
+
+Revision 1.39 1998/12/02 15:31:33 oneel
+Updates to drvrnet.c so that less compiler warnings would be
+generated. Fixes the signal handling.
+
+Revision 1.38 1998/11/23 10:03:24 oneel
+Added in a useragent string, as suggested by:
+Tim Kimball · Data Systems Division ¦ kimball stsci edu · 410-338-4417
+Space Telescope Science Institute ¦ http://www.stsci.edu/~kimball/
+3700 San Martin Drive ¦ http://archive.stsci.edu/
+Baltimore MD 21218 USA ¦ http://faxafloi.stsci.edu:4547/
+
+
+ */
+
+#ifdef HAVE_NET_SERVICES
+#include <string.h>
+
+#include <sys/types.h>
+#include <netinet/in.h>
+#include <netinet/tcp.h>
+#include <sys/socket.h>
+#include <arpa/inet.h>
+#include <netdb.h>
+#include <errno.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+
+#if defined(unix) || defined(__unix__) || defined(__unix)
+#include <unistd.h>
+#endif
+
+#include <signal.h>
+#include <setjmp.h>
+#include "fitsio2.h"
+
+static jmp_buf env; /* holds the jump buffer for setjmp/longjmp pairs */
+static void signal_handler(int sig);
+
+/* Network routine error codes */
+#define NET_OK 0
+#define NOT_INET_ADDRESS -1000
+#define UNKNOWN_INET_HOST -1001
+#define CONNECTION_ERROR -1002
+
+/* Network routine constants */
+#define NET_DEFAULT 0
+#define NET_OOB 1
+#define NET_PEEK 2
+
+#define NETTIMEOUT 180 /* in secs */
+
+/* local defines and variables */
+#define MAXLEN 1200
+#define SHORTLEN 100
+static char netoutfile[MAXLEN];
+
+
+#define ROOTD_USER 2000 /*user id follows */
+#define ROOTD_PASS 2001 /*passwd follows */
+#define ROOTD_AUTH 2002 /*authorization status (to client) */
+#define ROOTD_FSTAT 2003 /*filename follows */
+#define ROOTD_OPEN 2004 /*filename follows + mode */
+#define ROOTD_PUT 2005 /*offset, number of bytes and buffer */
+#define ROOTD_GET 2006 /*offset, number of bytes */
+#define ROOTD_FLUSH 2007 /*flush file */
+#define ROOTD_CLOSE 2008 /*close file */
+#define ROOTD_STAT 2009 /*return rootd statistics */
+#define ROOTD_ACK 2010 /*acknowledgement (all OK) */
+#define ROOTD_ERR 2011 /*error code and message follow */
+
+typedef struct /* structure containing disk file structure */
+{
+ int sock;
+ LONGLONG currentpos;
+} rootdriver;
+
+static rootdriver handleTable[NMAXFILES]; /* allocate diskfile handle tables */
+
+/* static prototypes */
+
+static int NET_TcpConnect(char *hostname, int port);
+static int NET_SendRaw(int sock, const void *buf, int length, int opt);
+static int NET_RecvRaw(int sock, void *buffer, int length);
+static int NET_ParseUrl(const char *url, char *proto, char *host, int *port,
+ char *fn);
+static int CreateSocketAddress(struct sockaddr_in *sockaddrPtr,
+ char *host,int port);
+static int ftp_status(FILE *ftp, char *statusstr);
+static int http_open_network(char *url, FILE **httpfile, char *contentencoding,
+ int *contentlength);
+static int ftp_open_network(char *url, FILE **ftpfile, FILE **command,
+ int *sock);
+
+static int root_send_buffer(int sock, int op, char *buffer, int buflen);
+static int root_recv_buffer(int sock, int *op, char *buffer,int buflen);
+static int root_openfile(char *filename, char *rwmode, int *sock);
+static int encode64(unsigned s_len, char *src, unsigned d_len, char *dst);
+
+/***************************/
+/* Static variables */
+
+static int closehttpfile;
+static int closememfile;
+static int closefdiskfile;
+static int closediskfile;
+static int closefile;
+static int closeoutfile;
+static int closecommandfile;
+static int closeftpfile;
+static FILE *diskfile;
+static FILE *outfile;
+
+/*--------------------------------------------------------------------------*/
+/* This creates a memory file handle with a copy of the URL in filename. The
+ file is uncompressed if necessary */
+
+int http_open(char *filename, int rwmode, int *handle)
+{
+
+ FILE *httpfile;
+ char contentencoding[SHORTLEN];
+ char newfilename[MAXLEN];
+ char errorstr[MAXLEN];
+ char recbuf[MAXLEN];
+ long len;
+ int contentlength;
+ int status;
+ char firstchar;
+
+ closehttpfile = 0;
+ closememfile = 0;
+
+ /* don't do r/w files */
+ if (rwmode != 0) {
+ ffpmsg("Can't open http:// type file with READWRITE access");
+ ffpmsg(" Specify an outfile for r/w access (http_open)");
+ goto error;
+ }
+
+ /* do the signal handler bits */
+ if (setjmp(env) != 0) {
+ /* feels like the second time */
+ /* this means something bad happened */
+ ffpmsg("Timeout (http_open)");
+ goto error;
+ }
+
+ (void) signal(SIGALRM, signal_handler);
+
+ /* Open the network connection */
+
+ /* Does the file have a .Z or .gz in it */
+ /* Also, if file has a '?' in it (probably cgi script) */
+ if (strstr(filename,".Z") || strstr(filename,".gz") ||
+ strstr(filename,"?")) {
+ alarm(NETTIMEOUT);
+ if (http_open_network(filename,&httpfile,contentencoding,
+ &contentlength)) {
+ alarm(0);
+ ffpmsg("Unable to open http file (http_open):");
+ ffpmsg(filename);
+ goto error;
+ }
+ } else {
+
+ if (strlen(filename) >= MAXLEN - 4) {
+ ffpmsg("http file name is too long (http_open)");
+ ffpmsg(filename);
+ goto error;
+ }
+
+ alarm(NETTIMEOUT);
+ /* Try the .gz one */
+ strcpy(newfilename,filename);
+ strcat(newfilename,".gz");
+
+ if (http_open_network(newfilename,&httpfile,contentencoding,
+ &contentlength)) {
+ alarm(0);
+ /* Now the .Z one */
+ strcpy(newfilename,filename);
+ strcat(newfilename,".Z");
+ alarm(NETTIMEOUT);
+ if (http_open_network(newfilename,&httpfile,contentencoding,
+ &contentlength)) {
+ alarm(0);
+ alarm(NETTIMEOUT);
+ if (http_open_network(filename,&httpfile,contentencoding,
+ &contentlength)) {
+ alarm(0);
+ ffpmsg("Unable to open http file (http_open)");
+ ffpmsg(filename);
+ goto error;
+ }
+ }
+ }
+ }
+
+ closehttpfile++;
+
+ /* Create the memory file */
+ if ((status = mem_create(filename,handle))) {
+ ffpmsg("Unable to create memory file (http_open)");
+ goto error;
+ }
+
+ closememfile++;
+
+ /* Now, what do we do with the file */
+ /* Check to see what the first character is */
+ firstchar = fgetc(httpfile);
+ ungetc(firstchar,httpfile);
+ if (!strcmp(contentencoding,"x-gzip") ||
+ !strcmp(contentencoding,"x-compress") ||
+ strstr(filename,".gz") ||
+ strstr(filename,".Z") ||
+ ('\037' == firstchar)) {
+ /* do the compress dance, which is the same as the gzip dance */
+ /* Using the cfitsio routine */
+
+ status = 0;
+ /* Ok, this is a tough case, let's be arbritary and say 10*NETTIMEOUT,
+ Given the choices for nettimeout above they'll probaby ^C before, but
+ it's always worth a shot*/
+
+ alarm(NETTIMEOUT*10);
+ status = mem_uncompress2mem(filename, httpfile, *handle);
+ alarm(0);
+ if (status) {
+ ffpmsg("Error writing compressed memory file (http_open)");
+ ffpmsg(filename);
+ goto error;
+ }
+
+ } else {
+ /* It's not compressed, bad choice, but we'll copy it anyway */
+ if (contentlength % 2880) {
+ sprintf(errorstr,"Content-Length not a multiple of 2880 (http_open) %d",
+ contentlength);
+ ffpmsg(errorstr);
+ }
+
+ /* write a memory file */
+ alarm(NETTIMEOUT);
+ while(0 != (len = fread(recbuf,1,MAXLEN,httpfile))) {
+ alarm(0); /* cancel alarm */
+ status = mem_write(*handle,recbuf,len);
+ if (status) {
+ ffpmsg("Error copying http file into memory (http_open)");
+ ffpmsg(filename);
+ goto error;
+ }
+ alarm(NETTIMEOUT); /* rearm the alarm */
+ }
+ }
+
+ fclose(httpfile);
+
+ signal(SIGALRM, SIG_DFL);
+ alarm(0);
+ return mem_seek(*handle,0);
+
+ error:
+ alarm(0); /* clear it */
+ if (closehttpfile) {
+ fclose(httpfile);
+ }
+ if (closememfile) {
+ mem_close_free(*handle);
+ }
+
+ signal(SIGALRM, SIG_DFL);
+ return (FILE_NOT_OPENED);
+}
+/*--------------------------------------------------------------------------*/
+/* This creates a memory file handle with a copy of the URL in filename. The
+ file must be compressed and is copied (still compressed) to disk first.
+ The compressed disk file is then uncompressed into memory (READONLY).
+*/
+
+int http_compress_open(char *url, int rwmode, int *handle)
+{
+ FILE *httpfile;
+ char contentencoding[SHORTLEN];
+ char recbuf[MAXLEN];
+ long len;
+ int contentlength;
+ int ii, flen, status;
+ char firstchar;
+
+ closehttpfile = 0;
+ closediskfile = 0;
+ closefdiskfile = 0;
+ closememfile = 0;
+
+ /* cfileio made a mistake, should set the netoufile first otherwise
+ we don't know where to write the output file */
+
+ flen = strlen(netoutfile);
+ if (!flen) {
+ ffpmsg
+ ("Output file not set, shouldn't have happened (http_compress_open)");
+ goto error;
+ }
+
+ if (rwmode != 0) {
+ ffpmsg("Can't open compressed http:// type file with READWRITE access");
+ ffpmsg(" Specify an UNCOMPRESSED outfile (http_compress_open)");
+ goto error;
+ }
+ /* do the signal handler bits */
+ if (setjmp(env) != 0) {
+ /* feels like the second time */
+ /* this means something bad happened */
+ ffpmsg("Timeout (http_open)");
+ goto error;
+ }
+
+ signal(SIGALRM, signal_handler);
+
+ /* Open the http connectin */
+ alarm(NETTIMEOUT);
+ if ((status = http_open_network(url,&httpfile,contentencoding,
+ &contentlength))) {
+ alarm(0);
+ ffpmsg("Unable to open http file (http_compress_open)");
+ ffpmsg(url);
+ goto error;
+ }
+
+ closehttpfile++;
+
+ /* Better be compressed */
+
+ firstchar = fgetc(httpfile);
+ ungetc(firstchar,httpfile);
+ if (!strcmp(contentencoding,"x-gzip") ||
+ !strcmp(contentencoding,"x-compress") ||
+ ('\037' == firstchar)) {
+
+ if (*netoutfile == '!')
+ {
+ /* user wants to clobber file, if it already exists */
+ for (ii = 0; ii < flen; ii++)
+ netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */
+
+ status = file_remove(netoutfile);
+ }
+
+ /* Create the new file */
+ if ((status = file_create(netoutfile,handle))) {
+ ffpmsg("Unable to create output disk file (http_compress_open):");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+
+ closediskfile++;
+
+ /* write a file */
+ alarm(NETTIMEOUT);
+ while(0 != (len = fread(recbuf,1,MAXLEN,httpfile))) {
+ alarm(0);
+ status = file_write(*handle,recbuf,len);
+ if (status) {
+ ffpmsg("Error writing disk file (http_compres_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ alarm(NETTIMEOUT);
+ }
+ file_close(*handle);
+ fclose(httpfile);
+ closehttpfile--;
+ closediskfile--;
+
+ /* File is on disk, let's uncompress it into memory */
+
+ if (NULL == (diskfile = fopen(netoutfile,"r"))) {
+ ffpmsg("Unable to reopen disk file (http_compress_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ closefdiskfile++;
+
+ /* Create the memory handle to hold it */
+ if ((status = mem_create(url,handle))) {
+ ffpmsg("Unable to create memory file (http_compress_open)");
+ goto error;
+ }
+ closememfile++;
+
+ /* Uncompress it */
+ status = 0;
+ status = mem_uncompress2mem(url,diskfile,*handle);
+ fclose(diskfile);
+ closefdiskfile--;
+ if (status) {
+ ffpmsg("Error uncompressing disk file to memory (http_compress_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+
+ } else {
+ /* Opps, this should not have happened */
+ ffpmsg("Can only have compressed files here (http_compress_open)");
+ goto error;
+ }
+
+ signal(SIGALRM, SIG_DFL);
+ alarm(0);
+ return mem_seek(*handle,0);
+
+ error:
+ alarm(0); /* clear it */
+ if (closehttpfile) {
+ fclose(httpfile);
+ }
+ if (closefdiskfile) {
+ fclose(diskfile);
+ }
+ if (closememfile) {
+ mem_close_free(*handle);
+ }
+ if (closediskfile) {
+ file_close(*handle);
+ }
+
+ signal(SIGALRM, SIG_DFL);
+ return (FILE_NOT_OPENED);
+}
+
+/*--------------------------------------------------------------------------*/
+/* This creates a file handle with a copy of the URL in filename. The http
+ file is copied to disk first. If it's compressed then it is
+ uncompressed when copying to the disk */
+
+int http_file_open(char *url, int rwmode, int *handle)
+{
+ FILE *httpfile;
+ char contentencoding[SHORTLEN];
+ char errorstr[MAXLEN];
+ char recbuf[MAXLEN];
+ long len;
+ int contentlength;
+ int ii, flen, status;
+ char firstchar;
+
+ /* Check if output file is actually a memory file */
+ if (!strncmp(netoutfile, "mem:", 4) )
+ {
+ /* allow the memory file to be opened with write access */
+ return( http_open(url, READONLY, handle) );
+ }
+
+ closehttpfile = 0;
+ closefile = 0;
+ closeoutfile = 0;
+
+ /* cfileio made a mistake, we need to know where to write the file */
+ flen = strlen(netoutfile);
+ if (!flen) {
+ ffpmsg("Output file not set, shouldn't have happened (http_file_open)");
+ return (FILE_NOT_OPENED);
+ }
+
+ /* do the signal handler bits */
+ if (setjmp(env) != 0) {
+ /* feels like the second time */
+ /* this means something bad happened */
+ ffpmsg("Timeout (http_open)");
+ goto error;
+ }
+
+ signal(SIGALRM, signal_handler);
+
+ /* Open the network connection */
+ alarm(NETTIMEOUT);
+ if ((status = http_open_network(url,&httpfile,contentencoding,
+ &contentlength))) {
+ alarm(0);
+ ffpmsg("Unable to open http file (http_file_open)");
+ ffpmsg(url);
+ goto error;
+ }
+
+ closehttpfile++;
+
+ if (*netoutfile == '!')
+ {
+ /* user wants to clobber disk file, if it already exists */
+ for (ii = 0; ii < flen; ii++)
+ netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */
+
+ status = file_remove(netoutfile);
+ }
+
+ firstchar = fgetc(httpfile);
+ ungetc(firstchar,httpfile);
+ if (!strcmp(contentencoding,"x-gzip") ||
+ !strcmp(contentencoding,"x-compress") ||
+ ('\037' == firstchar)) {
+
+ /* to make this more cfitsioish we use the file driver calls to create
+ the disk file */
+
+ /* Create the output file */
+ if ((status = file_create(netoutfile,handle))) {
+ ffpmsg("Unable to create output file (http_file_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+
+ file_close(*handle);
+ if (NULL == (outfile = fopen(netoutfile,"w"))) {
+ ffpmsg("Unable to reopen the output file (http_file_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ closeoutfile++;
+ status = 0;
+
+ /* Ok, this is a tough case, let's be arbritary and say 10*NETTIMEOUT,
+ Given the choices for nettimeout above they'll probaby ^C before, but
+ it's always worth a shot*/
+
+ alarm(NETTIMEOUT*10);
+ status = uncompress2file(url,httpfile,outfile,&status);
+ alarm(0);
+ if (status) {
+ ffpmsg("Error uncompressing http file to disk file (http_file_open)");
+ ffpmsg(url);
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ fclose(outfile);
+ closeoutfile--;
+ } else {
+
+ /* Create the output file */
+ if ((status = file_create(netoutfile,handle))) {
+ ffpmsg("Unable to create output file (http_file_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+
+ /* Give a warning message. This could just be bad padding at the end
+ so don't treat it like an error. */
+ closefile++;
+
+ if (contentlength % 2880) {
+ sprintf(errorstr,
+ "Content-Length not a multiple of 2880 (http_file_open) %d",
+ contentlength);
+ ffpmsg(errorstr);
+ }
+
+ /* write a file */
+ alarm(NETTIMEOUT);
+ while(0 != (len = fread(recbuf,1,MAXLEN,httpfile))) {
+ alarm(0);
+ status = file_write(*handle,recbuf,len);
+ if (status) {
+ ffpmsg("Error copying http file to disk file (http_file_open)");
+ ffpmsg(url);
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ }
+ file_close(*handle);
+ closefile--;
+ }
+
+ fclose(httpfile);
+ closehttpfile--;
+
+ signal(SIGALRM, SIG_DFL);
+ alarm(0);
+
+ return file_open(netoutfile,rwmode,handle);
+
+ error:
+ alarm(0); /* clear it */
+ if (closehttpfile) {
+ fclose(httpfile);
+ }
+ if (closeoutfile) {
+ fclose(outfile);
+ }
+ if (closefile) {
+ file_close(*handle);
+ }
+
+ signal(SIGALRM, SIG_DFL);
+ return (FILE_NOT_OPENED);
+}
+
+/*--------------------------------------------------------------------------*/
+/* This is the guts of the code to get a file via http.
+ url is the input url
+ httpfile is set to be the file connected to the socket which you can
+ read the file from
+ contentencoding is the mime type of the file, returned if the http server
+ returns it
+ contentlength is the lenght of the file, returned if the http server returns
+ it
+*/
+static int http_open_network(char *url, FILE **httpfile, char *contentencoding,
+ int *contentlength)
+{
+
+ int status;
+ int sock;
+ int tmpint;
+ char recbuf[MAXLEN];
+ char tmpstr[MAXLEN];
+ char tmpstr1[SHORTLEN];
+ char tmpstr2[MAXLEN];
+ char errorstr[MAXLEN];
+ char proto[SHORTLEN];
+ char host[SHORTLEN];
+ char userpass[MAXLEN];
+ char fn[MAXLEN];
+ char turl[MAXLEN];
+ char *scratchstr;
+ int port;
+ float version;
+
+ char pproto[SHORTLEN];
+ char phost[SHORTLEN]; /* address of the proxy server */
+ int pport; /* port number of the proxy server */
+ char pfn[MAXLEN];
+ char *proxy; /* URL of the proxy server */
+
+ /* Parse the URL apart again */
+ strcpy(turl,"http://";);
+ strncat(turl,url,MAXLEN - 8);
+ if (NET_ParseUrl(turl,proto,host,&port,fn)) {
+ sprintf(errorstr,"URL Parse Error (http_open) %s",url);
+ ffpmsg(errorstr);
+ return (FILE_NOT_OPENED);
+ }
+
+ /* Do we have a user:password combo ? */
+ strcpy(userpass, url);
+ if ((scratchstr = strchr(userpass, '@')) != NULL) {
+ *scratchstr = '\0';
+ } else
+ strcpy(userpass, "");
+
+ /* Ph. Prugniel 2003/04/03
+ Are we using a proxy?
+
+ We use a proxy if the environment variable "http_proxy" is set to an
+ address, eg. http://wwwcache.nottingham.ac.uk:3128
+ ("http_proxy" is also used by wget)
+ */
+ proxy = getenv("http_proxy");
+
+ /* Connect to the remote host */
+ if (proxy) {
+ if (NET_ParseUrl(proxy,pproto,phost,&pport,pfn)) {
+ sprintf(errorstr,"URL Parse Error (http_open) %s",proxy);
+ ffpmsg(errorstr);
+ return (FILE_NOT_OPENED);
+ }
+ sock = NET_TcpConnect(phost,pport);
+ }
+ else
+ sock = NET_TcpConnect(host,port);
+
+ if (sock < 0) {
+ if (proxy) {
+ ffpmsg("Couldn't connect to host via proxy server (http_open_network)");
+ ffpmsg(proxy);
+ }
+ return (FILE_NOT_OPENED);
+ }
+
+ /* Make the socket a stdio file */
+ if (NULL == (*httpfile = fdopen(sock,"r"))) {
+ ffpmsg ("fdopen failed to convert socket to file (http_open_network)");
+ close(sock);
+ return (FILE_NOT_OPENED);
+ }
+
+ /* Send the GET request to the remote server */
+ /* Ph. Prugniel 2003/04/03
+ One must add the Host: command because of HTTP 1.1 servers (ie. virtual
+ hosts) */
+
+ if (proxy)
+ sprintf(tmpstr,"GET http://%s:%-d%s HTTP/1.0\r\n",host,port,fn);
+ else
+ sprintf(tmpstr,"GET %s HTTP/1.0\r\n",fn);
+
+ if (strcmp(userpass, "")) {
+ encode64(strlen(userpass), userpass, MAXLEN, tmpstr2);
+ sprintf(tmpstr1, "Authorization: Basic %s\r\n", tmpstr2);
+
+ if (strlen(tmpstr) + strlen(tmpstr1) > MAXLEN - 1)
+ return (FILE_NOT_OPENED);
+
+ strcat(tmpstr,tmpstr1);
+ }
+
+ sprintf(tmpstr1,"User-Agent: HEASARC/CFITSIO/%-8.3f\r\n",ffvers(&version));
+
+ if (strlen(tmpstr) + strlen(tmpstr1) > MAXLEN - 1)
+ return (FILE_NOT_OPENED);
+
+ strcat(tmpstr,tmpstr1);
+
+ /* HTTP 1.1 servers require the following 'Host: ' string */
+ sprintf(tmpstr1,"Host: %s:%-d\r\n\r\n",host,port);
+
+ if (strlen(tmpstr) + strlen(tmpstr1) > MAXLEN - 1)
+ return (FILE_NOT_OPENED);
+
+ strcat(tmpstr,tmpstr1);
+
+ status = NET_SendRaw(sock,tmpstr,strlen(tmpstr),NET_DEFAULT);
+
+ /* read the header */
+ if (!(fgets(recbuf,MAXLEN,*httpfile))) {
+ sprintf (errorstr,"http header short (http_open_network) %s",recbuf);
+ ffpmsg(errorstr);
+ fclose(*httpfile);
+ return (FILE_NOT_OPENED);
+ }
+ *contentlength = 0;
+ contentencoding[0] = '\0';
+
+ /* Our choices are 200, ok, 301, temporary redirect, or 302 perm redirect */
+ sscanf(recbuf,"%s %d",tmpstr,&status);
+ if (status != 200){
+ if (status == 301 || status == 302) {
+ /* got a redirect */
+ if (status == 301) {
+ ffpmsg("Note: Web server replied with a temporary redirect from");
+ } else {
+ ffpmsg("Note: Web server replied with a redirect from");
+ }
+ ffpmsg(turl);
+ /* now, let's not write the most sophisticated parser here */
+
+ while (fgets(recbuf,MAXLEN,*httpfile)) {
+ scratchstr = strstr(recbuf,"<A HREF=\"");
+ if (scratchstr != NULL) {
+ /* Ok, we found the beginning of the anchor */
+ scratchstr += 9; /* skip the <A HREF=" bits */
+ scratchstr += 7; /* skip http://, we die if it's really ftp:// */
+ strcpy(turl,strtok(scratchstr,"\""));
+ sprintf(errorstr,"to %s\n",turl);
+ ffpmsg(errorstr);
+ fclose (*httpfile);
+ return
+ http_open_network(turl,httpfile,contentencoding,contentlength);
+ }
+ }
+ /* if we get here then we couldnt' decide the redirect */
+ ffpmsg("but we were unable to find the redirected url in the servers response");
+ }
+/* sprintf(errorstr,
+ "(http_open_network) Status not 200, was %d\nLine was %s\n",
+ status,recbuf);
+ ffpmsg(errorstr);
+*/
+ fclose(*httpfile);
+ return (FILE_NOT_OPENED);
+ }
+
+ /* from here the first word holds the keyword we want */
+ /* so, read the rest of the header */
+ while (fgets(recbuf,MAXLEN,*httpfile)) {
+ /* Blank line ends the header */
+ if (*recbuf == '\r') break;
+ if (strlen(recbuf) > 3) {
+ recbuf[strlen(recbuf)-1] = '\0';
+ recbuf[strlen(recbuf)-1] = '\0';
+ }
+ sscanf(recbuf,"%s %d",tmpstr,&tmpint);
+ /* Did we get a content-length header ? */
+ if (!strcmp(tmpstr,"Content-Length:")) {
+ *contentlength = tmpint;
+ }
+ /* Did we get the content-encoding header ? */
+ if (!strcmp(tmpstr,"Content-Encoding:")) {
+ if (NULL != (scratchstr = strstr(recbuf,":"))) {
+ /* Found the : */
+ scratchstr++; /* skip the : */
+ scratchstr++; /* skip the extra space */
+ strcpy(contentencoding,scratchstr);
+ }
+ }
+ }
+
+ /* we're done, so return */
+ return 0;
+}
+
+
+/*--------------------------------------------------------------------------*/
+/* This creates a memory file handle with a copy of the URL in filename. The
+ file is uncompressed if necessary */
+
+int ftp_open(char *filename, int rwmode, int *handle)
+{
+
+ FILE *ftpfile;
+ FILE *command;
+ int sock;
+ char newfilename[MAXLEN];
+ char recbuf[MAXLEN];
+ long len;
+ int status;
+ char firstchar;
+
+ closememfile = 0;
+ closecommandfile = 0;
+ closeftpfile = 0;
+
+ /* don't do r/w files */
+ if (rwmode != 0) {
+ ffpmsg("Can't open ftp:// type file with READWRITE access");
+ ffpmsg("Specify an outfile for r/w access (ftp_open)");
+ return (FILE_NOT_OPENED);
+ }
+
+ /* do the signal handler bits */
+ if (setjmp(env) != 0) {
+ /* feels like the second time */
+ /* this means something bad happened */
+ ffpmsg("Timeout (http_open)");
+ goto error;
+ }
+
+ signal(SIGALRM, signal_handler);
+
+ /* Open the ftp connetion. ftpfile is connected to the file port,
+ command is connected to port 21. sock is the socket on port 21 */
+
+ if (strlen(filename) > MAXLEN - 4) {
+ ffpmsg("filename too long (ftp_open)");
+ ffpmsg(filename);
+ goto error;
+ }
+
+ alarm(NETTIMEOUT);
+ strcpy(newfilename,filename);
+ /* Does the file have a .Z or .gz in it */
+ if (strstr(newfilename,".Z") || strstr(newfilename,".gz")) {
+ alarm(NETTIMEOUT);
+ if (ftp_open_network(filename,&ftpfile,&command,&sock)) {
+
+ alarm(0);
+ ffpmsg("Unable to open ftp file (ftp_open)");
+ ffpmsg(filename);
+ goto error;
+ }
+ } else {
+ /* Try the .gz one */
+ strcpy(newfilename,filename);
+ strcat(newfilename,".gz");
+ alarm(NETTIMEOUT);
+ if (ftp_open_network(newfilename,&ftpfile,&command,&sock)) {
+
+ alarm(0);
+ strcpy(newfilename,filename);
+ strcat(newfilename,".Z");
+ alarm(NETTIMEOUT);
+ if (ftp_open_network(newfilename,&ftpfile,&command,&sock)) {
+
+ /* Now as given */
+ alarm(0);
+ strcpy(newfilename,filename);
+ alarm(NETTIMEOUT);
+ if (ftp_open_network(newfilename,&ftpfile,&command,&sock)) {
+ alarm(0);
+ ffpmsg("Unable to open ftp file (ftp_open)");
+ ffpmsg(newfilename);
+ goto error;
+ }
+ }
+ }
+ }
+
+ closeftpfile++;
+ closecommandfile++;
+
+ /* create the memory file */
+ if ((status = mem_create(filename,handle))) {
+ ffpmsg ("Could not create memory file to passive port (ftp_open)");
+ ffpmsg(filename);
+ goto error;
+ }
+ closememfile++;
+ /* This isn't quite right, it'll fail if the file has .gzabc at the end
+ for instance */
+
+ /* Decide if the file is compressed */
+ firstchar = fgetc(ftpfile);
+ ungetc(firstchar,ftpfile);
+
+ if (strstr(newfilename,".gz") ||
+ strstr(newfilename,".Z") ||
+ ('\037' == firstchar)) {
+
+ status = 0;
+ /* A bit arbritary really, the user will probably hit ^C */
+ alarm(NETTIMEOUT*10);
+ status = mem_uncompress2mem(filename, ftpfile, *handle);
+ alarm(0);
+ if (status) {
+ ffpmsg("Error writing compressed memory file (ftp_open)");
+ ffpmsg(filename);
+ goto error;
+ }
+ } else {
+ /* write a memory file */
+ alarm(NETTIMEOUT);
+ while(0 != (len = fread(recbuf,1,MAXLEN,ftpfile))) {
+ alarm(0);
+ status = mem_write(*handle,recbuf,len);
+ if (status) {
+ ffpmsg("Error writing memory file (http_open)");
+ ffpmsg(filename);
+ goto error;
+ }
+ alarm(NETTIMEOUT);
+ }
+ }
+
+ /* close and clean up */
+ fclose(ftpfile);
+ closeftpfile--;
+
+ NET_SendRaw(sock,"QUIT\n",5,NET_DEFAULT);
+ fclose(command);
+ closecommandfile--;
+
+ signal(SIGALRM, SIG_DFL);
+ alarm(0);
+
+ return mem_seek(*handle,0);
+
+ error:
+ alarm(0); /* clear it */
+ if (closecommandfile) {
+ fclose(command);
+ }
+ if (closeftpfile) {
+ fclose(ftpfile);
+ }
+ if (closememfile) {
+ mem_close_free(*handle);
+ }
+
+ signal(SIGALRM, SIG_DFL);
+ return (FILE_NOT_OPENED);
+}
+/*--------------------------------------------------------------------------*/
+/* This creates a file handle with a copy of the URL in filename. The
+ file must be uncompressed and is copied to disk first */
+
+int ftp_file_open(char *url, int rwmode, int *handle)
+{
+ FILE *ftpfile;
+ FILE *command;
+ char recbuf[MAXLEN];
+ long len;
+ int sock;
+ int ii, flen, status;
+ char firstchar;
+
+ /* Check if output file is actually a memory file */
+ if (!strncmp(netoutfile, "mem:", 4) )
+ {
+ /* allow the memory file to be opened with write access */
+ return( ftp_open(url, READONLY, handle) );
+ }
+
+ closeftpfile = 0;
+ closecommandfile = 0;
+ closefile = 0;
+ closeoutfile = 0;
+
+ /* cfileio made a mistake, need to know where to write the output file */
+ flen = strlen(netoutfile);
+ if (!flen)
+ {
+ ffpmsg("Output file not set, shouldn't have happened (ftp_file_open)");
+ return (FILE_NOT_OPENED);
+ }
+
+ /* do the signal handler bits */
+ if (setjmp(env) != 0) {
+ /* feels like the second time */
+ /* this means something bad happened */
+ ffpmsg("Timeout (http_open)");
+ goto error;
+ }
+
+ signal(SIGALRM, signal_handler);
+
+ /* open the network connection to url. ftpfile holds the connection to
+ the input file, command holds the connection to port 21, and sock is
+ the socket connected to port 21 */
+
+ alarm(NETTIMEOUT);
+ if ((status = ftp_open_network(url,&ftpfile,&command,&sock))) {
+ alarm(0);
+ ffpmsg("Unable to open http file (ftp_file_open)");
+ ffpmsg(url);
+ goto error;
+ }
+ closeftpfile++;
+ closecommandfile++;
+
+ if (*netoutfile == '!')
+ {
+ /* user wants to clobber file, if it already exists */
+ for (ii = 0; ii < flen; ii++)
+ netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */
+
+ status = file_remove(netoutfile);
+ }
+
+ /* Now, what do we do with the file */
+ firstchar = fgetc(ftpfile);
+ ungetc(firstchar,ftpfile);
+
+ if (strstr(url,".gz") ||
+ strstr(url,".Z") ||
+ ('\037' == firstchar)) {
+
+ /* to make this more cfitsioish we use the file driver calls to create
+ the file */
+ /* Create the output file */
+ if ((status = file_create(netoutfile,handle))) {
+ ffpmsg("Unable to create output file (ftp_file_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+
+ file_close(*handle);
+ if (NULL == (outfile = fopen(netoutfile,"w"))) {
+ ffpmsg("Unable to reopen the output file (ftp_file_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ closeoutfile++;
+ status = 0;
+
+ /* Ok, this is a tough case, let's be arbritary and say 10*NETTIMEOUT,
+ Given the choices for nettimeout above they'll probaby ^C before, but
+ it's always worth a shot*/
+
+ alarm(NETTIMEOUT*10);
+ status = uncompress2file(url,ftpfile,outfile,&status);
+ alarm(0);
+ if (status) {
+ ffpmsg("Unable to uncompress the output file (ftp_file_open)");
+ ffpmsg(url);
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ fclose(outfile);
+ closeoutfile--;
+
+ } else {
+
+ /* Create the output file */
+ if ((status = file_create(netoutfile,handle))) {
+ ffpmsg("Unable to create output file (ftp_file_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ closefile++;
+
+ /* write a file */
+ alarm(NETTIMEOUT);
+ while(0 != (len = fread(recbuf,1,MAXLEN,ftpfile))) {
+ alarm(0);
+ status = file_write(*handle,recbuf,len);
+ if (status) {
+ ffpmsg("Error writing file (ftp_file_open)");
+ ffpmsg(url);
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ alarm(NETTIMEOUT);
+ }
+ file_close(*handle);
+ }
+ fclose(ftpfile);
+ closeftpfile--;
+
+ NET_SendRaw(sock,"QUIT\n",5,NET_DEFAULT);
+ fclose(command);
+ closecommandfile--;
+
+ signal(SIGALRM, SIG_DFL);
+ alarm(0);
+
+ return file_open(netoutfile,rwmode,handle);
+
+ error:
+ alarm(0); /* clear it */
+ if (closeftpfile) {
+ fclose(ftpfile);
+ }
+ if (closecommandfile) {
+ fclose(command);
+ }
+ if (closeoutfile) {
+ fclose(outfile);
+ }
+ if (closefile) {
+ file_close(*handle);
+ }
+
+ signal(SIGALRM, SIG_DFL);
+ return (FILE_NOT_OPENED);
+}
+
+/*--------------------------------------------------------------------------*/
+/* This creates a memory handle with a copy of the URL in filename. The
+ file must be compressed and is copied to disk first */
+
+int ftp_compress_open(char *url, int rwmode, int *handle)
+{
+ FILE *ftpfile;
+ FILE *command;
+ char recbuf[MAXLEN];
+ long len;
+ int ii, flen, status;
+ int sock;
+ char firstchar;
+
+ closeftpfile = 0;
+ closecommandfile = 0;
+ closememfile = 0;
+ closefdiskfile = 0;
+ closediskfile = 0;
+
+ /* don't do r/w files */
+ if (rwmode != 0) {
+ ffpmsg("Compressed files must be r/o");
+ return (FILE_NOT_OPENED);
+ }
+
+ /* Need to know where to write the output file */
+ flen = strlen(netoutfile);
+ if (!flen)
+ {
+ ffpmsg(
+ "Output file not set, shouldn't have happened (ftp_compress_open)");
+ return (FILE_NOT_OPENED);
+ }
+
+ /* do the signal handler bits */
+ if (setjmp(env) != 0) {
+ /* feels like the second time */
+ /* this means something bad happened */
+ ffpmsg("Timeout (http_open)");
+ goto error;
+ }
+
+ signal(SIGALRM, signal_handler);
+
+ /* Open the network connection to url, ftpfile is connected to the file
+ port, command is connected to port 21. sock is for writing to port 21 */
+ alarm(NETTIMEOUT);
+
+ if ((status = ftp_open_network(url,&ftpfile,&command,&sock))) {
+ alarm(0);
+ ffpmsg("Unable to open ftp file (ftp_compress_open)");
+ ffpmsg(url);
+ goto error;
+ }
+ closeftpfile++;
+ closecommandfile++;
+
+ /* Now, what do we do with the file */
+ firstchar = fgetc(ftpfile);
+ ungetc(firstchar,ftpfile);
+
+ if (strstr(url,".gz") ||
+ strstr(url,".Z") ||
+ ('\037' == firstchar)) {
+
+ if (*netoutfile == '!')
+ {
+ /* user wants to clobber file, if it already exists */
+ for (ii = 0; ii < flen; ii++)
+ netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */
+
+ status = file_remove(netoutfile);
+ }
+
+ /* Create the output file */
+ if ((status = file_create(netoutfile,handle))) {
+ ffpmsg("Unable to create output file (ftp_compress_open)");
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ closediskfile++;
+
+ /* write a file */
+ alarm(NETTIMEOUT);
+ while(0 != (len = fread(recbuf,1,MAXLEN,ftpfile))) {
+ alarm(0);
+ status = file_write(*handle,recbuf,len);
+ if (status) {
+ ffpmsg("Error writing file (ftp_compres_open)");
+ ffpmsg(url);
+ ffpmsg(netoutfile);
+ goto error;
+ }
+ alarm(NETTIMEOUT);
+ }
+
+ file_close(*handle);
+ closediskfile--;
+ fclose(ftpfile);
+ closeftpfile--;
+ /* Close down the ftp connection */
+ NET_SendRaw(sock,"QUIT\n",5,NET_DEFAULT);
+ fclose(command);
+ closecommandfile--;
+
+ /* File is on disk, let's uncompress it into memory */
+
+ if (NULL == (diskfile = fopen(netoutfile,"r"))) {
+ ffpmsg("Unable to reopen disk file (ftp_compress_open)");
+ ffpmsg(netoutfile);
+ return (FILE_NOT_OPENED);
+ }
+ closefdiskfile++;
+
+ if ((status = mem_create(url,handle))) {
+ ffpmsg("Unable to create memory file (ftp_compress_open)");
+ ffpmsg(url);
+ goto error;
+ }
+ closememfile++;
+
+ status = 0;
+ status = mem_uncompress2mem(url,diskfile,*handle);
+ fclose(diskfile);
+ closefdiskfile--;
+
+ if (status) {
+ ffpmsg("Error writing compressed memory file (ftp_compress_open)");
+ goto error;
+ }
+
+ } else {
+ /* Opps, this should not have happened */
+ ffpmsg("Can only compressed files here (ftp_compress_open)");
+ goto error;
+ }
+
+
+ signal(SIGALRM, SIG_DFL);
+ alarm(0);
+ return mem_seek(*handle,0);
+
+ error:
+ alarm(0); /* clear it */
+ if (closeftpfile) {
+ fclose(ftpfile);
+ }
+ if (closecommandfile) {
+ fclose(command);
+ }
+ if (closefdiskfile) {
+ fclose(diskfile);
+ }
+ if (closememfile) {
+ mem_close_free(*handle);
+ }
+ if (closediskfile) {
+ file_close(*handle);
+ }
+
+ signal(SIGALRM, SIG_DFL);
+ return (FILE_NOT_OPENED);
+}
+
+/*--------------------------------------------------------------------------*/
+/* Open a ftp connection to filename (really a URL), return ftpfile set to
+ the file connection, and command set to the control connection, with sock
+ also set to the control connection */
+
+int ftp_open_network(char *filename, FILE **ftpfile, FILE **command, int *sock)
+{
+ int status;
+ int sock1;
+ int tmpint;
+ char recbuf[MAXLEN];
+ char errorstr[MAXLEN];
+ char tmpstr[MAXLEN];
+ char proto[SHORTLEN];
+ char host[SHORTLEN];
+ char *newhost;
+ char *username;
+ char *password;
+ char fn[MAXLEN];
+ char *newfn;
+ char *passive;
+ char *tstr;
+ char ip[SHORTLEN];
+ char turl[MAXLEN];
+ int port;
+
+ /* parse the URL */
+ if (strlen(filename) > MAXLEN - 7) {
+ ffpmsg("ftp filename is too long (ftp_open)");
+ return (FILE_NOT_OPENED);
+ }
+
+ strcpy(turl,"ftp://";);
+ strcat(turl,filename);
+ if (NET_ParseUrl(turl,proto,host,&port,fn)) {
+ sprintf(errorstr,"URL Parse Error (ftp_open) %s",filename);
+ ffpmsg(errorstr);
+ return (FILE_NOT_OPENED);
+ }
+#ifdef DEBUG
+ printf ("proto, %s, host, %s, port %d, fn %s\n",proto,host,port,fn);
+#endif
+
+ port = 21;
+ /* we might have a user name */
+ username = "anonymous";
+ password = "user host com";
+ /* is there an @ sign */
+ if (NULL != (newhost = strrchr(host,'@'))) {
+ *newhost = '\0'; /* make it a null, */
+ newhost++; /* Now newhost points to the host name and host points to the
+ user name, password combo */
+ username = host;
+ /* is there a : for a password */
+ if (NULL != strchr(username,':')) {
+ password = strchr(username,':');
+ *password = '\0';
+ password++;
+ }
+ } else {
+ newhost = host;
+ }
+
+#ifdef DEBUG
+ printf("User %s pass %s\n",username,password);
+#endif
+
+ /* Connect to the host on the required port */
+ *sock = NET_TcpConnect(newhost,port);
+ /* convert it to a stdio file */
+ if (NULL == (*command = fdopen(*sock,"r"))) {
+ ffpmsg ("fdopen failed to convert socket to stdio file (ftp_open)");
+ return (FILE_NOT_OPENED);
+
+ }
+
+ /* Wait for the 220 response */
+ if (ftp_status(*command,"220 ")) {
+ ffpmsg ("error connecting to remote server, no 220 seen (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+
+ /* Send the user name and wait for the right response */
+ sprintf(tmpstr,"USER %s\n",username);
+ status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT);
+
+ if (ftp_status(*command,"331 ")) {
+ ffpmsg ("USER error no 331 seen (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+
+ }
+
+ /* Send the password and wait for the right response */
+ sprintf(tmpstr,"PASS %s\n",password);
+ status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT);
+
+ if (ftp_status(*command,"230 ")) {
+ ffpmsg ("PASS error, no 230 seen (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+
+
+ /* now do the cwd command */
+ newfn = strrchr(fn,'/');
+ if (newfn == NULL) {
+ strcpy(tmpstr,"CWD /\n");
+ newfn = fn;
+ } else {
+ *newfn = '\0';
+ newfn++;
+ if (strlen(fn) == 0) {
+ strcpy(tmpstr,"CWD /\n");
+ } else {
+ /* remove the leading slash */
+ if (fn[0] == '/') {
+ sprintf(tmpstr,"CWD %s\n",&fn[1]);
+ } else {
+ sprintf(tmpstr,"CWD %s\n",fn);
+ }
+ }
+ }
+
+#ifdef DEBUG
+ printf("CWD command is %s\n",tmpstr);
+#endif
+ status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT);
+
+ if (ftp_status(*command,"250 ")) {
+ ffpmsg ("CWD error, no 250 seen (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+
+ if (!strlen(newfn)) {
+ ffpmsg("Null file name (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+
+
+ /* Always use binary mode */
+ sprintf(tmpstr,"TYPE I\n");
+ status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT);
+
+ if (ftp_status(*command,"200 ")) {
+ ffpmsg ("TYPE I error, 200 not seen (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+
+ status = NET_SendRaw(*sock,"PASV\n",5,NET_DEFAULT);
+ if (!(fgets(recbuf,MAXLEN,*command))) {
+ ffpmsg ("PASV error (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+
+ /* Passive mode response looks like
+ 227 Entering Passive Mode (129,194,67,8,210,80) */
+ if (recbuf[0] == '2' && recbuf[1] == '2' && recbuf[2] == '7') {
+ /* got a good passive mode response, find the opening ( */
+
+ if (!(passive = strchr(recbuf,'('))) {
+ ffpmsg ("PASV error (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+
+ *passive = '\0';
+ passive++;
+ ip[0] = '\0';
+
+ /* Messy parsing of response from PASV *command */
+
+ if (!(tstr = strtok(passive,",)"))) {
+ ffpmsg ("PASV error (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+ strcpy(ip,tstr);
+ strcat(ip,".");
+
+ if (!(tstr = strtok(NULL,",)"))) {
+ ffpmsg ("PASV error (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+ strcat(ip,tstr);
+ strcat(ip,".");
+
+ if (!(tstr = strtok(NULL,",)"))) {
+ ffpmsg ("PASV error (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+ strcat(ip,tstr);
+ strcat(ip,".");
+
+ if (!(tstr = strtok(NULL,",)"))) {
+ ffpmsg ("PASV error (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+ strcat(ip,tstr);
+
+ /* Done the ip number, now do the port # */
+ if (!(tstr = strtok(NULL,",)"))) {
+ ffpmsg ("PASV error (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+ sscanf(tstr,"%d",&port);
+ port *= 256;
+
+ if (!(tstr = strtok(NULL,",)"))) {
+ ffpmsg ("PASV error (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+ sscanf(tstr,"%d",&tmpint);
+ port += tmpint;
+
+
+ if (!strlen(newfn)) {
+ ffpmsg("Null file name (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+
+
+#ifdef DEBUG
+ puts("connection to passive port");
+#endif
+ /* COnnect to the data port */
+ sock1 = NET_TcpConnect(ip,port);
+ if (NULL == (*ftpfile = fdopen(sock1,"r"))) {
+ ffpmsg ("Could not connect to passive port (ftp_open)");
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+ }
+
+ /* now we return */
+
+ /* Send the retrieve command */
+ sprintf(tmpstr,"RETR %s\n",newfn);
+ status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT);
+
+#ifdef DEBUG
+ puts("Sent RETR command");
+#endif
+ if (ftp_status(*command,"150 ")) {
+ /* ffpmsg ("RETR error, most likely file is not there (ftp_open)"); */
+ fclose(*command);
+#ifdef DEBUG
+ puts("File not there");
+#endif
+ return (FILE_NOT_OPENED);
+ }
+ return 0;
+ }
+
+ /* no passive mode */
+
+ NET_SendRaw(*sock,"QUIT\n",5,NET_DEFAULT);
+ fclose(*command);
+ return (FILE_NOT_OPENED);
+}
+
+/*--------------------------------------------------------------------------*/
+/* return a socket which results from connection to hostname on port port */
+static int NET_TcpConnect(char *hostname, int port)
+{
+ /* Connect to hostname on port */
+
+ struct sockaddr_in sockaddr;
+ int sock;
+ int stat;
+ int val = 1;
+
+ CreateSocketAddress(&sockaddr,hostname,port);
+ /* Create socket */
+ if ((sock = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
+ ffpmsg("Can't create socket");
+ return CONNECTION_ERROR;
+ }
+
+ if ((stat = connect(sock, (struct sockaddr*) &sockaddr,
+ sizeof(sockaddr)))
+ < 0) {
+ close(sock);
+/*
+ perror("NET_Tcpconnect - Connection error");
+ ffpmsg("Can't connect to host, connection error");
+*/
+ return CONNECTION_ERROR;
+ }
+ setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&val, sizeof(val));
+ setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE, (char *)&val, sizeof(val));
+
+ val = 65536;
+ setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&val, sizeof(val));
+ setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&val, sizeof(val));
+ return sock;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Write len bytes from buffer to socket sock */
+static int NET_SendRaw(int sock, const void *buffer, int length, int opt)
+{
+
+ char * buf = (char *) buffer;
+
+ int flag;
+ int n, nsent = 0;
+
+ switch (opt) {
+ case NET_DEFAULT:
+ flag = 0;
+ break;
+ case NET_OOB:
+ flag = MSG_OOB;
+ break;
+ case NET_PEEK:
+ default:
+ flag = 0;
+ break;
+ }
+
+ if (sock < 0) return -1;
+
+ for (n = 0; n < length; n += nsent) {
+ if ((nsent = send(sock, buf+n, length-n, flag)) <= 0) {
+ return nsent;
+ }
+#ifdef DEBUG
+ printf ("send raw, sent %d bytes\n",nsent);
+#endif
+ }
+#ifdef DEBUG
+ printf ("send raw end, sent %d bytes\n",n);
+#endif
+ return n;
+}
+
+/*--------------------------------------------------------------------------*/
+
+static int NET_RecvRaw(int sock, void *buffer, int length)
+{
+ /* Receive exactly length bytes into buffer. Returns number of bytes */
+ /* received. Returns -1 in case of error. */
+
+
+ int nrecv, n;
+ char *buf = (char *)buffer;
+
+ if (sock < 0) return -1;
+ for (n = 0; n < length; n += nrecv) {
+ while ((nrecv = recv(sock, buf+n, length-n, 0)) == -1 && errno == EINTR)
+ errno = 0; /* probably a SIGCLD that was caught */
+ if (nrecv < 0)
+ return nrecv;
+ else if (nrecv == 0)
+ break; /*/ EOF */
+ }
+
+ return n;
+}
+
+/*--------------------------------------------------------------------------*/
+/* Yet Another URL Parser
+ url - input url
+ proto - input protocol
+ host - output host
+ port - output port
+ fn - output filename
+*/
+
+static int NET_ParseUrl(const char *url, char *proto, char *host, int *port,
+ char *fn)
+{
+ /* parses urls into their bits */
+ /* returns 1 if error, else 0 */
+
+ char *urlcopy, *urlcopyorig;
+ char *ptrstr;
+ char *thost;
+ int isftp = 0;
+
+ /* figure out if there is a http: or ftp: */
+
+ urlcopyorig = urlcopy = (char *) malloc(strlen(url)+1);
+ strcpy(urlcopy,url);
+
+ /* set some defaults */
+ *port = 80;
+ strcpy(proto,"http:");
+ strcpy(host,"localhost");
+ strcpy(fn,"/");
+
+ ptrstr = strstr(urlcopy,"http:");
+ if (ptrstr == NULL) {
+ /* Nope, not http: */
+ ptrstr = strstr(urlcopy,"root:");
+ if (ptrstr == NULL) {
+ /* Nope, not root either */
+ ptrstr = strstr(urlcopy,"ftp:");
+ if (ptrstr != NULL) {
+ if (ptrstr == urlcopy) {
+ strcpy(proto,"ftp:");
+ *port = 21;
+ isftp++;
+ urlcopy += 4; /* move past ftp: */
+ } else {
+ /* not at the beginning, bad url */
+ free(urlcopyorig);
+ return 1;
+ }
+ }
+ } else {
+ if (ptrstr == urlcopy) {
+ urlcopy += 5; /* move past root: */
+ } else {
+ /* not at the beginning, bad url */
+ free(urlcopyorig);
+ return 1;
+ }
+ }
+ } else {
+ if (ptrstr == urlcopy) {
+ urlcopy += 5; /* move past http: */
+ } else {
+ free(urlcopyorig);
+ return 1;
+ }
+ }
+
+ /* got the protocol */
+ /* get the hostname */
+ if (urlcopy[0] == '/' && urlcopy[1] == '/') {
+ /* we have a hostname */
+ urlcopy += 2; /* move past the // */
+ }
+ /* do this only if http */
+ if (!strcmp(proto,"http:")) {
+
+ /* Move past any user:password */
+ if ((thost = strchr(urlcopy, '@')) != NULL)
+ urlcopy = thost+1;
+
+ strcpy(host,urlcopy);
+ thost = host;
+ while (*urlcopy != '/' && *urlcopy != ':' && *urlcopy) {
+ thost++;
+ urlcopy++;
+ }
+ /* we should either be at the end of the string, have a /, or have a : */
+ *thost = '\0';
+ if (*urlcopy == ':') {
+ /* follows a port number */
+ urlcopy++;
+ sscanf(urlcopy,"%d",port);
+ while (*urlcopy != '/' && *urlcopy) urlcopy++; /* step to the */
+ }
+ } else {
+ /* do this for ftp */
+ strcpy(host,urlcopy);
+ thost = host;
+ while (*urlcopy != '/' && *urlcopy) {
+ thost++;
+ urlcopy++;
+ }
+ *thost = '\0';
+ /* Now, we should either be at the end of the string, or have a / */
+
+ }
+ /* Now the rest is a fn */
+
+ if (*urlcopy) {
+ strcpy(fn,urlcopy);
+ }
+ free(urlcopyorig);
+ return 0;
+}
+
+/*--------------------------------------------------------------------------*/
+
+/* Small helper functions to set the netoutfile static string */
+/* Called by cfileio after parsing the output file off of the input file url */
+
+int http_checkfile (char *urltype, char *infile, char *outfile1)
+{
+ char newinfile[MAXLEN];
+ FILE *httpfile;
+ char contentencoding[MAXLEN];
+ int contentlength;
+
+ /* default to http:// if there is no output file */
+
+ strcpy(urltype,"http://";);
+
+ if (strlen(outfile1)) {
+ /* there is an output file */
+
+ /* don't copy the "file://" prefix, if present. */
+ if (!strncmp(outfile1, "file://", 7) )
+ strcpy(netoutfile,outfile1+7);
+ else
+ strcpy(netoutfile,outfile1);
+
+ if (!strncmp(outfile1, "mem:", 4) ) {
+ /* copy the file to memory, with READ and WRITE access
+ In this case, it makes no difference whether the http file
+ and or the output file are compressed or not. */
+
+ strcpy(urltype, "httpmem://"); /* use special driver */
+ return 0;
+ }
+
+ if (strstr(infile, "?")) {
+ /* file name contains a '?' so probably a cgi string; don't open it */
+ strcpy(urltype,"httpfile://");
+ return 0;
+ }
+
+ if (!http_open_network(infile,&httpfile,contentencoding,&contentlength)) {
+ fclose(httpfile);
+ /* It's there, we're happy */
+ if (strstr(infile,".gz") || (strstr(infile,".Z"))) {
+ /* It's compressed */
+ if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) {
+ strcpy(urltype,"httpcompress://");
+ } else {
+ strcpy(urltype,"httpfile://");
+ }
+ } else {
+ strcpy(urltype,"httpfile://");
+ }
+ return 0;
+ }
+
+ /* Ok, let's try the .gz one */
+ strcpy(newinfile,infile);
+ strcat(newinfile,".gz");
+ if (!http_open_network(newinfile,&httpfile,contentencoding,
+ &contentlength)) {
+ fclose(httpfile);
+ strcpy(infile,newinfile);
+ /* It's there, we're happy, and, it's compressed */
+ /* It's compressed */
+ if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) {
+ strcpy(urltype,"httpcompress://");
+ } else {
+ strcpy(urltype,"httpfile://");
+ }
+ return 0;
+ }
+
+ /* Ok, let's try the .Z one */
+ strcpy(newinfile,infile);
+ strcat(newinfile,".Z");
+ if (!http_open_network(newinfile,&httpfile,contentencoding,
+ &contentlength)) {
+ fclose(httpfile);
+ strcpy(infile,newinfile);
+ /* It's there, we're happy, and, it's compressed */
+ if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) {
+ strcpy(urltype,"httpcompress://");
+ } else {
+ strcpy(urltype,"httpfile://");
+ }
+ return 0;
+ }
+
+ }
+ return 0;
+}
+/*--------------------------------------------------------------------------*/
+int ftp_checkfile (char *urltype, char *infile, char *outfile1)
+{
+ char newinfile[MAXLEN];
+ FILE *ftpfile;
+ FILE *command;
+ int sock;
+
+
+ /* default to ftp:// */
+
+ strcpy(urltype,"ftp://";);
+
+ if (strlen(outfile1)) {
+ /* there is an output file */
+
+ /* don't copy the "file://" prefix, if present. */
+ if (!strncmp(outfile1, "file://", 7) )
+ strcpy(netoutfile,outfile1+7);
+ else
+ strcpy(netoutfile,outfile1);
+
+ if (!strncmp(outfile1, "mem:", 4) ) {
+ /* copy the file to memory, with READ and WRITE access
+ In this case, it makes no difference whether the ftp file
+ and or the output file are compressed or not. */
+
+ strcpy(urltype, "ftpmem://"); /* use special driver */
+ return 0;
+ }
+
+ if (!ftp_open_network(infile,&ftpfile,&command,&sock)) {
+ fclose(ftpfile);
+ fclose(command);
+ /* It's there, we're happy */
+ if (strstr(infile,".gz") || (strstr(infile,".Z"))) {
+ /* It's compressed */
+ if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) {
+ strcpy(urltype,"ftpcompress://");
+ } else {
+ strcpy(urltype,"ftpfile://");
+ }
+ } else {
+ strcpy(urltype,"ftpfile://");
+ }
+ return 0;
+ }
+
+ /* Ok, let's try the .gz one */
+ strcpy(newinfile,infile);
+ strcat(newinfile,".gz");
+ if (!ftp_open_network(newinfile,&ftpfile,&command,&sock)) {
+ fclose(ftpfile);
+ fclose(command);
+ strcpy(infile,newinfile);
+ /* It's there, we're happy, and, it's compressed */
+ if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) {
+ strcpy(urltype,"ftpcompress://");
+ } else {
+ strcpy(urltype,"ftpfile://");
+ }
+ return 0;
+ }
+
+ /* Ok, let's try the .Z one */
+ strcpy(newinfile,infile);
+ strcat(newinfile,".Z");
+ if (!ftp_open_network(newinfile,&ftpfile,&command,&sock)) {
+ fclose(ftpfile);
+ fclose(command);
+ strcpy(infile,newinfile);
+ if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) {
+ strcpy(urltype,"ftpcompress://");
+ } else {
+ strcpy(urltype,"ftpfile://");
+ }
+ return 0;
+ }
+
+ }
+ return 0;
+}
+/*--------------------------------------------------------------------------*/
+/* A small helper function to wait for a particular status on the ftp
+ connectino */
+static int ftp_status(FILE *ftp, char *statusstr)
+{
+ /* read through until we find a string beginning with statusstr */
+ /* This needs a timeout */
+
+ char recbuf[MAXLEN];
+ int len;
+
+ len = strlen(statusstr);
+ while (1) {
+ if (!(fgets(recbuf,MAXLEN,ftp))) {
+#ifdef DEBUG
+ puts("error reading response in ftp_status");
+#endif
+ return 1; /* error reading */
+ }
+
+#ifdef DEBUG
+ printf("ftp_status, return string was %s\n",recbuf);
+#endif
+
+ recbuf[len] = '\0'; /* make it short */
+ if (!strcmp(recbuf,statusstr)) {
+ return 0; /* we're ok */
+ }
+ if (recbuf[0] > '3') {
+ /* oh well, some sort of error */
+ return 1;
+ }
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateSocketAddress --
+ *
+ * This function initializes a sockaddr structure for a host and port.
+ *
+ * Results:
+ * 1 if the host was valid, 0 if the host could not be converted to
+ * an IP address.
+ *
+ * Side effects:
+ * Fills in the *sockaddrPtr structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateSocketAddress(
+ struct sockaddr_in *sockaddrPtr, /* Socket address */
+ char *host, /* Host. NULL implies INADDR_ANY */
+ int port) /* Port number */
+{
+ struct hostent *hostent; /* Host database entry */
+ struct in_addr addr; /* For 64/32 bit madness */
+ char localhost[MAXLEN];
+
+ strcpy(localhost,host);
+
+ memset((void *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
+ sockaddrPtr->sin_family = AF_INET;
+ sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
+ if (host == NULL) {
+ addr.s_addr = INADDR_ANY;
+ } else {
+ addr.s_addr = inet_addr(localhost);
+ if (addr.s_addr == 0xFFFFFFFF) {
+ hostent = gethostbyname(localhost);
+ if (hostent != NULL) {
+ memcpy((void *) &addr,
+ (void *) hostent->h_addr_list[0],
+ (size_t) hostent->h_length);
+ } else {
+#ifdef EHOSTUNREACH
+ errno = EHOSTUNREACH;
+#else
+#ifdef ENXIO
+ errno = ENXIO;
+#endif
+#endif
+ return 0; /* error */
+ }
+ }
+ }
+
+ /*
+ * NOTE: On 64 bit machines the assignment below is rumored to not
+ * do the right thing. Please report errors related to this if you
+ * observe incorrect behavior on 64 bit machines such as DEC Alphas.
+ * Should we modify this code to do an explicit memcpy?
+ */
+
+ sockaddrPtr->sin_addr.s_addr = addr.s_addr;
+ return 1; /* Success. */
+}
+
+/* Signal handler for timeouts */
+
+static void signal_handler(int sig) {
+
+ switch (sig) {
+ case SIGALRM: /* process for alarm */
+ longjmp(env,sig);
+
+ default: {
+ /* Hmm, shouldn't have happend */
+ exit(sig);
+ }
+ }
+}
+
+/**************************************************************/
+
+/* Root driver */
+
+/*--------------------------------------------------------------------------*/
+int root_init(void)
+{
+ int ii;
+
+ for (ii = 0; ii < NMAXFILES; ii++) /* initialize all empty slots in table */
+ {
+ handleTable[ii].sock = 0;
+ handleTable[ii].currentpos = 0;
+ }
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_setoptions(int options)
+{
+ /* do something with the options argument, to stop compiler warning */
+ options = 0;
+ return(options);
+}
+/*--------------------------------------------------------------------------*/
+int root_getoptions(int *options)
+{
+ *options = 0;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_getversion(int *version)
+{
+ *version = 10;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_shutdown(void)
+{
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_open(char *url, int rwmode, int *handle)
+{
+ int ii, status;
+ int sock;
+
+ *handle = -1;
+ for (ii = 0; ii < NMAXFILES; ii++) /* find empty slot in table */
+ {
+ if (handleTable[ii].sock == 0)
+ {
+ *handle = ii;
+ break;
+ }
+ }
+
+ if (*handle == -1)
+ return(TOO_MANY_FILES); /* too many files opened */
+
+ /*open the file */
+ if (rwmode) {
+ status = root_openfile(url, "update", &sock);
+ } else {
+ status = root_openfile(url, "read", &sock);
+ }
+ if (status)
+ return(status);
+
+ handleTable[ii].sock = sock;
+ handleTable[ii].currentpos = 0;
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_create(char *filename, int *handle)
+{
+ int ii, status;
+ int sock;
+
+ *handle = -1;
+ for (ii = 0; ii < NMAXFILES; ii++) /* find empty slot in table */
+ {
+ if (handleTable[ii].sock == 0)
+ {
+ *handle = ii;
+ break;
+ }
+ }
+
+ if (*handle == -1)
+ return(TOO_MANY_FILES); /* too many files opened */
+
+ /*open the file */
+ status = root_openfile(filename, "create", &sock);
+
+ if (status) {
+ ffpmsg("Unable to create file");
+ return(status);
+ }
+
+ handleTable[ii].sock = sock;
+ handleTable[ii].currentpos = 0;
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_size(int handle, LONGLONG *filesize)
+/*
+ return the size of the file in bytes
+*/
+{
+
+ int sock;
+ int offset;
+ int status;
+ int op;
+
+ sock = handleTable[handle].sock;
+
+ status = root_send_buffer(sock,ROOTD_STAT,NULL,0);
+ status = root_recv_buffer(sock,&op,(char *)&offset, 4);
+ *filesize = (LONGLONG) ntohl(offset);
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_close(int handle)
+/*
+ close the file
+*/
+{
+
+ int status;
+ int sock;
+
+ sock = handleTable[handle].sock;
+ status = root_send_buffer(sock,ROOTD_CLOSE,NULL,0);
+ close(sock);
+ handleTable[handle].sock = 0;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_flush(int handle)
+/*
+ flush the file
+*/
+{
+ int status;
+ int sock;
+
+ sock = handleTable[handle].sock;
+ status = root_send_buffer(sock,ROOTD_FLUSH,NULL,0);
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_seek(int handle, LONGLONG offset)
+/*
+ seek to position relative to start of the file
+*/
+{
+ handleTable[handle].currentpos = offset;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_read(int hdl, void *buffer, long nbytes)
+/*
+ read bytes from the current position in the file
+*/
+{
+ char msg[SHORTLEN];
+ int op;
+ int status;
+ int astat;
+
+ /* we presume here that the file position will never be > 2**31 = 2.1GB */
+ sprintf(msg,"%ld %ld ",(long) handleTable[hdl].currentpos,nbytes);
+ status = root_send_buffer(handleTable[hdl].sock,ROOTD_GET,msg,strlen(msg));
+ if ((unsigned) status != strlen(msg)) {
+ return (READ_ERROR);
+ }
+ astat = 0;
+ status = root_recv_buffer(handleTable[hdl].sock,&op,(char *) &astat,4);
+ if (astat != 0) {
+ return (READ_ERROR);
+ }
+#ifdef DEBUG
+ printf("root_read, op %d astat %d\n",op,astat);
+#endif
+ status = NET_RecvRaw(handleTable[hdl].sock,buffer,nbytes);
+ if (status != nbytes) {
+ return (READ_ERROR);
+ }
+ handleTable[hdl].currentpos += nbytes;
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int root_write(int hdl, void *buffer, long nbytes)
+/*
+ write bytes at the current position in the file
+*/
+{
+
+ char msg[SHORTLEN];
+ int len;
+ int sock;
+ int status;
+ int astat;
+ int op;
+
+ sock = handleTable[hdl].sock;
+ /* we presume here that the file position will never be > 2**31 = 2.1GB */
+ sprintf(msg,"%ld %ld ",(long) handleTable[hdl].currentpos,nbytes);
+
+ len = strlen(msg);
+ status = root_send_buffer(sock,ROOTD_PUT,msg,len+1);
+ if (status != len+1) {
+ return (WRITE_ERROR);
+ }
+ status = NET_SendRaw(sock,buffer,nbytes,NET_DEFAULT);
+ if (status != nbytes) {
+ return (WRITE_ERROR);
+ }
+ astat = 0;
+ status = root_recv_buffer(handleTable[hdl].sock,&op,(char *) &astat,4);
+#ifdef DEBUG
+ printf("root_read, op %d astat %d\n",op,astat);
+#endif
+ if (astat != 0) {
+ return (WRITE_ERROR);
+ }
+ handleTable[hdl].currentpos += nbytes;
+ return(0);
+}
+
+/*--------------------------------------------------------------------------*/
+int root_openfile(char *url, char *rwmode, int *sock)
+ /*
+ lowest level routine to physically open a root file
+ */
+{
+
+ int status;
+ char recbuf[MAXLEN];
+ char errorstr[MAXLEN];
+ char proto[SHORTLEN];
+ char host[SHORTLEN];
+ char fn[MAXLEN];
+ char turl[MAXLEN];
+ int port;
+ int op;
+ int ii;
+ int authstat;
+
+
+ /* Parse the URL apart again */
+ strcpy(turl,"root://");
+ strcat(turl,url);
+ if (NET_ParseUrl(turl,proto,host,&port,fn)) {
+ sprintf(errorstr,"URL Parse Error (root_open) %s",url);
+ ffpmsg(errorstr);
+ return (FILE_NOT_OPENED);
+ }
+
+#ifdef DEBUG
+ printf("Connecting to %s on port %d\n",host,port);
+#endif
+ /* Connect to the remote host */
+ *sock = NET_TcpConnect(host,port);
+ if (*sock < 0) {
+ ffpmsg("Couldn't connect to host (http_open_network)");
+ return (FILE_NOT_OPENED);
+ }
+
+ /* get the username */
+ if (NULL != getenv("ROOTUSERNAME")) {
+ strcpy(recbuf,getenv("ROOTUSERNAME"));
+ } else {
+ printf("Username: ");
+ fgets(recbuf,MAXLEN,stdin);
+ recbuf[strlen(recbuf)-1] = '\0';
+ }
+
+ status = root_send_buffer(*sock, ROOTD_USER, recbuf,strlen(recbuf));
+ if (status < 0) {
+ ffpmsg("error talking to remote system on username ");
+ return (FILE_NOT_OPENED);
+ }
+
+ status = root_recv_buffer(*sock,&op,(char *)&authstat,4);
+ if (!status) {
+ ffpmsg("error talking to remote system on username");
+ return (FILE_NOT_OPENED);
+ }
+
+#ifdef DEBUG
+ printf("op is %d and authstat is %d\n",op,authstat);
+#endif
+
+ if (op != ROOTD_AUTH) {
+ ffpmsg("ERROR on ROOTD_USER");
+ ffpmsg(recbuf);
+ return (FILE_NOT_OPENED);
+ }
+
+
+ /* now the password */
+ if (NULL != getenv("ROOTPASSWORD")) {
+ strcpy(recbuf,getenv("ROOTPASSWORD"));
+ } else {
+ printf("Password: ");
+ fgets(recbuf,MAXLEN,stdin);
+ recbuf[strlen(recbuf)-1] = '\0';
+ }
+ /* ones complement the password */
+ for (ii=0;(unsigned) ii<strlen(recbuf);ii++) {
+ recbuf[ii] = ~recbuf[ii];
+ }
+
+ status = root_send_buffer(*sock, ROOTD_PASS, recbuf, strlen(recbuf));
+ if (status < 0) {
+ ffpmsg("error talking to remote system sending password");
+ return (FILE_NOT_OPENED);
+ }
+
+ status = root_recv_buffer(*sock,&op,(char *)&authstat,4);
+ if (status < 0) {
+ ffpmsg("error talking to remote system acking password");
+ return (FILE_NOT_OPENED);
+ }
+
+#ifdef DEBUG
+ printf("op is %d and authstat is %d\n",op,authstat);
+#endif
+ if (op != ROOTD_AUTH) {
+ ffpmsg("ERROR on ROOTD_PASS");
+ ffpmsg(recbuf);
+ return (FILE_NOT_OPENED);
+ }
+
+ /* now the file open request */
+ strcpy(recbuf,fn);
+ strcat(recbuf," ");
+ strcat(recbuf,rwmode);
+
+ status = root_send_buffer(*sock, ROOTD_OPEN, recbuf, strlen(recbuf));
+ if (status < 0) {
+ ffpmsg("error talking to remote system on open ");
+ return (FILE_NOT_OPENED);
+ }
+
+ status = root_recv_buffer(*sock,&op,(char *)&authstat,4);
+ if (status < 0) {
+ ffpmsg("error talking to remote system on open");
+ return (FILE_NOT_OPENED);
+ }
+
+#ifdef DEBUG
+ printf("op is %d and recbuf is %d\n",op,authstat);
+#endif
+
+ if ((op != ROOTD_OPEN) && (authstat != 0)) {
+ ffpmsg("ERROR on ROOTD_OPEN");
+ ffpmsg(recbuf);
+ return (FILE_NOT_OPENED);
+ }
+
+ return 0;
+
+}
+
+static int root_send_buffer(int sock, int op, char *buffer, int buflen)
+{
+ /* send a buffer, the form is
+ <len>
+ <op>
+ <buffer>
+
+ <len> includes the 4 bytes for the op, the length bytes (4) are implicit
+
+
+ if buffer is null don't send it, not everything needs something sent */
+
+ int len;
+ int status;
+
+ int hdr[2];
+
+ len = 4;
+
+ if (buffer != NULL) {
+ len += buflen;
+ }
+
+ hdr[0] = htonl(len);
+
+#ifdef DEBUG
+ printf("len sent is %x\n",hdr[0]);
+#endif
+
+ hdr[1] = htonl(op);
+#ifdef DEBUG
+ printf("op sent is %x\n",hdr[1]);
+#endif
+
+
+#ifdef DEBUG
+ printf("Sending op %d and length of %d\n",op,len);
+#endif
+
+ status = NET_SendRaw(sock,hdr,sizeof(hdr),NET_DEFAULT);
+ if (status < 0) {
+ return status;
+ }
+ if (buffer != NULL) {
+ status = NET_SendRaw(sock,buffer,buflen,NET_DEFAULT);
+ }
+ return status;
+}
+
+static int root_recv_buffer(int sock, int *op, char *buffer, int buflen)
+{
+ /* recv a buffer, the form is
+ <len>
+ <op>
+ <buffer>
+
+ */
+
+ int recv1 = 0;
+ int len;
+ int status;
+ char recbuf[MAXLEN];
+
+ status = NET_RecvRaw(sock,&len,4);
+#ifdef DEBUG
+ printf("Recv: status from rec is %d\n",status);
+#endif
+ if (status < 0) {
+ return status;
+ }
+ recv1 += status;
+
+ len = ntohl(len);
+#ifdef DEBUG
+ printf ("Recv: length is %d\n",len);
+#endif
+
+ /* ok, have the length, recive the operation */
+ len -= 4;
+ status = NET_RecvRaw(sock,op,4);
+ if (status < 0) {
+ return status;
+ }
+
+ recv1 += status;
+
+ *op = ntohl(*op);
+#ifdef DEBUG
+ printf ("Recv: Operation is %d\n",*op);
+#endif
+
+ if (len > MAXLEN) {
+ len = MAXLEN;
+ }
+
+ if (len > 0) { /* Get the rest of the message */
+ status = NET_RecvRaw(sock,recbuf,len);
+ if (len > buflen) {
+ len = buflen;
+ }
+ memcpy(buffer,recbuf,len);
+ if (status < 0) {
+ return status;
+ }
+ }
+
+ recv1 += status;
+ return recv1;
+
+}
+
+/*****************************************************************************/
+/*
+ Encode a string into MIME Base64 format string
+*/
+
+
+static int encode64(unsigned s_len, char *src, unsigned d_len, char *dst) {
+
+ static char base64[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+"abcdefghijklmnopqrstuvwxyz"
+"0123456789"
+"+/";
+
+ unsigned triad;
+
+
+ for (triad = 0; triad < s_len; triad += 3) {
+ unsigned long int sr;
+ unsigned byte;
+
+ for (byte = 0; (byte<3) && (triad+byte<s_len); ++byte) {
+ sr <<= 8;
+ sr |= (*(src+triad+byte) & 0xff);
+ }
+
+ /* shift left to next 6 bit alignment*/
+ sr <<= (6-((8*byte)%6))%6;
+
+ if (d_len < 4)
+ return 1;
+
+ *(dst+0) = *(dst+1) = *(dst+2) = *(dst+3) = '=';
+ switch(byte) {
+ case 3:
+ *(dst+3) = base64[sr&0x3f];
+ sr >>= 6;
+ case 2:
+ *(dst+2) = base64[sr&0x3f];
+ sr >>= 6;
+ case 1:
+ *(dst+1) = base64[sr&0x3f];
+ sr >>= 6;
+ *(dst+0) = base64[sr&0x3f];
+ }
+ dst += 4;
+ d_len -= 4;
+ }
+
+ *dst = '\0';
+ return 0;
+}
+
+
+#endif
diff --git a/src/plugins/cfitsio/drvrsmem.c b/src/plugins/cfitsio/drvrsmem.c
new file mode 100644
index 0000000..c5fda75
--- /dev/null
+++ b/src/plugins/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
diff --git a/src/plugins/cfitsio/drvrsmem.h b/src/plugins/cfitsio/drvrsmem.h
new file mode 100644
index 0000000..52ac7d7
--- /dev/null
+++ b/src/plugins/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
diff --git a/src/plugins/cfitsio/editcol.c b/src/plugins/cfitsio/editcol.c
new file mode 100644
index 0000000..dc82f02
--- /dev/null
+++ b/src/plugins/cfitsio/editcol.c
@@ -0,0 +1,2474 @@
+/* This file, editcol.c, contains the set of FITSIO routines that */
+/* insert or delete rows or columns in a table or resize an image */
+
+/* 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 <ctype.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+/*--------------------------------------------------------------------------*/
+int ffrsim(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 */
+/*
+ resize an existing primary array or IMAGE extension.
+*/
+{
+ LONGLONG tnaxes[99];
+ int ii;
+
+ if (*status > 0)
+ return(*status);
+
+ for (ii = 0; (ii < naxis) && (ii < 99); ii++)
+ tnaxes[ii] = naxes[ii];
+
+ ffrsimll(fptr, bitpix, naxis, tnaxes, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffrsimll(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 */
+/*
+ resize an existing primary array or IMAGE extension.
+*/
+{
+ int ii, simple, obitpix, onaxis, extend, nmodify;
+ long nblocks, longval;
+ long pcount, gcount, longbitpix;
+ LONGLONG onaxes[99], newsize, oldsize;
+ char comment[FLEN_COMMENT], keyname[FLEN_KEYWORD], message[FLEN_ERRMSG];
+
+ if (*status > 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);
+
+ /* get current image size parameters */
+ if (ffghprll(fptr, 99, &simple, &obitpix, &onaxis, onaxes, &pcount,
+ &gcount, &extend, status) > 0)
+ return(*status);
+
+ longbitpix = bitpix;
+
+ /* test for the 2 special cases that represent unsigned integers */
+ if (longbitpix == USHORT_IMG)
+ longbitpix = SHORT_IMG;
+ else if (longbitpix == ULONG_IMG)
+ longbitpix = LONG_IMG;
+
+ /* test that the new values are legal */
+
+ if (longbitpix != BYTE_IMG && longbitpix != SHORT_IMG &&
+ longbitpix != LONG_IMG && longbitpix != LONGLONG_IMG &&
+ longbitpix != FLOAT_IMG && longbitpix != DOUBLE_IMG)
+ {
+ sprintf(message,
+ "Illegal value for BITPIX keyword: %d", bitpix);
+ ffpmsg(message);
+ return(*status = BAD_BITPIX);
+ }
+
+ if (naxis < 0 || naxis > 999)
+ {
+ sprintf(message,
+ "Illegal value for NAXIS keyword: %d", naxis);
+ ffpmsg(message);
+ return(*status = BAD_NAXIS);
+ }
+
+ if (naxis == 0)
+ newsize = 0;
+ else
+ newsize = 1;
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (naxes[ii] < 0)
+ {
+ sprintf(message,
+ "Illegal value for NAXIS%d keyword: %.0f", ii + 1, (double) (naxes[ii]));
+ ffpmsg(message);
+ return(*status = BAD_NAXES);
+ }
+
+ newsize *= naxes[ii]; /* compute new image size, in pixels */
+ }
+
+ /* compute size of old image, in bytes */
+
+ if (onaxis == 0)
+ oldsize = 0;
+ else
+ {
+ oldsize = 1;
+ for (ii = 0; ii < onaxis; ii++)
+ oldsize *= onaxes[ii];
+ oldsize = (oldsize + pcount) * gcount * (abs(obitpix) / 8);
+ }
+
+ oldsize = (oldsize + 2879) / 2880; /* old size, in blocks */
+
+ newsize = (newsize + pcount) * gcount * (abs(longbitpix) / 8);
+ newsize = (newsize + 2879) / 2880; /* new size, in blocks */
+
+ if (newsize > oldsize) /* have to insert new blocks for image */
+ {
+ nblocks = (long) (newsize - oldsize);
+ if (ffiblk(fptr, nblocks, 1, status) > 0)
+ return(*status);
+ }
+ else if (oldsize > newsize) /* have to delete blocks from image */
+ {
+ nblocks = (long) (oldsize - newsize);
+ if (ffdblk(fptr, nblocks, status) > 0)
+ return(*status);
+ }
+
+ /* now update the header keywords */
+
+ strcpy(comment,"&"); /* special value to leave comments unchanged */
+
+ if (longbitpix != obitpix)
+ { /* update BITPIX value */
+ ffmkyj(fptr, "BITPIX", longbitpix, comment, status);
+ }
+
+ if (naxis != onaxis)
+ { /* update NAXIS value */
+ longval = naxis;
+ ffmkyj(fptr, "NAXIS", longval, comment, status);
+ }
+
+ /* modify the existing NAXISn keywords */
+ nmodify = minvalue(naxis, onaxis);
+ for (ii = 0; ii < nmodify; ii++)
+ {
+ ffkeyn("NAXIS", ii+1, keyname, status);
+ ffmkyj(fptr, keyname, naxes[ii], comment, status);
+ }
+
+ if (naxis > onaxis) /* insert additional NAXISn keywords */
+ {
+ strcpy(comment,"length of data axis");
+ for (ii = onaxis; ii < naxis; ii++)
+ {
+ ffkeyn("NAXIS", ii+1, keyname, status);
+ ffikyj(fptr, keyname, naxes[ii], comment, status);
+ }
+ }
+ else if (onaxis > naxis) /* delete old NAXISn keywords */
+ {
+ for (ii = naxis; ii < onaxis; ii++)
+ {
+ ffkeyn("NAXIS", ii+1, keyname, status);
+ ffdkey(fptr, keyname, status);
+ }
+ }
+
+ /* Update the BSCALE and BZERO keywords, if an unsigned integer image */
+ if (bitpix == USHORT_IMG)
+ {
+ strcpy(comment, "offset data range to that of unsigned short");
+ ffukyg(fptr, "BZERO", 32768., 0, comment, status);
+ strcpy(comment, "default scaling factor");
+ ffukyg(fptr, "BSCALE", 1.0, 0, comment, status);
+ }
+ else if (bitpix == ULONG_IMG)
+ {
+ strcpy(comment, "offset data range to that of unsigned long");
+ ffukyg(fptr, "BZERO", 2147483648., 0, comment, status);
+ strcpy(comment, "default scaling factor");
+ ffukyg(fptr, "BSCALE", 1.0, 0, comment, status);
+ }
+
+ /* re-read the header, to make sure structures are updated */
+ ffrdef(fptr, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffirow(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG firstrow, /* I - insert space AFTER this row */
+ /* 0 = insert space at beginning of table */
+ LONGLONG nrows, /* I - number of rows to insert */
+ int *status) /* IO - error status */
+/*
+ insert NROWS blank rows immediated after row firstrow (1 = first row).
+ Set firstrow = 0 to insert space at the beginning of the table.
+*/
+{
+ int tstatus;
+ LONGLONG naxis1, naxis2;
+ LONGLONG datasize, firstbyte, nshift, nbytes;
+ LONGLONG freespace;
+ long nblock;
+
+ if (*status > 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 ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ ffpmsg("Can only add rows to TABLE or BINTABLE extension (ffirow)");
+ return(*status = NOT_TABLE);
+ }
+
+ if (nrows < 0 )
+ return(*status = NEG_BYTES);
+ else if (nrows == 0)
+ return(*status); /* no op, so just return */
+
+ /* get the current size of the table */
+ /* use internal structure since NAXIS2 keyword may not be up to date */
+ naxis1 = (fptr->Fptr)->rowlength;
+ naxis2 = (fptr->Fptr)->numrows;
+
+ if (firstrow > naxis2)
+ {
+ ffpmsg(
+ "Insert position greater than the number of rows in the table (ffirow)");
+ return(*status = BAD_ROW_NUM);
+ }
+ else if (firstrow < 0)
+ {
+ ffpmsg("Insert position is less than 0 (ffirow)");
+ return(*status = BAD_ROW_NUM);
+ }
+
+ /* current data size */
+ datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
+ freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize;
+ nshift = naxis1 * nrows; /* no. of bytes to add to table */
+
+ if ( (freespace - nshift) < 0) /* not enough existing space? */
+ {
+ nblock = (long) ((nshift - freespace + 2879) / 2880); /* number of blocks */
+ ffiblk(fptr, nblock, 1, status); /* insert the blocks */
+ }
+
+ firstbyte = naxis1 * firstrow; /* relative insert position */
+ nbytes = datasize - firstbyte; /* no. of bytes to shift down */
+ firstbyte += ((fptr->Fptr)->datastart); /* absolute insert position */
+
+ ffshft(fptr, firstbyte, nbytes, nshift, status); /* shift rows and heap */
+
+ /* update the heap starting address */
+ (fptr->Fptr)->heapstart += nshift;
+
+ /* update the THEAP keyword if it exists */
+ tstatus = 0;
+ ffmkyj(fptr, "THEAP", (fptr->Fptr)->heapstart, "&", &tstatus);
+
+ /* update the NAXIS2 keyword */
+ ffmkyj(fptr, "NAXIS2", naxis2 + nrows, "&", status);
+ ((fptr->Fptr)->numrows) += nrows;
+ ((fptr->Fptr)->origrows) += nrows;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdrow(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG firstrow, /* I - first row to delete (1 = first) */
+ LONGLONG nrows, /* I - number of rows to delete */
+ int *status) /* IO - error status */
+/*
+ delete NROWS rows from table starting with firstrow (1 = first row of table).
+*/
+{
+ int tstatus;
+ LONGLONG naxis1, naxis2;
+ LONGLONG datasize, firstbyte, nbytes, nshift;
+ LONGLONG freespace;
+ long nblock;
+ char comm[FLEN_COMMENT];
+
+ if (*status > 0)
+ return(*status);
+
+ 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 == IMAGE_HDU)
+ {
+ ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrow)");
+ return(*status = NOT_TABLE);
+ }
+
+ if (nrows < 0 )
+ return(*status = NEG_BYTES);
+ else if (nrows == 0)
+ return(*status); /* no op, so just return */
+
+ ffgkyjj(fptr, "NAXIS1", &naxis1, comm, status); /* get the current */
+
+ /* ffgkyj(fptr, "NAXIS2", &naxis2, comm, status);*/ /* size of the table */
+
+ /* the NAXIS2 keyword may not be up to date, so use the structure value */
+ naxis2 = (fptr->Fptr)->numrows;
+
+ if (firstrow > naxis2)
+ {
+ ffpmsg(
+ "Delete position greater than the number of rows in the table (ffdrow)");
+ return(*status = BAD_ROW_NUM);
+ }
+ else if (firstrow < 1)
+ {
+ ffpmsg("Delete position is less than 1 (ffdrow)");
+ return(*status = BAD_ROW_NUM);
+ }
+ else if (firstrow + nrows - 1 > naxis2)
+ {
+ ffpmsg("No. of rows to delete exceeds size of table (ffdrow)");
+ return(*status = BAD_ROW_NUM);
+ }
+
+ nshift = naxis1 * nrows; /* no. of bytes to delete from table */
+ /* cur size of data */
+ datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
+
+ firstbyte = naxis1 * (firstrow + nrows - 1); /* relative del pos */
+ nbytes = datasize - firstbyte; /* no. of bytes to shift up */
+ firstbyte += ((fptr->Fptr)->datastart); /* absolute delete position */
+
+ ffshft(fptr, firstbyte, nbytes, nshift * (-1), status); /* shift data */
+
+ freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize;
+ nblock = (long) ((nshift + freespace) / 2880); /* number of blocks */
+
+ /* delete integral number blocks */
+ if (nblock > 0)
+ ffdblk(fptr, nblock, status);
+
+ /* update the heap starting address */
+ (fptr->Fptr)->heapstart -= nshift;
+
+ /* update the THEAP keyword if it exists */
+ tstatus = 0;
+ ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus);
+
+ /* update the NAXIS2 keyword */
+ ffmkyj(fptr, "NAXIS2", naxis2 - nrows, "&", status);
+ ((fptr->Fptr)->numrows) -= nrows;
+ ((fptr->Fptr)->origrows) -= nrows;
+
+ /* Update the heap data, if any. This will remove any orphaned data */
+ /* that was only pointed to by the rows that have been deleted */
+ ffcmph(fptr, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdrrg(fitsfile *fptr, /* I - FITS file pointer to table */
+ char *ranges, /* I - ranges of rows to delete (1 = first) */
+ int *status) /* IO - error status */
+/*
+ delete the ranges of rows from the table (1 = first row of table).
+
+The 'ranges' parameter typically looks like:
+ '10-20, 30 - 40, 55' or '50-'
+and gives a list of rows or row ranges separated by commas.
+*/
+{
+ char *cptr;
+ int nranges, nranges2, ii;
+ long *minrow, *maxrow, nrows, *rowarray, jj, kk;
+ LONGLONG naxis2;
+
+ if (*status > 0)
+ return(*status);
+
+ 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 == IMAGE_HDU)
+ {
+ ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrrg)");
+ return(*status = NOT_TABLE);
+ }
+
+ /* the NAXIS2 keyword may not be up to date, so use the structure value */
+ naxis2 = (fptr->Fptr)->numrows;
+
+ /* find how many ranges were specified ( = no. of commas in string + 1) */
+ cptr = ranges;
+ for (nranges = 1; (cptr = strchr(cptr, ',')); nranges++)
+ cptr++;
+
+ minrow = calloc(nranges, sizeof(long));
+ maxrow = calloc(nranges, sizeof(long));
+
+ if (!minrow || !maxrow) {
+ *status = MEMORY_ALLOCATION;
+ ffpmsg("failed to allocate memory for row ranges (ffdrrg)");
+ if (maxrow) free(maxrow);
+ if (minrow) free(minrow);
+ return(*status);
+ }
+
+ /* parse range list into array of range min and max values */
+ ffrwrg(ranges, naxis2, nranges, &nranges2, minrow, maxrow, status);
+ if (*status > 0 || nranges2 == 0) {
+ free(maxrow);
+ free(minrow);
+ return(*status);
+ }
+
+ /* determine total number or rows to delete */
+ nrows = 0;
+ for (ii = 0; ii < nranges2; ii++) {
+ nrows = nrows + maxrow[ii] - minrow[ii] + 1;
+ }
+
+ rowarray = calloc(nrows, sizeof(long));
+ if (!rowarray) {
+ *status = MEMORY_ALLOCATION;
+ ffpmsg("failed to allocate memory for row array (ffdrrg)");
+ return(*status);
+ }
+
+ for (kk = 0, ii = 0; ii < nranges2; ii++) {
+ for (jj = minrow[ii]; jj <= maxrow[ii]; jj++) {
+ rowarray[kk] = jj;
+ kk++;
+ }
+ }
+
+ /* delete the rows */
+ ffdrws(fptr, rowarray, nrows, status);
+
+ free(rowarray);
+ free(maxrow);
+ free(minrow);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdrws(fitsfile *fptr, /* I - FITS file pointer */
+ long *rownum, /* I - list of rows to delete (1 = first) */
+ long nrows, /* I - number of rows to delete */
+ int *status) /* IO - error status */
+/*
+ delete the list of rows from the table (1 = first row of table).
+*/
+{
+ LONGLONG naxis1, naxis2, insertpos, nextrowpos;
+ long ii, nextrow;
+ char comm[FLEN_COMMENT];
+ unsigned char *buffer;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ /* rescan header if data structure is undefined */
+ if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0)
+ return(*status);
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrws)");
+ return(*status = NOT_TABLE);
+ }
+
+ if (nrows < 0 )
+ return(*status = NEG_BYTES);
+ else if (nrows == 0)
+ return(*status); /* no op, so just return */
+
+ ffgkyjj(fptr, "NAXIS1", &naxis1, comm, status); /* row width */
+ ffgkyjj(fptr, "NAXIS2", &naxis2, comm, status); /* number of rows */
+
+ /* check that input row list is in ascending order */
+ for (ii = 1; ii < nrows; ii++)
+ {
+ if (rownum[ii - 1] >= rownum[ii])
+ {
+ ffpmsg("row numbers are not in increasing order (ffdrws)");
+ return(*status = BAD_ROW_NUM);
+ }
+ }
+
+ if (rownum[0] < 1)
+ {
+ ffpmsg("first row to delete is less than 1 (ffdrws)");
+ return(*status = BAD_ROW_NUM);
+ }
+ else if (rownum[nrows - 1] > naxis2)
+ {
+ ffpmsg("last row to delete exceeds size of table (ffdrws)");
+ return(*status = BAD_ROW_NUM);
+ }
+
+ buffer = (unsigned char *) malloc( (size_t) naxis1); /* buffer for one row */
+
+ if (!buffer)
+ {
+ ffpmsg("malloc failed (ffdrws)");
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* byte location to start of first row to delete, and the next row */
+ insertpos = (fptr->Fptr)->datastart + ((rownum[0] - 1) * naxis1);
+ nextrowpos = insertpos + naxis1;
+ nextrow = rownum[0] + 1;
+
+ /* work through the list of rows to delete */
+ for (ii = 1; ii < nrows; nextrow++, nextrowpos += naxis1)
+ {
+ if (nextrow < rownum[ii])
+ { /* keep this row, so copy it to the new position */
+
+ ffmbyt(fptr, nextrowpos, REPORT_EOF, status);
+ ffgbyt(fptr, naxis1, buffer, status); /* read the bytes */
+
+ ffmbyt(fptr, insertpos, IGNORE_EOF, status);
+ ffpbyt(fptr, naxis1, buffer, status); /* write the bytes */
+
+ if (*status > 0)
+ {
+ ffpmsg("error while copying good rows in table (ffdrws)");
+ free(buffer);
+ return(*status);
+ }
+ insertpos += naxis1;
+ }
+ else
+ { /* skip over this row since it is in the list */
+ ii++;
+ }
+ }
+
+ /* finished with all the rows to delete; copy remaining rows */
+ while(nextrow <= naxis2)
+ {
+ ffmbyt(fptr, nextrowpos, REPORT_EOF, status);
+ ffgbyt(fptr, naxis1, buffer, status); /* read the bytes */
+
+ ffmbyt(fptr, insertpos, IGNORE_EOF, status);
+ ffpbyt(fptr, naxis1, buffer, status); /* write the bytes */
+
+ if (*status > 0)
+ {
+ ffpmsg("failed to copy remaining rows in table (ffdrws)");
+ free(buffer);
+ return(*status);
+ }
+ insertpos += naxis1;
+ nextrowpos += naxis1;
+ nextrow++;
+ }
+ free(buffer);
+
+ /* now delete the empty rows at the end of the table */
+ ffdrow(fptr, naxis2 - nrows + 1, nrows, status);
+
+ /* Update the heap data, if any. This will remove any orphaned data */
+ /* that was only pointed to by the rows that have been deleted */
+ ffcmph(fptr, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdrwsll(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG *rownum, /* I - list of rows to delete (1 = first) */
+ LONGLONG nrows, /* I - number of rows to delete */
+ int *status) /* IO - error status */
+/*
+ delete the list of rows from the table (1 = first row of table).
+*/
+{
+ LONGLONG insertpos, nextrowpos;
+ LONGLONG naxis1, naxis2, ii, nextrow;
+ char comm[FLEN_COMMENT];
+ unsigned char *buffer;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ /* rescan header if data structure is undefined */
+ if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0)
+ return(*status);
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrws)");
+ return(*status = NOT_TABLE);
+ }
+
+ if (nrows < 0 )
+ return(*status = NEG_BYTES);
+ else if (nrows == 0)
+ return(*status); /* no op, so just return */
+
+ ffgkyjj(fptr, "NAXIS1", &naxis1, comm, status); /* row width */
+ ffgkyjj(fptr, "NAXIS2", &naxis2, comm, status); /* number of rows */
+
+ /* check that input row list is in ascending order */
+ for (ii = 1; ii < nrows; ii++)
+ {
+ if (rownum[ii - 1] >= rownum[ii])
+ {
+ ffpmsg("row numbers are not in increasing order (ffdrws)");
+ return(*status = BAD_ROW_NUM);
+ }
+ }
+
+ if (rownum[0] < 1)
+ {
+ ffpmsg("first row to delete is less than 1 (ffdrws)");
+ return(*status = BAD_ROW_NUM);
+ }
+ else if (rownum[nrows - 1] > naxis2)
+ {
+ ffpmsg("last row to delete exceeds size of table (ffdrws)");
+ return(*status = BAD_ROW_NUM);
+ }
+
+ buffer = (unsigned char *) malloc( (size_t) naxis1); /* buffer for one row */
+
+ if (!buffer)
+ {
+ ffpmsg("malloc failed (ffdrwsll)");
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* byte location to start of first row to delete, and the next row */
+ insertpos = (fptr->Fptr)->datastart + ((rownum[0] - 1) * naxis1);
+ nextrowpos = insertpos + naxis1;
+ nextrow = rownum[0] + 1;
+
+ /* work through the list of rows to delete */
+ for (ii = 1; ii < nrows; nextrow++, nextrowpos += naxis1)
+ {
+ if (nextrow < rownum[ii])
+ { /* keep this row, so copy it to the new position */
+
+ ffmbyt(fptr, nextrowpos, REPORT_EOF, status);
+ ffgbyt(fptr, naxis1, buffer, status); /* read the bytes */
+
+ ffmbyt(fptr, insertpos, IGNORE_EOF, status);
+ ffpbyt(fptr, naxis1, buffer, status); /* write the bytes */
+
+ if (*status > 0)
+ {
+ ffpmsg("error while copying good rows in table (ffdrws)");
+ free(buffer);
+ return(*status);
+ }
+ insertpos += naxis1;
+ }
+ else
+ { /* skip over this row since it is in the list */
+ ii++;
+ }
+ }
+
+ /* finished with all the rows to delete; copy remaining rows */
+ while(nextrow <= naxis2)
+ {
+ ffmbyt(fptr, nextrowpos, REPORT_EOF, status);
+ ffgbyt(fptr, naxis1, buffer, status); /* read the bytes */
+
+ ffmbyt(fptr, insertpos, IGNORE_EOF, status);
+ ffpbyt(fptr, naxis1, buffer, status); /* write the bytes */
+
+ if (*status > 0)
+ {
+ ffpmsg("failed to copy remaining rows in table (ffdrws)");
+ free(buffer);
+ return(*status);
+ }
+ insertpos += naxis1;
+ nextrowpos += naxis1;
+ nextrow++;
+ }
+ free(buffer);
+
+ /* now delete the empty rows at the end of the table */
+ ffdrow(fptr, naxis2 - nrows + 1, nrows, status);
+
+ /* Update the heap data, if any. This will remove any orphaned data */
+ /* that was only pointed to by the rows that have been deleted */
+ ffcmph(fptr, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffrwrg(
+ char *rowlist, /* I - list of rows and row ranges */
+ LONGLONG maxrows, /* I - number of rows in the table */
+ int maxranges, /* I - max number of ranges to be returned */
+ int *numranges, /* O - number ranges returned */
+ long *minrow, /* O - first row in each range */
+ long *maxrow, /* O - last row in each range */
+ int *status) /* IO - status value */
+{
+/*
+ parse the input list of row ranges, returning the number of ranges,
+ and the min and max row value in each range.
+
+ The only characters allowed in the input rowlist are
+ decimal digits, minus sign, and comma (and non-significant spaces)
+
+ Example:
+
+ list = "10-20, 30-35,50"
+
+ would return numranges = 3, minrow[] = {10, 30, 50}, maxrow[] = {20, 35, 50}
+
+ error is returned if min value of range is > max value of range or if the
+ ranges are not monotonically increasing.
+*/
+ char *next;
+ long minval, maxval;
+
+ if (*status > 0)
+ return(*status);
+
+ if (maxrows <= 0 ) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Input maximum range value is <= 0 (fits_parse_ranges)");
+ return(*status);
+ }
+
+ next = rowlist;
+ *numranges = 0;
+
+ while (*next == ' ')next++; /* skip spaces */
+
+ while (*next != '\0') {
+
+ /* find min value of next range; *next must be '-' or a digit */
+ if (*next == '-') {
+ minval = 1; /* implied minrow value = 1 */
+ } else if ( isdigit((int) *next) ) {
+ minval = strtol(next, &next, 10);
+ } else {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list:");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+
+ while (*next == ' ')next++; /* skip spaces */
+
+ /* find max value of next range; *next must be '-', or ',' */
+ if (*next == '-') {
+ next++;
+ while (*next == ' ')next++; /* skip spaces */
+
+ if ( isdigit((int) *next) ) {
+ maxval = strtol(next, &next, 10);
+ } else if (*next == ',' || *next == '\0') {
+ maxval = (long) maxrows; /* implied max value */
+ } else {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list:");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+ } else if (*next == ',' || *next == '\0') {
+ maxval = minval; /* only a single integer in this range */
+ } else {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list:");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+
+ if (*numranges + 1 > maxranges) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Overflowed maximum number of ranges (fits_parse_ranges)");
+ return(*status);
+ }
+
+ if (minval < 1 ) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list: row number < 1");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+
+ if (maxval < minval) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list: min > max");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+
+ if (*numranges > 0) {
+ if (minval <= maxrow[(*numranges) - 1]) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list. Range minimum is");
+ ffpmsg(" less than or equal to previous range maximum");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+ }
+
+ if (minval <= maxrows) { /* ignore range if greater than maxrows */
+ if (maxval > maxrows)
+ maxval = (long) maxrows;
+
+ minrow[*numranges] = minval;
+ maxrow[*numranges] = maxval;
+
+ (*numranges)++;
+ }
+
+ while (*next == ' ')next++; /* skip spaces */
+ if (*next == ',') {
+ next++;
+ while (*next == ' ')next++; /* skip more spaces */
+ }
+ }
+
+ if (*numranges == 0) { /* a null string was entered */
+ minrow[0] = 1;
+ maxrow[0] = (long) maxrows;
+ *numranges = 1;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffrwrgll(
+ char *rowlist, /* I - list of rows and row ranges */
+ LONGLONG maxrows, /* I - number of rows in the list */
+ int maxranges, /* I - max number of ranges to be returned */
+ int *numranges, /* O - number ranges returned */
+ LONGLONG *minrow, /* O - first row in each range */
+ LONGLONG *maxrow, /* O - last row in each range */
+ int *status) /* IO - status value */
+{
+/*
+ parse the input list of row ranges, returning the number of ranges,
+ and the min and max row value in each range.
+
+ The only characters allowed in the input rowlist are
+ decimal digits, minus sign, and comma (and non-significant spaces)
+
+ Example:
+
+ list = "10-20, 30-35,50"
+
+ would return numranges = 3, minrow[] = {10, 30, 50}, maxrow[] = {20, 35, 50}
+
+ error is returned if min value of range is > max value of range or if the
+ ranges are not monotonically increasing.
+*/
+ char *next;
+ LONGLONG minval, maxval;
+ double dvalue;
+
+ if (*status > 0)
+ return(*status);
+
+ if (maxrows <= 0 ) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Input maximum range value is <= 0 (fits_parse_ranges)");
+ return(*status);
+ }
+
+ next = rowlist;
+ *numranges = 0;
+
+ while (*next == ' ')next++; /* skip spaces */
+
+ while (*next != '\0') {
+
+ /* find min value of next range; *next must be '-' or a digit */
+ if (*next == '-') {
+ minval = 1; /* implied minrow value = 1 */
+ } else if ( isdigit((int) *next) ) {
+
+ /* read as a double, because the string to LONGLONG function */
+ /* is platform dependent (strtoll, strtol, _atoI64) */
+
+ dvalue = strtod(next, &next);
+ minval = (LONGLONG) (dvalue + 0.1);
+
+ } else {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list:");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+
+ while (*next == ' ')next++; /* skip spaces */
+
+ /* find max value of next range; *next must be '-', or ',' */
+ if (*next == '-') {
+ next++;
+ while (*next == ' ')next++; /* skip spaces */
+
+ if ( isdigit((int) *next) ) {
+
+ /* read as a double, because the string to LONGLONG function */
+ /* is platform dependent (strtoll, strtol, _atoI64) */
+
+ dvalue = strtod(next, &next);
+ maxval = (LONGLONG) (dvalue + 0.1);
+
+ } else if (*next == ',' || *next == '\0') {
+ maxval = maxrows; /* implied max value */
+ } else {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list:");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+ } else if (*next == ',' || *next == '\0') {
+ maxval = minval; /* only a single integer in this range */
+ } else {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list:");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+
+ if (*numranges + 1 > maxranges) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Overflowed maximum number of ranges (fits_parse_ranges)");
+ return(*status);
+ }
+
+ if (minval < 1 ) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list: row number < 1");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+
+ if (maxval < minval) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list: min > max");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+
+ if (*numranges > 0) {
+ if (minval <= maxrow[(*numranges) - 1]) {
+ *status = RANGE_PARSE_ERROR;
+ ffpmsg("Syntax error in this row range list. Range minimum is");
+ ffpmsg(" less than or equal to previous range maximum");
+ ffpmsg(rowlist);
+ return(*status);
+ }
+ }
+
+ if (minval <= maxrows) { /* ignore range if greater than maxrows */
+ if (maxval > maxrows)
+ maxval = maxrows;
+
+ minrow[*numranges] = minval;
+ maxrow[*numranges] = maxval;
+
+ (*numranges)++;
+ }
+
+ while (*next == ' ')next++; /* skip spaces */
+ if (*next == ',') {
+ next++;
+ while (*next == ' ')next++; /* skip more spaces */
+ }
+ }
+
+ if (*numranges == 0) { /* a null string was entered */
+ minrow[0] = 1;
+ maxrow[0] = maxrows;
+ *numranges = 1;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fficol(fitsfile *fptr, /* I - FITS file pointer */
+ int numcol, /* I - position for new col. (1 = 1st) */
+ char *ttype, /* I - name of column (TTYPE keyword) */
+ char *tform, /* I - format of column (TFORM keyword) */
+ int *status) /* IO - error status */
+/*
+ Insert a new column into an existing table at position numcol. If
+ numcol is greater than the number of existing columns in the table
+ then the new column will be appended as the last column in the table.
+*/
+{
+ char *name, *format;
+
+ name = ttype;
+ format = tform;
+
+ fficls(fptr, numcol, 1, &name, &format, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fficls(fitsfile *fptr, /* I - FITS file pointer */
+ int fstcol, /* I - position for first new col. (1 = 1st) */
+ int ncols, /* I - number of columns to insert */
+ char **ttype, /* I - array of column names(TTYPE keywords) */
+ char **tform, /* I - array of formats of column (TFORM) */
+ int *status) /* IO - error status */
+/*
+ Insert 1 or more new columns into an existing table at position numcol. If
+ fstcol is greater than the number of existing columns in the table
+ then the new column will be appended as the last column in the table.
+*/
+{
+ int colnum, datacode, decims, tfields, tstatus, ii;
+ LONGLONG datasize, firstbyte, nbytes, nadd, naxis1, naxis2, freespace;
+ LONGLONG tbcol, firstcol, delbyte;
+ long nblock, width, repeat;
+ char tfm[FLEN_VALUE], keyname[FLEN_KEYWORD], comm[FLEN_COMMENT], *cptr;
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ 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 == IMAGE_HDU)
+ {
+ ffpmsg("Can only add columns to TABLE or BINTABLE extension (fficol)");
+ return(*status = NOT_TABLE);
+ }
+
+ /* is the column number valid? */
+ tfields = (fptr->Fptr)->tfield;
+ if (fstcol < 1 )
+ return(*status = BAD_COL_NUM);
+ else if (fstcol > tfields)
+ colnum = tfields + 1; /* append as last column */
+ else
+ colnum = fstcol;
+
+ /* parse the tform value and calc number of bytes to add to each row */
+ delbyte = 0;
+ for (ii = 0; ii < ncols; ii++)
+ {
+ strcpy(tfm, tform[ii]);
+ ffupch(tfm); /* make sure format is in upper case */
+
+ if ((fptr->Fptr)->hdutype == ASCII_TBL)
+ {
+ ffasfm(tfm, &datacode, &width, &decims, status);
+ delbyte += width + 1; /* add one space between the columns */
+ }
+ else
+ {
+ ffbnfm(tfm, &datacode, &repeat, &width, status);
+
+ if (datacode < 0) /* variable length array column */
+ delbyte += 8;
+ else if (datacode == 1) /* bit column; round up */
+ delbyte += (repeat + 7) / 8; /* to multiple of 8 bits */
+ else if (datacode == 16) /* ASCII string column */
+ delbyte += repeat;
+ else /* numerical data type */
+ delbyte += (datacode / 10) * repeat;
+ }
+ }
+
+ if (*status > 0)
+ return(*status);
+
+ /* get the current size of the table */
+ /* use internal structure since NAXIS2 keyword may not be up to date */
+ naxis1 = (fptr->Fptr)->rowlength;
+ naxis2 = (fptr->Fptr)->numrows;
+
+ /* current size of data */
+ datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
+ freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize;
+ nadd = delbyte * naxis2; /* no. of bytes to add to table */
+
+ if ( (freespace - nadd) < 0) /* not enough existing space? */
+ {
+ nblock = (long) ((nadd - freespace + 2879) / 2880); /* number of blocks */
+ if (ffiblk(fptr, nblock, 1, status) > 0) /* insert the blocks */
+ return(*status);
+ }
+
+ /* shift heap down (if it exists) */
+ if ((fptr->Fptr)->heapsize > 0)
+ {
+ nbytes = (fptr->Fptr)->heapsize; /* no. of bytes to shift down */
+
+ /* absolute heap pos */
+ firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart;
+
+ if (ffshft(fptr, firstbyte, nbytes, nadd, status) > 0) /* move heap */
+ return(*status);
+ }
+
+ /* update the heap starting address */
+ (fptr->Fptr)->heapstart += nadd;
+
+ /* update the THEAP keyword if it exists */
+ tstatus = 0;
+ ffmkyj(fptr, "THEAP", (fptr->Fptr)->heapstart, "&", &tstatus);
+
+ /* calculate byte position in the row where to insert the new column */
+ if (colnum > tfields)
+ firstcol = naxis1;
+ else
+ {
+ colptr = (fptr->Fptr)->tableptr;
+ colptr += (colnum - 1);
+ firstcol = colptr->tbcol;
+ }
+
+ /* insert delbyte bytes in every row, at byte position firstcol */
+ ffcins(fptr, naxis1, naxis2, delbyte, firstcol, status);
+
+ if ((fptr->Fptr)->hdutype == ASCII_TBL)
+ {
+ /* adjust the TBCOL values of the existing columns */
+ for(ii = 0; ii < tfields; ii++)
+ {
+ ffkeyn("TBCOL", ii + 1, keyname, status);
+ ffgkyjj(fptr, keyname, &tbcol, comm, status);
+ if (tbcol > firstcol)
+ {
+ tbcol += delbyte;
+ ffmkyj(fptr, keyname, tbcol, "&", status);
+ }
+ }
+ }
+
+ /* update the mandatory keywords */
+ ffmkyj(fptr, "TFIELDS", tfields + ncols, "&", status);
+ ffmkyj(fptr, "NAXIS1", naxis1 + delbyte, "&", status);
+
+ /* increment the index value on any existing column keywords */
+ if(colnum <= tfields)
+ ffkshf(fptr, colnum, tfields, ncols, status);
+
+ /* add the required keywords for the new columns */
+ for (ii = 0; ii < ncols; ii++, colnum++)
+ {
+ strcpy(comm, "label for field");
+ ffkeyn("TTYPE", colnum, keyname, status);
+ ffpkys(fptr, keyname, ttype[ii], comm, status);
+
+ strcpy(comm, "format of field");
+ strcpy(tfm, tform[ii]);
+ ffupch(tfm); /* make sure format is in upper case */
+ ffkeyn("TFORM", colnum, keyname, status);
+
+ if (abs(datacode) == TSBYTE)
+ {
+ /* Replace the 'S' with an 'B' in the TFORMn code */
+ cptr = tfm;
+ while (*cptr != 'S')
+ cptr++;
+
+ *cptr = 'B';
+ ffpkys(fptr, keyname, tfm, comm, status);
+
+ /* write the TZEROn and TSCALn keywords */
+ ffkeyn("TZERO", colnum, keyname, status);
+ strcpy(comm, "offset for signed bytes");
+
+ ffpkyg(fptr, keyname, -128., 0, comm, status);
+
+ ffkeyn("TSCAL", colnum, keyname, status);
+ strcpy(comm, "data are not scaled");
+ ffpkyg(fptr, keyname, 1., 0, comm, status);
+ }
+ else if (abs(datacode) == TUSHORT)
+ {
+ /* Replace the 'U' with an 'I' in the TFORMn code */
+ cptr = tfm;
+ while (*cptr != 'U')
+ cptr++;
+
+ *cptr = 'I';
+ ffpkys(fptr, keyname, tfm, comm, status);
+
+ /* write the TZEROn and TSCALn keywords */
+ ffkeyn("TZERO", colnum, keyname, status);
+ strcpy(comm, "offset for unsigned integers");
+
+ ffpkyg(fptr, keyname, 32768., 0, comm, status);
+
+ ffkeyn("TSCAL", colnum, keyname, status);
+ strcpy(comm, "data are not scaled");
+ ffpkyg(fptr, keyname, 1., 0, comm, status);
+ }
+ else if (abs(datacode) == TULONG)
+ {
+ /* Replace the 'V' with an 'J' in the TFORMn code */
+ cptr = tfm;
+ while (*cptr != 'V')
+ cptr++;
+
+ *cptr = 'J';
+ ffpkys(fptr, keyname, tfm, comm, status);
+
+ /* write the TZEROn and TSCALn keywords */
+ ffkeyn("TZERO", colnum, keyname, status);
+ strcpy(comm, "offset for unsigned integers");
+
+ ffpkyg(fptr, keyname, 2147483648., 0, comm, status);
+
+ ffkeyn("TSCAL", colnum, keyname, status);
+ strcpy(comm, "data are not scaled");
+ ffpkyg(fptr, keyname, 1., 0, comm, status);
+ }
+ else
+ {
+ ffpkys(fptr, keyname, tfm, comm, status);
+ }
+
+ if ((fptr->Fptr)->hdutype == ASCII_TBL) /* write the TBCOL keyword */
+ {
+ if (colnum == tfields + 1)
+ tbcol = firstcol + 2; /* allow space between preceding col */
+ else
+ tbcol = firstcol + 1;
+
+ strcpy(comm, "beginning column of field");
+ ffkeyn("TBCOL", colnum, keyname, status);
+ ffpkyj(fptr, keyname, tbcol, comm, status);
+
+ /* increment the column starting position for the next column */
+ ffasfm(tfm, &datacode, &width, &decims, status);
+ firstcol += width + 1; /* add one space between the columns */
+ }
+ }
+ ffrdef(fptr, status); /* initialize the new table structure */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmvec(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - position of col to be modified */
+ LONGLONG newveclen, /* I - new vector length of column (TFORM) */
+ int *status) /* IO - error status */
+/*
+ Modify the vector length of a column in a binary table, larger or smaller.
+ E.g., change a column from TFORMn = '1E' to '20E'.
+*/
+{
+ int datacode, tfields, tstatus;
+ LONGLONG datasize, size, firstbyte, nbytes, nadd, ndelete;
+ LONGLONG naxis1, naxis2, firstcol, freespace;
+ LONGLONG width, delbyte, repeat;
+ long nblock;
+ char tfm[FLEN_VALUE], keyname[FLEN_KEYWORD], tcode[2];
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ 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(
+ "Can only change vector length of a column in BINTABLE extension (ffmvec)");
+ return(*status = NOT_TABLE);
+ }
+
+ /* is the column number valid? */
+ tfields = (fptr->Fptr)->tfield;
+ if (colnum < 1 || colnum > tfields)
+ return(*status = BAD_COL_NUM);
+
+ /* look up the current vector length and element width */
+
+ colptr = (fptr->Fptr)->tableptr;
+ colptr += (colnum - 1);
+
+ datacode = colptr->tdatatype; /* datatype of the column */
+ repeat = colptr->trepeat; /* field repeat count */
+ width = colptr->twidth; /* width of a single element in chars */
+
+ if (datacode < 0)
+ {
+ ffpmsg(
+ "Can't modify vector length of variable length column (ffmvec)");
+ return(*status = BAD_TFORM);
+ }
+
+ if (repeat == newveclen)
+ return(*status); /* column already has the desired vector length */
+
+ if (datacode == TSTRING)
+ width = 1; /* width was equal to width of unit string */
+
+ naxis1 = (fptr->Fptr)->rowlength; /* current width of the table */
+ naxis2 = (fptr->Fptr)->numrows;
+
+ delbyte = (newveclen - repeat) * width; /* no. of bytes to insert */
+ if (datacode == TBIT) /* BIT column is a special case */
+ delbyte = ((newveclen + 7) / 8) - ((repeat + 7) / 8);
+
+ if (delbyte > 0) /* insert space for more elements */
+ {
+ /* current size of data */
+ datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
+ freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize;
+
+ nadd = (LONGLONG)delbyte * naxis2; /* no. of bytes to add to table */
+
+ if ( (freespace - nadd) < 0) /* not enough existing space? */
+ {
+ nblock = (long) ((nadd - freespace + 2879) / 2880); /* number of blocks */
+ if (ffiblk(fptr, nblock, 1, status) > 0) /* insert the blocks */
+ return(*status);
+ }
+
+ /* shift heap down (if it exists) */
+ if ((fptr->Fptr)->heapsize > 0)
+ {
+ nbytes = (fptr->Fptr)->heapsize; /* no. of bytes to shift down */
+
+ /* absolute heap pos */
+ firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart;
+
+ if (ffshft(fptr, firstbyte, nbytes, nadd, status) > 0) /* move heap */
+ return(*status);
+ }
+
+ /* update the heap starting address */
+ (fptr->Fptr)->heapstart += nadd;
+
+ /* update the THEAP keyword if it exists */
+ tstatus = 0;
+ ffmkyj(fptr, "THEAP", (fptr->Fptr)->heapstart, "&", &tstatus);
+
+ firstcol = colptr->tbcol + (repeat * width); /* insert position */
+
+ /* insert delbyte bytes in every row, at byte position firstcol */
+ ffcins(fptr, naxis1, naxis2, delbyte, firstcol, status);
+ }
+ else if (delbyte < 0)
+ {
+ /* current size of table */
+ size = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
+ freespace = ((size + 2879) / 2880) * 2880 - size - ((LONGLONG)delbyte * naxis2);
+ nblock = (long) (freespace / 2880); /* number of empty blocks to delete */
+ firstcol = colptr->tbcol + (newveclen * width); /* delete position */
+
+ /* delete elements from the vector */
+ ffcdel(fptr, naxis1, naxis2, -delbyte, firstcol, status);
+
+ /* abs heap pos */
+ firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart;
+ ndelete = (LONGLONG)delbyte * naxis2; /* size of shift (negative) */
+
+ /* shift heap up (if it exists) */
+ if ((fptr->Fptr)->heapsize > 0)
+ {
+ nbytes = (fptr->Fptr)->heapsize; /* no. of bytes to shift up */
+ if (ffshft(fptr, firstbyte, nbytes, ndelete, status) > 0)
+ return(*status);
+ }
+
+ /* delete the empty blocks at the end of the HDU */
+ if (nblock > 0)
+ ffdblk(fptr, nblock, status);
+
+ /* update the heap starting address */
+ (fptr->Fptr)->heapstart += ndelete; /* ndelete is negative */
+
+ /* update the THEAP keyword if it exists */
+ tstatus = 0;
+ ffmkyj(fptr, "THEAP", (fptr->Fptr)->heapstart, "&", &tstatus);
+ }
+
+ /* construct the new TFORM keyword for the column */
+ if (datacode == TBIT)
+ strcpy(tcode,"X");
+ else if (datacode == TBYTE)
+ strcpy(tcode,"B");
+ else if (datacode == TLOGICAL)
+ strcpy(tcode,"L");
+ else if (datacode == TSTRING)
+ strcpy(tcode,"A");
+ else if (datacode == TSHORT)
+ strcpy(tcode,"I");
+ else if (datacode == TLONG)
+ strcpy(tcode,"J");
+ else if (datacode == TLONGLONG)
+ strcpy(tcode,"K");
+ else if (datacode == TFLOAT)
+ strcpy(tcode,"E");
+ else if (datacode == TDOUBLE)
+ strcpy(tcode,"D");
+ else if (datacode == TCOMPLEX)
+ strcpy(tcode,"C");
+ else if (datacode == TDBLCOMPLEX)
+ strcpy(tcode,"M");
+
+ /* write as a double value because the LONGLONG conversion */
+ /* character in sprintf is platform dependent ( %lld, %ld, %I64d ) */
+
+ sprintf(tfm,"%.0f%s",(double) newveclen, tcode);
+
+ ffkeyn("TFORM", colnum, keyname, status); /* Keyword name */
+ ffmkys(fptr, keyname, tfm, "&", status); /* modify TFORM keyword */
+
+ ffmkyj(fptr, "NAXIS1", naxis1 + delbyte, "&", status); /* modify NAXIS1 */
+
+ ffrdef(fptr, status); /* reinitialize the new table structure */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcpcl(fitsfile *infptr, /* I - FITS file pointer to input file */
+ fitsfile *outfptr, /* I - FITS file pointer to output file */
+ int incol, /* I - number of input column */
+ int outcol, /* I - number for output column */
+ int create_col, /* I - create new col if TRUE, else overwrite */
+ int *status) /* IO - error status */
+/*
+ copy a column from infptr and insert it in the outfptr table.
+*/
+{
+ int tstatus, colnum, typecode, anynull;
+ long tfields, repeat, width, nrows, outrows;
+ long inloop, outloop, maxloop, ndone, ntodo, npixels;
+ long firstrow, firstelem, ii;
+ char keyname[FLEN_KEYWORD], ttype[FLEN_VALUE], tform[FLEN_VALUE];
+ char ttype_comm[FLEN_COMMENT],tform_comm[FLEN_COMMENT];
+ char *lvalues = 0, nullflag, **strarray = 0;
+ char nulstr[] = {'\5', '\0'}; /* unique null string value */
+ double dnull = 0.l, *dvalues = 0;
+ float fnull = 0., *fvalues = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ if (infptr->HDUposition != (infptr->Fptr)->curhdu)
+ {
+ ffmahd(infptr, (infptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((infptr->Fptr)->datastart == DATA_UNDEFINED)
+ ffrdef(infptr, status); /* rescan header */
+
+ if (outfptr->HDUposition != (outfptr->Fptr)->curhdu)
+ {
+ ffmahd(outfptr, (outfptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((outfptr->Fptr)->datastart == DATA_UNDEFINED)
+ ffrdef(outfptr, status); /* rescan header */
+
+ if (*status > 0)
+ return(*status);
+
+ if ((infptr->Fptr)->hdutype == IMAGE_HDU || (outfptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ ffpmsg
+ ("Can not copy columns to or from IMAGE HDUs (ffcpcl)");
+ return(*status = NOT_TABLE);
+ }
+
+ if ( (infptr->Fptr)->hdutype == BINARY_TBL && (outfptr->Fptr)->hdutype == ASCII_TBL)
+ {
+ ffpmsg
+ ("Copying from Binary table to ASCII table is not supported (ffcpcl)");
+ return(*status = NOT_BTABLE);
+ }
+
+ /* get the datatype and vector repeat length of the column */
+ ffgtcl(infptr, incol, &typecode, &repeat, &width, status);
+
+ if (typecode < 0)
+ {
+ ffpmsg("Variable-length columns are not supported (ffcpcl)");
+ return(*status = BAD_TFORM);
+ }
+
+ if (create_col) /* insert new column in output table? */
+ {
+ tstatus = 0;
+ ffkeyn("TTYPE", incol, keyname, &tstatus);
+ ffgkys(infptr, keyname, ttype, ttype_comm, &tstatus);
+ ffkeyn("TFORM", incol, keyname, &tstatus);
+
+ if (ffgkys(infptr, keyname, tform, tform_comm, &tstatus) )
+ {
+ ffpmsg
+ ("Could not find TTYPE and TFORM keywords in input table (ffcpcl)");
+ return(*status = NO_TFORM);
+ }
+
+ if ((infptr->Fptr)->hdutype == ASCII_TBL && (outfptr->Fptr)->hdutype == BINARY_TBL)
+ {
+ /* convert from ASCII table to BINARY table format string */
+ if (typecode == TSTRING)
+ ffnkey(width, "A", tform, status);
+
+ else if (typecode == TLONG)
+ strcpy(tform, "1J");
+
+ else if (typecode == TSHORT)
+ strcpy(tform, "1I");
+
+ else if (typecode == TFLOAT)
+ strcpy(tform,"1E");
+
+ else if (typecode == TDOUBLE)
+ strcpy(tform,"1D");
+ }
+
+ if (ffgkyj(outfptr, "TFIELDS", &tfields, 0, &tstatus))
+ {
+ ffpmsg
+ ("Could not read TFIELDS keyword in output table (ffcpcl)");
+ return(*status = NO_TFIELDS);
+ }
+
+ colnum = minvalue((int) tfields + 1, outcol); /* output col. number */
+
+ /* create the empty column */
+ if (fficol(outfptr, colnum, ttype, tform, status) > 0)
+ {
+ ffpmsg
+ ("Could not append new column to output file (ffcpcl)");
+ return(*status);
+ }
+
+ /* copy the comment strings from the input file for TTYPE and TFORM */
+ tstatus = 0;
+ ffkeyn("TTYPE", colnum, keyname, &tstatus);
+ ffmcom(outfptr, keyname, ttype_comm, &tstatus);
+ ffkeyn("TFORM", colnum, keyname, &tstatus);
+ ffmcom(outfptr, keyname, tform_comm, &tstatus);
+
+ /* copy other column-related keywords if they exist */
+
+ ffcpky(infptr, outfptr, incol, colnum, "TUNIT", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TSCAL", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TZERO", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TDISP", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TLMIN", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TLMAX", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TDIM", status);
+
+ /* WCS keywords */
+ ffcpky(infptr, outfptr, incol, colnum, "TCTYP", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TCUNI", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TCRVL", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TCRPX", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TCDLT", status);
+ ffcpky(infptr, outfptr, incol, colnum, "TCROT", status);
+
+ if ((infptr->Fptr)->hdutype == ASCII_TBL && (outfptr->Fptr)->hdutype == BINARY_TBL)
+ {
+ /* binary tables only have TNULLn keyword for integer columns */
+ if (typecode == TLONG || typecode == TSHORT)
+ {
+ /* check if null string is defined; replace with integer */
+ ffkeyn("TNULL", incol, keyname, &tstatus);
+ if (ffgkys(infptr, keyname, ttype, 0, &tstatus) <= 0)
+ {
+ ffkeyn("TNULL", colnum, keyname, &tstatus);
+ if (typecode == TLONG)
+ ffpkyj(outfptr, keyname, -9999999L, "Null value", status);
+ else
+ ffpkyj(outfptr, keyname, -32768L, "Null value", status);
+ }
+ }
+ }
+ else
+ {
+ ffcpky(infptr, outfptr, incol, colnum, "TNULL", status);
+ }
+
+ /* rescan header to recognize the new keywords */
+ if (ffrdef(outfptr, status) )
+ return(*status);
+ }
+ else
+ {
+ colnum = outcol;
+ }
+
+ ffgkyj(infptr, "NAXIS2", &nrows, 0, status); /* no. of input rows */
+ ffgkyj(outfptr, "NAXIS2", &outrows, 0, status); /* no. of output rows */
+ nrows = minvalue(nrows, outrows);
+
+ if (typecode == TBIT)
+ repeat = (repeat - 1) / 8 + 1; /* convert from bits to bytes */
+ else if (typecode == TSTRING && (infptr->Fptr)->hdutype == BINARY_TBL)
+ repeat = repeat / width; /* convert from chars to unit strings */
+
+ /* get optimum number of rows to copy at one time */
+ ffgrsz(infptr, &inloop, status);
+ ffgrsz(outfptr, &outloop, status);
+
+ /* adjust optimum number, since 2 tables are open at once */
+ maxloop = minvalue(inloop, outloop); /* smallest of the 2 tables */
+ maxloop = maxvalue(1, maxloop / 2); /* at least 1 row */
+ maxloop = minvalue(maxloop, nrows); /* max = nrows to be copied */
+ maxloop *= repeat; /* mult by no of elements in a row */
+
+ /* allocate memory for arrays */
+ if (typecode == TLOGICAL)
+ {
+ lvalues = (char *) calloc(maxloop, sizeof(char) );
+ if (!lvalues)
+ {
+ ffpmsg
+ ("malloc failed to get memory for logicals (ffcpcl)");
+ return(*status = ARRAY_TOO_BIG);
+ }
+ }
+ else if (typecode == TSTRING)
+ {
+ /* allocate array of pointers */
+ strarray = (char **) calloc(maxloop, sizeof(strarray));
+
+ /* allocate space for each string */
+ for (ii = 0; ii < maxloop; ii++)
+ strarray[ii] = (char *) calloc(width+1, sizeof(char));
+ }
+ else if (typecode == TCOMPLEX)
+ {
+ fvalues = (float *) calloc(maxloop * 2, sizeof(float) );
+ if (!fvalues)
+ {
+ ffpmsg
+ ("malloc failed to get memory for complex (ffcpcl)");
+ return(*status = ARRAY_TOO_BIG);
+ }
+ fnull = 0.;
+ }
+ else if (typecode == TDBLCOMPLEX)
+ {
+ dvalues = (double *) calloc(maxloop * 2, sizeof(double) );
+ if (!dvalues)
+ {
+ ffpmsg
+ ("malloc failed to get memory for dbl complex (ffcpcl)");
+ return(*status = ARRAY_TOO_BIG);
+ }
+ dnull = 0.;
+ }
+ else /* numerical datatype; read them all as doubles */
+ {
+ dvalues = (double *) calloc(maxloop, sizeof(double) );
+ if (!dvalues)
+ {
+ ffpmsg
+ ("malloc failed to get memory for doubles (ffcpcl)");
+ return(*status = ARRAY_TOO_BIG);
+ }
+ dnull = -9.99991999E31; /* use an unlikely value for nulls */
+ }
+
+ npixels = nrows * repeat; /* total no. of pixels to copy */
+ ntodo = minvalue(npixels, maxloop); /* no. to copy per iteration */
+ ndone = 0; /* total no. of pixels that have been copied */
+
+ while (ntodo) /* iterate through the table */
+ {
+ firstrow = ndone / repeat + 1;
+ firstelem = ndone - ((firstrow - 1) * repeat) + 1;
+
+ /* read from input table */
+ if (typecode == TLOGICAL)
+ ffgcl(infptr, incol, firstrow, firstelem, ntodo,
+ lvalues, status);
+ else if (typecode == TSTRING)
+ ffgcvs(infptr, incol, firstrow, firstelem, ntodo,
+ nulstr, strarray, &anynull, status);
+
+ else if (typecode == TCOMPLEX)
+ ffgcvc(infptr, incol, firstrow, firstelem, ntodo, fnull,
+ fvalues, &anynull, status);
+
+ else if (typecode == TDBLCOMPLEX)
+ ffgcvm(infptr, incol, firstrow, firstelem, ntodo, dnull,
+ dvalues, &anynull, status);
+
+ else /* all numerical types */
+ ffgcvd(infptr, incol, firstrow, firstelem, ntodo, dnull,
+ dvalues, &anynull, status);
+
+ if (*status > 0)
+ {
+ ffpmsg("Error reading input copy of column (ffcpcl)");
+ break;
+ }
+
+ /* write to output table */
+ if (typecode == TLOGICAL)
+ {
+ nullflag = 2;
+
+ ffpcnl(outfptr, colnum, firstrow, firstelem, ntodo,
+ lvalues, nullflag, status);
+
+ }
+
+ else if (typecode == TSTRING)
+ {
+ if (anynull)
+ ffpcns(outfptr, colnum, firstrow, firstelem, ntodo,
+ strarray, nulstr, status);
+ else
+ ffpcls(outfptr, colnum, firstrow, firstelem, ntodo,
+ strarray, status);
+ }
+
+ else if (typecode == TCOMPLEX)
+ { /* doesn't support writing nulls */
+ ffpclc(outfptr, colnum, firstrow, firstelem, ntodo,
+ fvalues, status);
+ }
+
+ else if (typecode == TDBLCOMPLEX)
+ { /* doesn't support writing nulls */
+ ffpclm(outfptr, colnum, firstrow, firstelem, ntodo,
+ dvalues, status);
+ }
+
+ else /* all other numerical types */
+ {
+ if (anynull)
+ ffpcnd(outfptr, colnum, firstrow, firstelem, ntodo,
+ dvalues, dnull, status);
+ else
+ ffpcld(outfptr, colnum, firstrow, firstelem, ntodo,
+ dvalues, status);
+ }
+
+ if (*status > 0)
+ {
+ ffpmsg("Error writing output copy of column (ffcpcl)");
+ break;
+ }
+
+ npixels -= ntodo;
+ ndone += ntodo;
+ ntodo = minvalue(npixels, maxloop);
+ }
+
+ /* free the previously allocated memory */
+ if (typecode == TLOGICAL)
+ {
+ free(lvalues);
+ }
+ else if (typecode == TSTRING)
+ {
+ for (ii = 0; ii < maxloop; ii++)
+ free(strarray[ii]);
+
+ free(strarray);
+ }
+ else
+ {
+ free(dvalues);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcprw(fitsfile *infptr, /* I - FITS file pointer to input file */
+ fitsfile *outfptr, /* I - FITS file pointer to output file */
+ LONGLONG firstrow, /* I - number of first row to copy (1 based) */
+ LONGLONG nrows, /* I - number of rows to copy */
+ int *status) /* IO - error status */
+/*
+ copy consecutive set of rows from infptr and append it in the outfptr table.
+*/
+{
+ LONGLONG innaxis1, innaxis2, outnaxis1, outnaxis2, ii, jj;
+ unsigned char *buffer;
+
+ if (*status > 0)
+ return(*status);
+
+ if (infptr->HDUposition != (infptr->Fptr)->curhdu)
+ {
+ ffmahd(infptr, (infptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((infptr->Fptr)->datastart == DATA_UNDEFINED)
+ ffrdef(infptr, status); /* rescan header */
+
+ if (outfptr->HDUposition != (outfptr->Fptr)->curhdu)
+ {
+ ffmahd(outfptr, (outfptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((outfptr->Fptr)->datastart == DATA_UNDEFINED)
+ ffrdef(outfptr, status); /* rescan header */
+
+ if (*status > 0)
+ return(*status);
+
+ if ((infptr->Fptr)->hdutype == IMAGE_HDU || (outfptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ ffpmsg
+ ("Can not copy rows to or from IMAGE HDUs (ffcprw)");
+ return(*status = NOT_TABLE);
+ }
+
+ if ( ((infptr->Fptr)->hdutype == BINARY_TBL && (outfptr->Fptr)->hdutype == ASCII_TBL) ||
+ ((infptr->Fptr)->hdutype == ASCII_TBL && (outfptr->Fptr)->hdutype == BINARY_TBL) )
+ {
+ ffpmsg
+ ("Copying rows between Binary and ASCII tables is not supported (ffcprw)");
+ return(*status = NOT_BTABLE);
+ }
+
+ ffgkyjj(infptr, "NAXIS1", &innaxis1, 0, status); /* width of input rows */
+ ffgkyjj(infptr, "NAXIS2", &innaxis2, 0, status); /* no. of input rows */
+ ffgkyjj(outfptr, "NAXIS1", &outnaxis1, 0, status); /* width of output rows */
+ ffgkyjj(outfptr, "NAXIS2", &outnaxis2, 0, status); /* no. of output rows */
+
+ if (*status > 0)
+ return(*status);
+
+ if (outnaxis1 > innaxis1) {
+ ffpmsg
+ ("Input and output tables do not have same width (ffcprw)");
+ return(*status = BAD_ROW_WIDTH);
+ }
+
+ if (firstrow + nrows - 1 > innaxis2) {
+ ffpmsg
+ ("Not enough rows in input table to copy (ffcprw)");
+ return(*status = BAD_ROW_NUM);
+ }
+
+ /* allocate buffer to hold 1 row of data */
+ buffer = malloc( (size_t) innaxis1);
+ if (!buffer) {
+ ffpmsg
+ ("Unable to allocate memory (ffcprw)");
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* copy the rows, 1 at a time */
+ jj = outnaxis2 + 1;
+ for (ii = firstrow; ii < firstrow + nrows; ii++) {
+ fits_read_tblbytes (infptr, ii, 1, innaxis1, buffer, status);
+ fits_write_tblbytes(outfptr, jj, 1, innaxis1, buffer, status);
+ jj++;
+ }
+
+ outnaxis2 += nrows;
+ fits_update_key(outfptr, TLONGLONG, "NAXIS2", &outnaxis2, 0, status);
+
+ free(buffer);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcpky(fitsfile *infptr, /* I - FITS file pointer to input file */
+ fitsfile *outfptr, /* I - FITS file pointer to output file */
+ int incol, /* I - input index number */
+ int outcol, /* I - output index number */
+ char *rootname, /* I - root name of the keyword to be copied */
+ int *status) /* IO - error status */
+/*
+ copy an indexed keyword from infptr to outfptr.
+*/
+{
+ int tstatus = 0;
+ char keyname[FLEN_KEYWORD];
+ char value[FLEN_VALUE], comment[FLEN_COMMENT], card[FLEN_CARD];
+
+ ffkeyn(rootname, incol, keyname, &tstatus);
+ if (ffgkey(infptr, keyname, value, comment, &tstatus) <= 0)
+ {
+ ffkeyn(rootname, outcol, keyname, &tstatus);
+ ffmkky(keyname, value, comment, card, status);
+ ffprec(outfptr, card, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdcol(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column to delete (1 = 1st) */
+ int *status) /* IO - error status */
+/*
+ Delete a column from a table.
+*/
+{
+ int ii, tstatus;
+ LONGLONG firstbyte, size, ndelete, nbytes, naxis1, naxis2, firstcol, delbyte, freespace;
+ LONGLONG tbcol;
+ long nblock, nspace;
+ char keyname[FLEN_KEYWORD], comm[FLEN_COMMENT];
+ tcolumn *colptr, *nextcol;
+
+ if (*status > 0)
+ return(*status);
+
+ 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 == IMAGE_HDU)
+ {
+ ffpmsg
+ ("Can only delete column from TABLE or BINTABLE extension (ffdcol)");
+ return(*status = NOT_TABLE);
+ }
+
+ if (colnum < 1 || colnum > (fptr->Fptr)->tfield )
+ return(*status = BAD_COL_NUM);
+
+ colptr = (fptr->Fptr)->tableptr;
+ colptr += (colnum - 1);
+ firstcol = colptr->tbcol; /* starting byte position of the column */
+
+ /* use column width to determine how many bytes to delete in each row */
+ if ((fptr->Fptr)->hdutype == ASCII_TBL)
+ {
+ delbyte = colptr->twidth; /* width of ASCII column */
+
+ if (colnum < (fptr->Fptr)->tfield) /* check for space between next column */
+ {
+ nextcol = colptr + 1;
+ nspace = (long) ((nextcol->tbcol) - (colptr->tbcol) - delbyte);
+ if (nspace > 0)
+ delbyte++;
+ }
+ else if (colnum > 1) /* check for space between last 2 columns */
+ {
+ nextcol = colptr - 1;
+ nspace = (long) ((colptr->tbcol) - (nextcol->tbcol) - (nextcol->twidth));
+ if (nspace > 0)
+ {
+ delbyte++;
+ firstcol--; /* delete the leading space */
+ }
+ }
+ }
+ else /* a binary table */
+ {
+ if (colnum < (fptr->Fptr)->tfield)
+ {
+ nextcol = colptr + 1;
+ delbyte = (nextcol->tbcol) - (colptr->tbcol);
+ }
+ else
+ {
+ delbyte = ((fptr->Fptr)->rowlength) - (colptr->tbcol);
+ }
+ }
+
+ naxis1 = (fptr->Fptr)->rowlength; /* current width of the table */
+ naxis2 = (fptr->Fptr)->numrows;
+
+ /* current size of table */
+ size = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
+ freespace = ((LONGLONG)delbyte * naxis2) + ((size + 2879) / 2880) * 2880 - size;
+ nblock = (long) (freespace / 2880); /* number of empty blocks to delete */
+
+ ffcdel(fptr, naxis1, naxis2, delbyte, firstcol, status); /* delete col */
+
+ /* absolute heap position */
+ firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart;
+ ndelete = (LONGLONG)delbyte * naxis2; /* size of shift */
+
+ /* shift heap up (if it exists) */
+ if ((fptr->Fptr)->heapsize > 0)
+ {
+ nbytes = (fptr->Fptr)->heapsize; /* no. of bytes to shift up */
+
+ if (ffshft(fptr, firstbyte, nbytes, -ndelete, status) > 0) /* mv heap */
+ return(*status);
+ }
+
+ /* delete the empty blocks at the end of the HDU */
+ if (nblock > 0)
+ ffdblk(fptr, nblock, status);
+
+ /* update the heap starting address */
+ (fptr->Fptr)->heapstart -= ndelete;
+
+ /* update the THEAP keyword if it exists */
+ tstatus = 0;
+ ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus);
+
+ if ((fptr->Fptr)->hdutype == ASCII_TBL)
+ {
+ /* adjust the TBCOL values of the remaining columns */
+ for (ii = 1; ii <= (fptr->Fptr)->tfield; ii++)
+ {
+ ffkeyn("TBCOL", ii, keyname, status);
+ ffgkyjj(fptr, keyname, &tbcol, comm, status);
+ if (tbcol > firstcol)
+ {
+ tbcol = tbcol - delbyte;
+ ffmkyj(fptr, keyname, tbcol, "&", status);
+ }
+ }
+ }
+
+ /* update the mandatory keywords */
+ ffmkyj(fptr, "TFIELDS", ((fptr->Fptr)->tfield) - 1, "&", status);
+ ffmkyj(fptr, "NAXIS1", naxis1 - delbyte, "&", status);
+ /*
+ delete the index keywords starting with 'T' associated with the
+ deleted column and subtract 1 from index of all higher keywords
+ */
+ ffkshf(fptr, colnum, (fptr->Fptr)->tfield, -1, status);
+
+ ffrdef(fptr, status); /* initialize the new table structure */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcins(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG naxis1, /* I - width of the table, in bytes */
+ LONGLONG naxis2, /* I - number of rows in the table */
+ LONGLONG ninsert, /* I - number of bytes to insert in each row */
+ LONGLONG bytepos, /* I - rel. position in row to insert bytes */
+ int *status) /* IO - error status */
+/*
+ Insert 'ninsert' bytes into each row of the table at position 'bytepos'.
+*/
+{
+ unsigned char buffer[10000], cfill;
+ LONGLONG newlen, fbyte, nbytes, irow, nseg, ii;
+
+ if (*status > 0)
+ return(*status);
+
+ if (naxis2 == 0)
+ return(*status); /* just return if there are 0 rows in the table */
+
+ /* select appropriate fill value */
+ if ((fptr->Fptr)->hdutype == ASCII_TBL)
+ cfill = 32; /* ASCII tables use blank fill */
+ else
+ cfill = 0; /* primary array and binary tables use zero fill */
+
+ newlen = naxis1 + ninsert;
+
+ if (newlen <= 10000)
+ {
+ /*******************************************************************
+ CASE #1: optimal case where whole new row fits in the work buffer
+ *******************************************************************/
+
+ for (ii = 0; ii < ninsert; ii++)
+ buffer[ii] = cfill; /* initialize buffer with fill value */
+
+ /* first move the trailing bytes (if any) in the last row */
+ fbyte = bytepos + 1;
+ nbytes = naxis1 - bytepos;
+ ffgtbb(fptr, naxis2, fbyte, nbytes, &buffer[ninsert], status);
+ (fptr->Fptr)->rowlength = newlen; /* new row length */
+
+ /* write the row (with leading fill bytes) in the new place */
+ nbytes += ninsert;
+ ffptbb(fptr, naxis2, fbyte, nbytes, buffer, status);
+ (fptr->Fptr)->rowlength = naxis1; /* reset to orig. value */
+
+ /* now move the rest of the rows */
+ for (irow = naxis2 - 1; irow > 0; irow--)
+ {
+ /* read the row to be shifted (work backwards thru the table) */
+ ffgtbb(fptr, irow, fbyte, naxis1, &buffer[ninsert], status);
+ (fptr->Fptr)->rowlength = newlen; /* new row length */
+
+ /* write the row (with the leading fill bytes) in the new place */
+ ffptbb(fptr, irow, fbyte, newlen, buffer, status);
+ (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
+ }
+ }
+ else
+ {
+ /*****************************************************************
+ CASE #2: whole row doesn't fit in work buffer; move row in pieces
+ ******************************************************************
+ first copy the data, then go back and write fill into the new column
+ start by copying the trailing bytes (if any) in the last row. */
+
+ nbytes = naxis1 - bytepos;
+ nseg = (nbytes + 9999) / 10000;
+ fbyte = (nseg - 1) * 10000 + bytepos + 1;
+ nbytes = naxis1 - fbyte + 1;
+
+ for (ii = 0; ii < nseg; ii++)
+ {
+ ffgtbb(fptr, naxis2, fbyte, nbytes, buffer, status);
+ (fptr->Fptr)->rowlength = newlen; /* new row length */
+
+ ffptbb(fptr, naxis2, fbyte + ninsert, nbytes, buffer, status);
+ (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
+
+ fbyte -= 10000;
+ nbytes = 10000;
+ }
+
+ /* now move the rest of the rows */
+ nseg = (naxis1 + 9999) / 10000;
+ for (irow = naxis2 - 1; irow > 0; irow--)
+ {
+ fbyte = (nseg - 1) * 10000 + bytepos + 1;
+ nbytes = naxis1 - (nseg - 1) * 10000;
+ for (ii = 0; ii < nseg; ii++)
+ {
+ /* read the row to be shifted (work backwards thru the table) */
+ ffgtbb(fptr, irow, fbyte, nbytes, buffer, status);
+ (fptr->Fptr)->rowlength = newlen; /* new row length */
+
+ /* write the row in the new place */
+ ffptbb(fptr, irow, fbyte + ninsert, nbytes, buffer, status);
+ (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
+
+ fbyte -= 10000;
+ nbytes = 10000;
+ }
+ }
+
+ /* now write the fill values into the new column */
+ nbytes = minvalue(ninsert, 10000);
+ memset(buffer, cfill, (size_t) nbytes); /* initialize with fill value */
+
+ nseg = (ninsert + 9999) / 10000;
+ (fptr->Fptr)->rowlength = newlen; /* new row length */
+
+ for (irow = 1; irow <= naxis2; irow++)
+ {
+ fbyte = bytepos + 1;
+ nbytes = ninsert - ((nseg - 1) * 10000);
+ for (ii = 0; ii < nseg; ii++)
+ {
+ ffptbb(fptr, irow, fbyte, nbytes, buffer, status);
+ fbyte += nbytes;
+ nbytes = 10000;
+ }
+ }
+ (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcdel(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG naxis1, /* I - width of the table, in bytes */
+ LONGLONG naxis2, /* I - number of rows in the table */
+ LONGLONG ndelete, /* I - number of bytes to delete in each row */
+ LONGLONG bytepos, /* I - rel. position in row to delete bytes */
+ int *status) /* IO - error status */
+/*
+ delete 'ndelete' bytes from each row of the table at position 'bytepos'. */
+{
+ unsigned char buffer[10000];
+ LONGLONG i1, i2, ii, irow, nseg;
+ LONGLONG newlen, remain, nbytes;
+
+ if (*status > 0)
+ return(*status);
+
+ if (naxis2 == 0)
+ return(*status); /* just return if there are 0 rows in the table */
+
+ newlen = naxis1 - ndelete;
+
+ if (newlen <= 10000)
+ {
+ /*******************************************************************
+ CASE #1: optimal case where whole new row fits in the work buffer
+ *******************************************************************/
+ i1 = bytepos + 1;
+ i2 = i1 + ndelete;
+ for (irow = 1; irow < naxis2; irow++)
+ {
+ ffgtbb(fptr, irow, i2, newlen, buffer, status); /* read row */
+ (fptr->Fptr)->rowlength = newlen; /* new row length */
+
+ ffptbb(fptr, irow, i1, newlen, buffer, status); /* write row */
+ (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
+ }
+
+ /* now do the last row */
+ remain = naxis1 - (bytepos + ndelete);
+
+ if (remain > 0)
+ {
+ ffgtbb(fptr, naxis2, i2, remain, buffer, status); /* read row */
+ (fptr->Fptr)->rowlength = newlen; /* new row length */
+
+ ffptbb(fptr, naxis2, i1, remain, buffer, status); /* write row */
+ (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
+ }
+ }
+ else
+ {
+ /*****************************************************************
+ CASE #2: whole row doesn't fit in work buffer; move row in pieces
+ ******************************************************************/
+
+ nseg = (newlen + 9999) / 10000;
+ for (irow = 1; irow < naxis2; irow++)
+ {
+ i1 = bytepos + 1;
+ i2 = i1 + ndelete;
+
+ nbytes = newlen - (nseg - 1) * 10000;
+ for (ii = 0; ii < nseg; ii++)
+ {
+ ffgtbb(fptr, irow, i2, nbytes, buffer, status); /* read bytes */
+ (fptr->Fptr)->rowlength = newlen; /* new row length */
+
+ ffptbb(fptr, irow, i1, nbytes, buffer, status); /* rewrite bytes */
+ (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
+
+ i1 += nbytes;
+ i2 += nbytes;
+ nbytes = 10000;
+ }
+ }
+
+ /* now do the last row */
+ remain = naxis1 - (bytepos + ndelete);
+
+ if (remain > 0)
+ {
+ nseg = (remain + 9999) / 10000;
+ i1 = bytepos + 1;
+ i2 = i1 + ndelete;
+ nbytes = remain - (nseg - 1) * 10000;
+ for (ii = 0; ii < nseg; ii++)
+ {
+ ffgtbb(fptr, naxis2, i2, nbytes, buffer, status);
+ (fptr->Fptr)->rowlength = newlen; /* new row length */
+
+ ffptbb(fptr, naxis2, i1, nbytes, buffer, status); /* write row */
+ (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
+
+ i1 += nbytes;
+ i2 += nbytes;
+ nbytes = 10000;
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffkshf(fitsfile *fptr, /* I - FITS file pointer */
+ int colmin, /* I - starting col. to be incremented; 1 = 1st */
+ int colmax, /* I - last column to be incremented */
+ int incre, /* I - shift index number by this amount */
+ int *status) /* IO - error status */
+/*
+ shift the index value on any existing column keywords
+ This routine will modify the name of any keyword that begins with 'T'
+ and has an index number in the range COLMIN - COLMAX, inclusive.
+
+ if incre is positive, then the index values will be incremented.
+ if incre is negative, then the kewords with index = COLMIN
+ will be deleted and the index of higher numbered keywords will
+ be decremented.
+*/
+{
+ int nkeys, nmore, nrec, tstatus, i1;
+ long ivalue;
+ char rec[FLEN_CARD], q[FLEN_KEYWORD], newkey[FLEN_KEYWORD];
+
+ ffghsp(fptr, &nkeys, &nmore, status); /* get number of keywords */
+
+ /* go thru header starting with the 9th keyword looking for 'TxxxxNNN' */
+
+ for (nrec = 9; nrec <= nkeys; nrec++)
+ {
+ ffgrec(fptr, nrec, rec, status);
+
+ if (rec[0] == 'T')
+ {
+ i1 = 0;
+ strncpy(q, &rec[1], 4);
+ if (!strncmp(q, "BCOL", 4) || !strncmp(q, "FORM", 4) ||
+ !strncmp(q, "TYPE", 4) || !strncmp(q, "SCAL", 4) ||
+ !strncmp(q, "UNIT", 4) || !strncmp(q, "NULL", 4) ||
+ !strncmp(q, "ZERO", 4) || !strncmp(q, "DISP", 4) ||
+ !strncmp(q, "LMIN", 4) || !strncmp(q, "LMAX", 4) ||
+ !strncmp(q, "DMIN", 4) || !strncmp(q, "DMAX", 4) ||
+ !strncmp(q, "CTYP", 4) || !strncmp(q, "CRPX", 4) ||
+ !strncmp(q, "CRVL", 4) || !strncmp(q, "CDLT", 4) ||
+ !strncmp(q, "CROT", 4) || !strncmp(q, "CUNI", 4) )
+ i1 = 5;
+ else if (!strncmp(rec, "TDIM", 4) )
+ i1 = 4;
+
+ if (i1)
+ {
+ /* try reading the index number suffix */
+ q[0] = '\0';
+ strncat(q, &rec[i1], 8 - i1);
+
+ tstatus = 0;
+ ffc2ii(q, &ivalue, &tstatus);
+
+ if (tstatus == 0 && ivalue >= colmin && ivalue <= colmax)
+ {
+ if (incre <= 0 && ivalue == colmin)
+ {
+ ffdrec(fptr, nrec, status); /* delete keyword */
+ nkeys = nkeys - 1;
+ nrec = nrec - 1;
+ }
+ else
+ {
+ ivalue = ivalue + incre;
+ q[0] = '\0';
+ strncat(q, rec, i1);
+
+ ffkeyn(q, ivalue, newkey, status);
+ strncpy(rec, " ", 8); /* erase old keyword name */
+ i1 = strlen(newkey);
+ strncpy(rec, newkey, i1); /* overwrite new keyword name */
+ ffmrec(fptr, nrec, rec, status); /* modify the record */
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffshft(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG firstbyte, /* I - position of first byte in block to shift */
+ LONGLONG nbytes, /* I - size of block of bytes to shift */
+ LONGLONG nshift, /* I - size of shift in bytes (+ or -) */
+ int *status) /* IO - error status */
+/*
+ Shift block of bytes by nshift bytes (positive or negative).
+ A positive nshift value moves the block down further in the file, while a
+ negative value shifts the block towards the beginning of the file.
+*/
+{
+#define shftbuffsize 100000
+ long ntomov;
+ LONGLONG ptr, ntodo;
+ char buffer[shftbuffsize];
+
+ if (*status > 0)
+ return(*status);
+
+ ntodo = nbytes; /* total number of bytes to shift */
+
+ if (nshift > 0)
+ /* start at the end of the block and work backwards */
+ ptr = firstbyte + nbytes;
+ else
+ /* start at the beginning of the block working forwards */
+ ptr = firstbyte;
+
+ while (ntodo)
+ {
+ /* number of bytes to move at one time */
+ ntomov = (long) (minvalue(ntodo, shftbuffsize));
+
+ if (nshift > 0) /* if moving block down ... */
+ ptr -= ntomov;
+
+ /* move to position and read the bytes to be moved */
+
+ ffmbyt(fptr, ptr, REPORT_EOF, status);
+ ffgbyt(fptr, ntomov, buffer, status);
+
+ /* move by shift amount and write the bytes */
+ ffmbyt(fptr, ptr + nshift, IGNORE_EOF, status);
+ if (ffpbyt(fptr, ntomov, buffer, status) > 0)
+ {
+ ffpmsg("Error while shifting block (ffshft)");
+ return(*status);
+ }
+
+ ntodo -= ntomov;
+ if (nshift < 0) /* if moving block up ... */
+ ptr += ntomov;
+ }
+
+ /* now overwrite the old data with fill */
+ if ((fptr->Fptr)->hdutype == ASCII_TBL)
+ memset(buffer, 32, shftbuffsize); /* fill ASCII tables with spaces */
+ else
+ memset(buffer, 0, shftbuffsize); /* fill other HDUs with zeros */
+
+
+ if (nshift < 0)
+ {
+ ntodo = -nshift;
+ /* point to the end of the shifted block */
+ ptr = firstbyte + nbytes + nshift;
+ }
+ else
+ {
+ ntodo = nshift;
+ /* point to original beginning of the block */
+ ptr = firstbyte;
+ }
+
+ ffmbyt(fptr, ptr, REPORT_EOF, status);
+
+ while (ntodo)
+ {
+ ntomov = (long) (minvalue(ntodo, shftbuffsize));
+ ffpbyt(fptr, ntomov, buffer, status);
+ ntodo -= ntomov;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/edithdu.c b/src/plugins/cfitsio/edithdu.c
new file mode 100644
index 0000000..385bbe9
--- /dev/null
+++ b/src/plugins/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);
+}
+
diff --git a/src/plugins/cfitsio/eval_defs.h b/src/plugins/cfitsio/eval_defs.h
new file mode 100644
index 0000000..09c066b
--- /dev/null
+++ b/src/plugins/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
diff --git a/src/plugins/cfitsio/eval_f.c b/src/plugins/cfitsio/eval_f.c
new file mode 100644
index 0000000..f9bdd05
--- /dev/null
+++ b/src/plugins/cfitsio/eval_f.c
@@ -0,0 +1,2823 @@
+/************************************************************************/
+/* */
+/* 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 */
+/* Peter D Wilson Aug 1999 Add row-offset capability */
+/* Peter D Wilson Sep 1999 Add row-range capability to ffcalc_rng */
+/* */
+/************************************************************************/
+
+#include <limits.h>
+#include <ctype.h>
+#include "eval_defs.h"
+#include "region.h"
+
+typedef struct {
+ int datatype; /* Data type to cast parse results into for user */
+ void *dataPtr; /* Pointer to array of results, NULL if to use iterCol */
+ void *nullPtr; /* Pointer to nulval, use zero if NULL */
+ long maxRows; /* Max No. of rows to process, -1=all, 0=1 iteration */
+ int anyNull; /* Flag indicating at least 1 undef value encountered */
+} parseInfo;
+
+/* Internal routines needed to allow the evaluator to operate on FITS data */
+
+static void Setup_DataArrays( int nCols, iteratorCol *cols,
+ long fRow, long nRows );
+static int find_column( char *colName, void *itslval );
+static int find_keywd ( char *key, void *itslval );
+static int allocateCol( int nCol, int *status );
+static int load_column( int varNum, long fRow, long nRows,
+ void *data, char *undef );
+
+static int DEBUG_PIXFILTER;
+
+#define FREE(x) { if (x) free(x); else printf("invalid free(" #x ") at %s:%d\n", __FILE__, __LINE__); }
+
+/*---------------------------------------------------------------------------*/
+int fffrow( fitsfile *fptr, /* I - Input FITS file */
+ char *expr, /* I - Boolean expression */
+ long firstrow, /* I - First row of table to eval */
+ long nrows, /* I - Number of rows to evaluate */
+ long *n_good_rows, /* O - Number of rows eval to True */
+ char *row_status, /* O - Array of boolean results */
+ int *status ) /* O - Error status */
+/* */
+/* Evaluate a boolean expression using the indicated rows, returning an */
+/* array of flags indicating which rows evaluated to TRUE/FALSE */
+/*---------------------------------------------------------------------------*/
+{
+ parseInfo Info;
+ int naxis, constant;
+ long nelem, naxes[MAXDIMS], elem;
+ char result;
+
+ if( *status ) return( *status );
+
+ FFLOCK;
+ if( ffiprs( fptr, 0, expr, MAXDIMS, &Info.datatype, &nelem, &naxis,
+ naxes, status ) ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+ if( nelem<0 ) {
+ constant = 1;
+ nelem = -nelem;
+ } else
+ constant = 0;
+
+ if( Info.datatype!=TLOGICAL || nelem!=1 ) {
+ ffcprs();
+ ffpmsg("Expression does not evaluate to a logical scalar.");
+ FFUNLOCK;
+ return( *status = PARSE_BAD_TYPE );
+ }
+
+ if( constant ) { /* No need to call parser... have result from ffiprs */
+ result = gParse.Nodes[gParse.resultNode].value.data.log;
+ *n_good_rows = nrows;
+ for( elem=0; elem<nrows; elem++ )
+ row_status[elem] = result;
+ } else {
+ firstrow = (firstrow>1 ? firstrow : 1);
+ Info.dataPtr = row_status;
+ Info.nullPtr = NULL;
+ Info.maxRows = nrows;
+
+ if( ffiter( gParse.nCols, gParse.colData, firstrow-1, 0,
+ parse_data, (void*)&Info, status ) == -1 )
+ *status = 0; /* -1 indicates exitted without error before end... OK */
+
+ if( *status ) {
+
+ /***********************/
+ /* Error... Do nothing */
+ /***********************/
+
+ } else {
+
+ /***********************************/
+ /* Count number of good rows found */
+ /***********************************/
+
+ *n_good_rows = 0L;
+ for( elem=0; elem<Info.maxRows; elem++ ) {
+ if( row_status[elem]==1 ) ++*n_good_rows;
+ }
+ }
+ }
+
+ ffcprs();
+ FFUNLOCK;
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int ffsrow( fitsfile *infptr, /* I - Input FITS file */
+ fitsfile *outfptr, /* I - Output FITS file */
+ char *expr, /* I - Boolean expression */
+ int *status ) /* O - Error status */
+/* */
+/* Evaluate an expression on all rows of a table. If the input and output */
+/* files are not the same, copy the TRUE rows to the output file. If the */
+/* files are the same, delete the FALSE rows (preserve the TRUE rows). */
+/* Can copy rows between extensions of the same file, *BUT* if output */
+/* extension is before the input extension, the second extension *MUST* be */
+/* opened using ffreopen, so that CFITSIO can handle changing file lengths. */
+/*--------------------------------------------------------------------------*/
+{
+ parseInfo Info;
+ int naxis, constant;
+ long nelem, rdlen, naxes[MAXDIMS], maxrows, nbuff, nGood, inloc, outloc;
+ LONGLONG ntodo, inbyteloc, outbyteloc, hsize;
+ long freespace;
+ unsigned char *buffer, result;
+ struct {
+ LONGLONG rowLength, numRows, heapSize;
+ LONGLONG dataStart, heapStart;
+ } inExt, outExt;
+
+ if( *status ) return( *status );
+
+ FFLOCK;
+ if( ffiprs( infptr, 0, expr, MAXDIMS, &Info.datatype, &nelem, &naxis,
+ naxes, status ) ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+
+ if( nelem<0 ) {
+ constant = 1;
+ nelem = -nelem;
+ } else
+ constant = 0;
+
+ /**********************************************************************/
+ /* Make sure expression evaluates to the right type... logical scalar */
+ /**********************************************************************/
+
+ if( Info.datatype!=TLOGICAL || nelem!=1 ) {
+ ffcprs();
+ ffpmsg("Expression does not evaluate to a logical scalar.");
+ FFUNLOCK;
+ return( *status = PARSE_BAD_TYPE );
+ }
+
+ /***********************************************************/
+ /* Extract various table information from each extension */
+ /***********************************************************/
+
+ if( infptr->HDUposition != (infptr->Fptr)->curhdu )
+ ffmahd( infptr, (infptr->HDUposition) + 1, NULL, status );
+ if( *status ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+ inExt.rowLength = (long) (infptr->Fptr)->rowlength;
+ inExt.numRows = (infptr->Fptr)->numrows;
+ inExt.heapSize = (infptr->Fptr)->heapsize;
+ if( inExt.numRows == 0 ) { /* Nothing to copy */
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+
+ if( outfptr->HDUposition != (outfptr->Fptr)->curhdu )
+ ffmahd( outfptr, (outfptr->HDUposition) + 1, NULL, status );
+ if( (outfptr->Fptr)->datastart < 0 )
+ ffrdef( outfptr, status );
+ if( *status ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+ outExt.rowLength = (long) (outfptr->Fptr)->rowlength;
+ outExt.numRows = (outfptr->Fptr)->numrows;
+ if( !outExt.numRows )
+ (outfptr->Fptr)->heapsize = 0L;
+ outExt.heapSize = (outfptr->Fptr)->heapsize;
+
+ if( inExt.rowLength != outExt.rowLength ) {
+ ffpmsg("Output table has different row length from input");
+ ffcprs();
+ FFUNLOCK;
+ return( *status = PARSE_BAD_OUTPUT );
+ }
+
+ /***********************************/
+ /* Fill out Info data for parser */
+ /***********************************/
+
+ Info.dataPtr = (char *)malloc( (size_t) ((inExt.numRows + 1) * sizeof(char)) );
+ Info.nullPtr = NULL;
+ Info.maxRows = (long) inExt.numRows;
+ if( !Info.dataPtr ) {
+ ffpmsg("Unable to allocate memory for row selection");
+ ffcprs();
+ FFUNLOCK;
+ return( *status = MEMORY_ALLOCATION );
+ }
+
+ /* make sure array is zero terminated */
+ ((char*)Info.dataPtr)[inExt.numRows] = 0;
+
+ if( constant ) { /* Set all rows to the same value from constant result */
+
+ result = gParse.Nodes[gParse.resultNode].value.data.log;
+ for( ntodo = 0; ntodo<inExt.numRows; ntodo++ )
+ ((char*)Info.dataPtr)[ntodo] = result;
+ nGood = (long) (result ? inExt.numRows : 0);
+
+ } else {
+
+ ffiter( gParse.nCols, gParse.colData, 0L, 0L,
+ parse_data, (void*)&Info, status );
+
+ nGood = 0;
+ for( ntodo = 0; ntodo<inExt.numRows; ntodo++ )
+ if( ((char*)Info.dataPtr)[ntodo] ) nGood++;
+ }
+
+ if( *status ) {
+ /* Error... Do nothing */
+ } else {
+ rdlen = (long) inExt.rowLength;
+ buffer = (unsigned char *)malloc(maxvalue(500000,rdlen) * sizeof(char) );
+ if( buffer==NULL ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status=MEMORY_ALLOCATION );
+ }
+ maxrows = maxvalue( (500000L/rdlen), 1);
+ nbuff = 0;
+ inloc = 1;
+ if( infptr==outfptr ) { /* Skip initial good rows if input==output file */
+ while( ((char*)Info.dataPtr)[inloc-1] ) inloc++;
+ outloc = inloc;
+ } else {
+ outloc = (long) (outExt.numRows + 1);
+ if (outloc > 1)
+ ffirow( outfptr, outExt.numRows, nGood, status );
+ }
+
+ do {
+ if( ((char*)Info.dataPtr)[inloc-1] ) {
+ ffgtbb( infptr, inloc, 1L, rdlen, buffer+rdlen*nbuff, status );
+ nbuff++;
+ if( nbuff==maxrows ) {
+ ffptbb( outfptr, outloc, 1L, rdlen*nbuff, buffer, status );
+ outloc += nbuff;
+ nbuff = 0;
+ }
+ }
+ inloc++;
+ } while( !*status && inloc<=inExt.numRows );
+
+ if( nbuff ) {
+ ffptbb( outfptr, outloc, 1L, rdlen*nbuff, buffer, status );
+ outloc += nbuff;
+ }
+
+ if( infptr==outfptr ) {
+
+ if( outloc<=inExt.numRows )
+ ffdrow( infptr, outloc, inExt.numRows-outloc+1, status );
+
+ } else if( inExt.heapSize && nGood ) {
+
+ /* Copy heap, if it exists and at least one row copied */
+
+ /********************************************************/
+ /* Get location information from the output extension */
+ /********************************************************/
+
+ if( outfptr->HDUposition != (outfptr->Fptr)->curhdu )
+ ffmahd( outfptr, (outfptr->HDUposition) + 1, NULL, status );
+ outExt.dataStart = (outfptr->Fptr)->datastart;
+ outExt.heapStart = (outfptr->Fptr)->heapstart;
+
+ /*************************************************/
+ /* Insert more space into outfptr if necessary */
+ /*************************************************/
+
+ hsize = outExt.heapStart + outExt.heapSize;
+ freespace = (long) (( ( (hsize + 2879) / 2880) * 2880) - hsize);
+ ntodo = inExt.heapSize;
+
+ if ( (freespace - ntodo) < 0) { /* not enough existing space? */
+ ntodo = (ntodo - freespace + 2879) / 2880; /* number of blocks */
+ ffiblk(outfptr, (long) ntodo, 1, status); /* insert the blocks */
+ }
+ ffukyj( outfptr, "PCOUNT", inExt.heapSize+outExt.heapSize,
+ NULL, status );
+
+ /*******************************************************/
+ /* Get location information from the input extension */
+ /*******************************************************/
+
+ if( infptr->HDUposition != (infptr->Fptr)->curhdu )
+ ffmahd( infptr, (infptr->HDUposition) + 1, NULL, status );
+ inExt.dataStart = (infptr->Fptr)->datastart;
+ inExt.heapStart = (infptr->Fptr)->heapstart;
+
+ /**********************************/
+ /* Finally copy heap to outfptr */
+ /**********************************/
+
+ ntodo = inExt.heapSize;
+ inbyteloc = inExt.heapStart + inExt.dataStart;
+ outbyteloc = outExt.heapStart + outExt.dataStart + outExt.heapSize;
+
+ while ( ntodo && !*status ) {
+ rdlen = (long) minvalue(ntodo,500000);
+ ffmbyt( infptr, inbyteloc, REPORT_EOF, status );
+ ffgbyt( infptr, rdlen, buffer, status );
+ ffmbyt( outfptr, outbyteloc, IGNORE_EOF, status );
+ ffpbyt( outfptr, rdlen, buffer, status );
+ inbyteloc += rdlen;
+ outbyteloc += rdlen;
+ ntodo -= rdlen;
+ }
+
+ /***********************************************************/
+ /* But must update DES if data is being appended to a */
+ /* pre-existing heap space. Edit each new entry in file */
+ /***********************************************************/
+
+ if( outExt.heapSize ) {
+ LONGLONG repeat, offset, j;
+ int i;
+ for( i=1; i<=(outfptr->Fptr)->tfield; i++ ) {
+ if( (outfptr->Fptr)->tableptr[i-1].tdatatype<0 ) {
+ for( j=outExt.numRows+1; j<=outExt.numRows+nGood; j++ ) {
+ ffgdesll( outfptr, i, j, &repeat, &offset, status );
+ offset += outExt.heapSize;
+ ffpdes( outfptr, i, j, repeat, offset, status );
+ }
+ }
+ }
+ }
+
+ } /* End of HEAP copy */
+
+ FREE(buffer);
+ }
+
+ FREE(Info.dataPtr);
+ ffcprs();
+
+ ffcmph(outfptr, status); /* compress heap, deleting any orphaned data */
+ FFUNLOCK;
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffcrow( fitsfile *fptr, /* I - Input FITS file */
+ int datatype, /* I - Datatype to return results as */
+ char *expr, /* I - Arithmetic expression */
+ long firstrow, /* I - First row to evaluate */
+ long nelements, /* I - Number of elements to return */
+ void *nulval, /* I - Ptr to value to use as UNDEF */
+ void *array, /* O - Array of results */
+ int *anynul, /* O - Were any UNDEFs encountered? */
+ int *status ) /* O - Error status */
+/* */
+/* Calculate an expression for the indicated rows of a table, returning */
+/* the results, cast as datatype (TSHORT, TDOUBLE, etc), in array. If */
+/* nulval==NULL, UNDEFs will be zeroed out. For vector results, the number */
+/* of elements returned may be less than nelements if nelements is not an */
+/* even multiple of the result dimension. Call fftexp to obtain the */
+/* dimensions of the results. */
+/*---------------------------------------------------------------------------*/
+{
+ parseInfo Info;
+ int naxis;
+ long nelem1, naxes[MAXDIMS];
+
+ if( *status ) return( *status );
+
+ FFLOCK;
+ if( ffiprs( fptr, 0, expr, MAXDIMS, &Info.datatype, &nelem1, &naxis,
+ naxes, status ) ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+ if( nelem1<0 ) nelem1 = - nelem1;
+
+ if( nelements<nelem1 ) {
+ ffcprs();
+ ffpmsg("Array not large enough to hold at least one row of data.");
+ FFUNLOCK;
+ return( *status = PARSE_LRG_VECTOR );
+ }
+
+ firstrow = (firstrow>1 ? firstrow : 1);
+
+ if( datatype ) Info.datatype = datatype;
+
+ Info.dataPtr = array;
+ Info.nullPtr = nulval;
+ Info.maxRows = nelements / nelem1;
+
+ if( ffiter( gParse.nCols, gParse.colData, firstrow-1, 0,
+ parse_data, (void*)&Info, status ) == -1 )
+ *status=0; /* -1 indicates exitted without error before end... OK */
+
+ *anynul = Info.anyNull;
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+}
+
+/*--------------------------------------------------------------------------*/
+int ffcalc( fitsfile *infptr, /* I - Input FITS file */
+ char *expr, /* I - Arithmetic expression */
+ fitsfile *outfptr, /* I - Output fits file */
+ char *parName, /* I - Name of output parameter */
+ char *parInfo, /* I - Extra information on parameter */
+ int *status ) /* O - Error status */
+/* */
+/* Evaluate an expression for all rows of a table. Call ffcalc_rng with */
+/* a row range of 1-MAX. */
+{
+ long start=1, end=LONG_MAX;
+
+ return ffcalc_rng( infptr, expr, outfptr, parName, parInfo,
+ 1, &start, &end, status );
+}
+
+/*--------------------------------------------------------------------------*/
+int ffcalc_rng( fitsfile *infptr, /* I - Input FITS file */
+ char *expr, /* I - Arithmetic expression */
+ fitsfile *outfptr, /* I - Output fits file */
+ char *parName, /* I - Name of output parameter */
+ char *parInfo, /* I - Extra information on parameter */
+ int nRngs, /* I - Row range info */
+ long *start, /* I - Row range info */
+ long *end, /* I - Row range info */
+ int *status ) /* O - Error status */
+/* */
+/* Evaluate an expression using the data in the input FITS file and place */
+/* the results into either a column or keyword in the output fits file, */
+/* depending on the value of parName (keywords normally prefixed with '#') */
+/* and whether the expression evaluates to a constant or a table column. */
+/* The logic is as follows: */
+/* (1) If a column exists with name, parName, put results there. */
+/* (2) If parName starts with '#', as in #NAXIS, put result there, */
+/* with parInfo used as the comment. If expression does not evaluate */
+/* to a constant, flag an error. */
+/* (3) If a keyword exists with name, parName, and expression is a */
+/* constant, put result there, using parInfo as the new comment. */
+/* (4) Else, create a new column with name parName and TFORM parInfo. */
+/* If parInfo is NULL, use a default data type for the column. */
+/*--------------------------------------------------------------------------*/
+{
+ parseInfo Info;
+ int naxis, constant, typecode, newNullKwd=0;
+ long nelem, naxes[MAXDIMS], repeat, width;
+ int col_cnt, colNo;
+ Node *result;
+ char card[81], tform[16], nullKwd[9], tdimKwd[9];
+
+ if( *status ) return( *status );
+
+ FFLOCK;
+ if( ffiprs( infptr, 0, expr, MAXDIMS, &Info.datatype, &nelem, &naxis,
+ naxes, status ) ) {
+
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+ if( nelem<0 ) {
+ constant = 1;
+ nelem = -nelem;
+ } else
+ constant = 0;
+
+ /* Case (1): If column exists put it there */
+
+ colNo = 0;
+ if( ffgcno( outfptr, CASEINSEN, parName, &colNo, status )==COL_NOT_FOUND ) {
+
+ /* Output column doesn't exist. Test for keyword. */
+
+ /* Case (2): Does parName indicate result should be put into keyword */
+
+ *status = 0;
+ if( parName[0]=='#' ) {
+ if( ! constant ) {
+ ffcprs();
+ ffpmsg( "Cannot put tabular result into keyword (ffcalc)" );
+ FFUNLOCK;
+ return( *status = PARSE_BAD_TYPE );
+ }
+ parName++;
+
+ } else if( constant ) {
+
+ /* Case (3): Does a keyword named parName already exist */
+
+ if( ffgcrd( outfptr, parName, card, status )==KEY_NO_EXIST ) {
+ colNo = -1;
+ } else if( *status ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+
+ } else
+ colNo = -1;
+
+ if( colNo<0 ) {
+
+ /* Case (4): Create new column */
+
+ *status = 0;
+ ffgncl( outfptr, &colNo, status );
+ colNo++;
+ if( parInfo==NULL || *parInfo=='\0' ) {
+ /* Figure out best default column type */
+ if( gParse.hdutype==BINARY_TBL ) {
+ sprintf(tform,"%ld",nelem);
+ switch( Info.datatype ) {
+ case TLOGICAL: strcat(tform,"L"); break;
+ case TLONG: strcat(tform,"J"); break;
+ case TDOUBLE: strcat(tform,"D"); break;
+ case TSTRING: strcat(tform,"A"); break;
+ case TBIT: strcat(tform,"X"); break;
+ case TLONGLONG: strcat(tform,"K"); break;
+ }
+ } else {
+ switch( Info.datatype ) {
+ case TLOGICAL:
+ ffcprs();
+ ffpmsg("Cannot create LOGICAL column in ASCII table");
+ FFUNLOCK;
+ return( *status = NOT_BTABLE );
+ case TLONG: strcpy(tform,"I11"); break;
+ case TDOUBLE: strcpy(tform,"D23.15"); break;
+ case TSTRING:
+ case TBIT: sprintf(tform,"A%ld",nelem); break;
+ }
+ }
+ parInfo = tform;
+ } else if( !(isdigit((int) *parInfo)) && gParse.hdutype==BINARY_TBL ) {
+ if( Info.datatype==TBIT && *parInfo=='B' )
+ nelem = (nelem+7)/8;
+ sprintf(tform,"%ld%s",nelem,parInfo);
+ parInfo = tform;
+ }
+ fficol( outfptr, colNo, parName, parInfo, status );
+ if( naxis>1 )
+ ffptdm( outfptr, colNo, naxis, naxes, status );
+
+ /* Setup TNULLn keyword in case NULLs are encountered */
+
+ ffkeyn("TNULL", colNo, nullKwd, status);
+ if( ffgcrd( outfptr, nullKwd, card, status )==KEY_NO_EXIST ) {
+ *status = 0;
+ if( gParse.hdutype==BINARY_TBL ) {
+ LONGLONG nullVal=0;
+ fits_binary_tform( parInfo, &typecode, &repeat, &width, status );
+ if( typecode==TBYTE )
+ nullVal = UCHAR_MAX;
+ else if( typecode==TSHORT )
+ nullVal = SHRT_MIN;
+ else if( typecode==TINT )
+ nullVal = INT_MIN;
+ else if( typecode==TLONG )
+ nullVal = LONG_MIN;
+ else if( typecode==TLONGLONG )
+ nullVal = LONGLONG_MIN;
+
+ if( nullVal ) {
+ ffpkyj( outfptr, nullKwd, nullVal, "Null value", status );
+ fits_set_btblnull( outfptr, colNo, nullVal, status );
+ newNullKwd = 1;
+ }
+ } else if( gParse.hdutype==ASCII_TBL ) {
+ ffpkys( outfptr, nullKwd, "NULL", "Null value string", status );
+ fits_set_atblnull( outfptr, colNo, "NULL", status );
+ newNullKwd = 1;
+ }
+ }
+
+ }
+
+ } else if( *status ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ } else {
+
+ /********************************************************/
+ /* Check if a TDIM keyword should be written/updated. */
+ /********************************************************/
+
+ ffkeyn("TDIM", colNo, tdimKwd, status);
+ ffgcrd( outfptr, tdimKwd, card, status );
+ if( *status==0 ) {
+ /* TDIM exists, so update it with result's dimension */
+ ffptdm( outfptr, colNo, naxis, naxes, status );
+ } else if( *status==KEY_NO_EXIST ) {
+ /* TDIM does not exist, so clear error stack and */
+ /* write a TDIM only if result is multi-dimensional */
+ *status = 0;
+ ffcmsg();
+ if( naxis>1 )
+ ffptdm( outfptr, colNo, naxis, naxes, status );
+ }
+ if( *status ) {
+ /* Either some other error happened in ffgcrd */
+ /* or one happened in ffptdm */
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+
+ }
+
+ if( colNo>0 ) {
+
+ /* Output column exists (now)... put results into it */
+
+ int anyNull = 0;
+ int nPerLp, i;
+ long totaln;
+
+ ffgkyj(infptr, "NAXIS2", &totaln, 0, status);
+
+ /*************************************/
+ /* Create new iterator Output Column */
+ /*************************************/
+
+ col_cnt = gParse.nCols;
+ if( allocateCol( col_cnt, status ) ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+
+ fits_iter_set_by_num( gParse.colData+col_cnt, outfptr,
+ colNo, 0, OutputCol );
+ gParse.nCols++;
+
+ for( i=0; i<nRngs; i++ ) {
+ Info.dataPtr = NULL;
+ Info.maxRows = end[i]-start[i]+1;
+
+ /*
+ If there is only 1 range, and it includes all the rows,
+ and there are 10 or more rows, then set nPerLp = 0 so
+ that the iterator function will dynamically choose the
+ most efficient number of rows to process in each loop.
+ Otherwise, set nPerLp to the number of rows in this range.
+ */
+
+ if( (Info.maxRows >= 10) && (nRngs == 1) &&
+ (start[0] == 1) && (end[0] == totaln))
+ nPerLp = 0;
+ else
+ nPerLp = Info.maxRows;
+
+ if( ffiter( gParse.nCols, gParse.colData, start[i]-1,
+ nPerLp, parse_data, (void*)&Info, status ) == -1 )
+ *status = 0;
+ else if( *status ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+ if( Info.anyNull ) anyNull = 1;
+ }
+
+ if( newNullKwd && !anyNull ) {
+ ffdkey( outfptr, nullKwd, status );
+ }
+
+ } else {
+
+ /* Put constant result into keyword */
+
+ result = gParse.Nodes + gParse.resultNode;
+ switch( Info.datatype ) {
+ case TDOUBLE:
+ ffukyd( outfptr, parName, result->value.data.dbl, 15,
+ parInfo, status );
+ break;
+ case TLONG:
+ ffukyj( outfptr, parName, result->value.data.lng, parInfo, status );
+ break;
+ case TLOGICAL:
+ ffukyl( outfptr, parName, result->value.data.log, parInfo, status );
+ break;
+ case TBIT:
+ case TSTRING:
+ ffukys( outfptr, parName, result->value.data.str, parInfo, status );
+ break;
+ }
+ }
+
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+}
+
+/*--------------------------------------------------------------------------*/
+int fftexp( fitsfile *fptr, /* I - Input FITS file */
+ char *expr, /* I - Arithmetic expression */
+ int maxdim, /* I - Max Dimension of naxes */
+ int *datatype, /* O - Data type of result */
+ long *nelem, /* O - Vector length of result */
+ int *naxis, /* O - # of dimensions of result */
+ long *naxes, /* O - Size of each dimension */
+ int *status ) /* O - Error status */
+/* */
+/* Evaluate the given expression and return information on the result. */
+/*--------------------------------------------------------------------------*/
+{
+ FFLOCK;
+ ffiprs( fptr, 0, expr, maxdim, datatype, nelem, naxis, naxes, status );
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+}
+
+/*--------------------------------------------------------------------------*/
+int ffiprs( fitsfile *fptr, /* I - Input FITS file */
+ int compressed, /* I - Is FITS file hkunexpanded? */
+ char *expr, /* I - Arithmetic expression */
+ int maxdim, /* I - Max Dimension of naxes */
+ int *datatype, /* O - Data type of result */
+ long *nelem, /* O - Vector length of result */
+ int *naxis, /* O - # of dimensions of result */
+ long *naxes, /* O - Size of each dimension */
+ int *status ) /* O - Error status */
+/* */
+/* Initialize the parser and determine what type of result the expression */
+/* produces. */
+/*--------------------------------------------------------------------------*/
+{
+ Node *result;
+ int i,lexpr, tstatus = 0;
+ int xaxis, bitpix;
+ long xaxes[9];
+ static iteratorCol dmyCol;
+
+ if( *status ) return( *status );
+
+ /* make sure all internal structures for this HDU are current */
+ if ( ffrdef(fptr, status) ) return(*status);
+
+ /* Initialize the Parser structure */
+
+ gParse.def_fptr = fptr;
+ gParse.compressed = compressed;
+ gParse.nCols = 0;
+ gParse.colData = NULL;
+ gParse.varData = NULL;
+ gParse.getData = find_column;
+ gParse.loadData = load_column;
+ gParse.Nodes = NULL;
+ gParse.nNodesAlloc= 0;
+ gParse.nNodes = 0;
+ gParse.hdutype = 0;
+ gParse.status = 0;
+
+ fits_get_hdu_type(fptr, &gParse.hdutype, status );
+
+ if (gParse.hdutype == IMAGE_HDU) {
+
+ fits_get_img_param(fptr, 9, &bitpix, &xaxis, xaxes, status);
+ if (*status) {
+ ffpmsg("ffiprs: unable to get image dimensions");
+ return( *status );
+ }
+ gParse.totalRows = xaxis > 0 ? 1 : 0;
+ for (i = 0; i < xaxis; ++i)
+ gParse.totalRows *= xaxes[i];
+ if (DEBUG_PIXFILTER)
+ printf("naxis=%d, gParse.totalRows=%ld\n", xaxis, gParse.totalRows);
+ }
+ else if( ffgkyj(fptr, "NAXIS2", &gParse.totalRows, 0, &tstatus) )
+ {
+ /* this might be a 1D or null image with no NAXIS2 keyword */
+ gParse.totalRows = 0;
+ }
+
+
+ /* Copy expression into parser... read from file if necessary */
+
+
+ if( expr[0]=='@' ) {
+ if( ffimport_file( expr+1, &gParse.expr, status ) ) return( *status );
+ lexpr = strlen(gParse.expr);
+ } else {
+ lexpr = strlen(expr);
+ gParse.expr = (char*)malloc( (2+lexpr)*sizeof(char));
+ strcpy(gParse.expr,expr);
+ }
+ strcat(gParse.expr + lexpr,"\n");
+ gParse.index = 0;
+ gParse.is_eobuf = 0;
+
+ /* Parse the expression, building the Nodes and determing */
+ /* which columns are needed and what data type is returned */
+
+ ffrestart(NULL);
+ if( ffparse() ) {
+ return( *status = PARSE_SYNTAX_ERR );
+ }
+ /* Check results */
+
+ *status = gParse.status;
+ if( *status ) return(*status);
+
+ if( !gParse.nNodes ) {
+ ffpmsg("Blank expression");
+ return( *status = PARSE_SYNTAX_ERR );
+ }
+ if( !gParse.nCols ) {
+ dmyCol.fptr = fptr; /* This allows iterator to know value of */
+ gParse.colData = &dmyCol; /* fptr when no columns are referenced */
+ }
+
+ result = gParse.Nodes + gParse.resultNode;
+
+ *naxis = result->value.naxis;
+ *nelem = result->value.nelem;
+ for( i=0; i<*naxis && i<maxdim; i++ )
+ naxes[i] = result->value.naxes[i];
+
+ switch( result->type ) {
+ case BOOLEAN:
+ *datatype = TLOGICAL;
+ break;
+ case LONG:
+ *datatype = TLONG;
+ break;
+ case DOUBLE:
+ *datatype = TDOUBLE;
+ break;
+ case BITSTR:
+ *datatype = TBIT;
+ break;
+ case STRING:
+ *datatype = TSTRING;
+ break;
+ default:
+ *datatype = 0;
+ ffpmsg("Bad return data type");
+ *status = gParse.status = PARSE_BAD_TYPE;
+ break;
+ }
+ gParse.datatype = *datatype;
+ FREE(gParse.expr);
+
+ if( result->operation==CONST_OP ) *nelem = - *nelem;
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+void ffcprs( void ) /* No parameters */
+/* */
+/* Clear the parser, making it ready to accept a new expression. */
+/*--------------------------------------------------------------------------*/
+{
+ int col, node, i;
+
+ if( gParse.nCols > 0 ) {
+ FREE( gParse.colData );
+ for( col=0; col<gParse.nCols; col++ ) {
+ if( gParse.varData[col].undef == NULL ) continue;
+ if( gParse.varData[col].type == BITSTR )
+ FREE( ((char**)gParse.varData[col].data)[0] );
+ free( gParse.varData[col].undef );
+ }
+ FREE( gParse.varData );
+ gParse.nCols = 0;
+ }
+
+ if( gParse.nNodes > 0 ) {
+ node = gParse.nNodes;
+ while( node-- ) {
+ if( gParse.Nodes[node].operation==gtifilt_fct ) {
+ i = gParse.Nodes[node].SubNodes[0];
+ if (gParse.Nodes[ i ].value.data.ptr)
+ FREE( gParse.Nodes[ i ].value.data.ptr );
+ }
+ else if( gParse.Nodes[node].operation==regfilt_fct ) {
+ i = gParse.Nodes[node].SubNodes[0];
+ fits_free_region( (SAORegion *)gParse.Nodes[ i ].value.data.ptr );
+ }
+ }
+ gParse.nNodes = 0;
+ }
+ if( gParse.Nodes ) free( gParse.Nodes );
+ gParse.Nodes = NULL;
+
+ gParse.hdutype = ANY_HDU;
+ gParse.pixFilter = 0;
+}
+
+/*---------------------------------------------------------------------------*/
+int parse_data( long totalrows, /* I - Total rows to be processed */
+ long offset, /* I - Number of rows skipped at start*/
+ long firstrow, /* I - First row of this iteration */
+ long nrows, /* I - Number of rows in this iter */
+ int nCols, /* I - Number of columns in use */
+ iteratorCol *colData, /* IO- Column information/data */
+ void *userPtr ) /* I - Data handling instructions */
+/* */
+/* Iterator work function which calls the parser and copies the results */
+/* into either an OutputCol or a data pointer supplied in the userPtr */
+/* structure. */
+/*---------------------------------------------------------------------------*/
+{
+ int status, constant=0, anyNullThisTime=0;
+ long jj, kk, idx, remain, ntodo;
+ Node *result;
+ iteratorCol * outcol;
+
+ /* declare variables static to preserve their values between calls */
+ static void *Data, *Null;
+ static int datasize;
+ static long lastRow, repeat, resDataSize;
+ static LONGLONG jnull;
+ static parseInfo *userInfo;
+ static long zeros[4] = {0,0,0,0};
+
+ if (DEBUG_PIXFILTER)
+ printf("parse_data(total=%ld, offset=%ld, first=%ld, rows=%ld, cols=%d)\n",
+ totalrows, offset, firstrow, nrows, nCols);
+ /*--------------------------------------------------------*/
+ /* Initialization procedures: execute on the first call */
+ /*--------------------------------------------------------*/
+ outcol = colData + (nCols - 1);
+ if (firstrow == offset+1)
+ {
+ userInfo = (parseInfo*)userPtr;
+ userInfo->anyNull = 0;
+
+ if( userInfo->maxRows>0 )
+ userInfo->maxRows = minvalue(totalrows,userInfo->maxRows);
+ else if( userInfo->maxRows<0 )
+ userInfo->maxRows = totalrows;
+ else
+ userInfo->maxRows = nrows;
+
+ lastRow = firstrow + userInfo->maxRows - 1;
+
+ if( userInfo->dataPtr==NULL ) {
+
+ if( outcol->iotype == InputCol ) {
+ ffpmsg("Output column for parser results not found!");
+ return( PARSE_NO_OUTPUT );
+ }
+ /* Data gets set later */
+ Null = outcol->array;
+ userInfo->datatype = outcol->datatype;
+
+ /* Check for a TNULL/BLANK keyword for output column/image */
+
+ status = 0;
+ jnull = 0;
+ if (gParse.hdutype == IMAGE_HDU) {
+ if (gParse.pixFilter->blank)
+ jnull = (LONGLONG) gParse.pixFilter->blank;
+ }
+ else {
+ ffgknjj( outcol->fptr, "TNULL", outcol->colnum,
+ 1, &jnull, (int*)&jj, &status );
+
+ if( status==BAD_INTKEY ) {
+ /* Probably ASCII table with text TNULL keyword */
+ switch( userInfo->datatype ) {
+ case TSHORT: jnull = (LONGLONG) SHRT_MIN; break;
+ case TINT: jnull = (LONGLONG) INT_MIN; break;
+ case TLONG: jnull = (LONGLONG) LONG_MIN; break;
+ }
+ }
+ }
+ repeat = outcol->repeat;
+ if (DEBUG_PIXFILTER)
+ printf("parse_data: using null value %ld\n", jnull);
+ } else {
+
+ Data = userInfo->dataPtr;
+ Null = (userInfo->nullPtr ? userInfo->nullPtr : zeros);
+ repeat = gParse.Nodes[gParse.resultNode].value.nelem;
+
+ }
+
+ /* Determine the size of each element of the returned result */
+
+ switch( userInfo->datatype ) {
+ case TBIT: /* Fall through to TBYTE */
+ case TLOGICAL: /* Fall through to TBYTE */
+ case TBYTE: datasize = sizeof(char); break;
+ case TSHORT: datasize = sizeof(short); break;
+ case TINT: datasize = sizeof(int); break;
+ case TLONG: datasize = sizeof(long); break;
+ case TLONGLONG: datasize = sizeof(LONGLONG); break;
+ case TFLOAT: datasize = sizeof(float); break;
+ case TDOUBLE: datasize = sizeof(double); break;
+ case TSTRING: datasize = sizeof(char*); break;
+ }
+
+ /* Determine the size of each element of the calculated result */
+ /* (only matters for numeric/logical data) */
+
+ switch( gParse.Nodes[gParse.resultNode].type ) {
+ case BOOLEAN: resDataSize = sizeof(char); break;
+ case LONG: resDataSize = sizeof(long); break;
+ case DOUBLE: resDataSize = sizeof(double); break;
+ }
+ }
+
+ /*-------------------------------------------*/
+ /* Main loop: process all the rows of data */
+ /*-------------------------------------------*/
+
+ /* If writing to output column, set first element to appropriate */
+ /* null value. If no NULLs encounter, zero out before returning. */
+ if (DEBUG_PIXFILTER)
+ printf("parse_data: using null value %ld\n", jnull);
+
+
+ if( userInfo->dataPtr == NULL ) {
+ /* First, reset Data pointer to start of output array */
+ Data = (char*) outcol->array + datasize;
+
+ switch( userInfo->datatype ) {
+ case TLOGICAL: *(char *)Null = 'U'; break;
+ case TBYTE: *(char *)Null = (char )jnull; break;
+ case TSHORT: *(short *)Null = (short)jnull; break;
+ case TINT: *(int *)Null = (int )jnull; break;
+ case TLONG: *(long *)Null = (long )jnull; break;
+ case TLONGLONG: *(LONGLONG *)Null = (LONGLONG )jnull; break;
+ case TFLOAT: *(float *)Null = FLOATNULLVALUE; break;
+ case TDOUBLE: *(double*)Null = DOUBLENULLVALUE; break;
+ case TSTRING: (*(char **)Null)[0] = '\1';
+ (*(char **)Null)[1] = '\0'; break;
+ }
+ }
+
+ /* Alter nrows in case calling routine didn't want to do all rows */
+
+ nrows = minvalue(nrows,lastRow-firstrow+1);
+
+ Setup_DataArrays( nCols, colData, firstrow, nrows );
+
+ /* Parser allocates arrays for each column and calculation it performs. */
+ /* Limit number of rows processed during each pass to reduce memory */
+ /* requirements... In most cases, iterator will limit rows to less */
+ /* than 2500 rows per iteration, so this is really only relevant for */
+ /* hk-compressed files which must be decompressed in memory and sent */
+ /* whole to parse_data in a single iteration. */
+
+ remain = nrows;
+ while( remain ) {
+ ntodo = minvalue(remain,2500);
+ Evaluate_Parser ( firstrow, ntodo );
+ if( gParse.status ) break;
+
+ firstrow += ntodo;
+ remain -= ntodo;
+
+ /* Copy results into data array */
+
+ result = gParse.Nodes + gParse.resultNode;
+ if( result->operation==CONST_OP ) constant = 1;
+
+ switch( result->type ) {
+
+ case BOOLEAN:
+ case LONG:
+ case DOUBLE:
+ if( constant ) {
+ char undef=0;
+ for( kk=0; kk<ntodo; kk++ )
+ for( jj=0; jj<repeat; jj++ )
+ ffcvtn( gParse.datatype,
+ &(result->value.data),
+ &undef, result->value.nelem /* 1 */,
+ userInfo->datatype, Null,
+ (char*)Data + (kk*repeat+jj)*datasize,
+ &anyNullThisTime, &gParse.status );
+ } else {
+ if ( repeat == result->value.nelem ) {
+ ffcvtn( gParse.datatype,
+ result->value.data.ptr,
+ result->value.undef,
+ result->value.nelem*ntodo,
+ userInfo->datatype, Null, Data,
+ &anyNullThisTime, &gParse.status );
+ } else if( result->value.nelem == 1 ) {
+ for( kk=0; kk<ntodo; kk++ )
+ for( jj=0; jj<repeat; jj++ ) {
+ ffcvtn( gParse.datatype,
+ (char*)result->value.data.ptr + kk*resDataSize,
+ (char*)result->value.undef + kk,
+ 1, userInfo->datatype, Null,
+ (char*)Data + (kk*repeat+jj)*datasize,
+ &anyNullThisTime, &gParse.status );
+ }
+ } else {
+ int nCopy;
+ nCopy = minvalue( repeat, result->value.nelem );
+ for( kk=0; kk<ntodo; kk++ ) {
+ ffcvtn( gParse.datatype,
+ (char*)result->value.data.ptr
+ + kk*result->value.nelem*resDataSize,
+ (char*)result->value.undef
+ + kk*result->value.nelem,
+ nCopy, userInfo->datatype, Null,
+ (char*)Data + (kk*repeat)*datasize,
+ &anyNullThisTime, &gParse.status );
+ if( nCopy < repeat ) {
+ memset( (char*)Data + (kk*repeat+nCopy)*datasize,
+ 0, (repeat-nCopy)*datasize);
+ }
+ }
+
+ }
+ if( result->operation>0 ) {
+ FREE( result->value.data.ptr );
+ }
+ }
+ if( gParse.status==OVERFLOW_ERR ) {
+ gParse.status = NUM_OVERFLOW;
+ ffpmsg("Numerical overflow while converting expression to necessary datatype");
+ }
+ break;
+
+ case BITSTR:
+ switch( userInfo->datatype ) {
+ case TBYTE:
+ idx = -1;
+ for( kk=0; kk<ntodo; kk++ ) {
+ for( jj=0; jj<result->value.nelem; jj++ ) {
+ if( jj%8 == 0 )
+ ((char*)Data)[++idx] = 0;
+ if( constant ) {
+ if( result->value.data.str[jj]=='1' )
+ ((char*)Data)[idx] |= 128>>(jj%8);
+ } else {
+ if( result->value.data.strptr[kk][jj]=='1' )
+ ((char*)Data)[idx] |= 128>>(jj%8);
+ }
+ }
+ }
+ break;
+ case TBIT:
+ case TLOGICAL:
+ if( constant ) {
+ for( kk=0; kk<ntodo; kk++ )
+ for( jj=0; jj<result->value.nelem; jj++ ) {
+ ((char*)Data)[ jj+kk*result->value.nelem ] =
+ ( result->value.data.str[jj]=='1' );
+ }
+ } else {
+ for( kk=0; kk<ntodo; kk++ )
+ for( jj=0; jj<result->value.nelem; jj++ ) {
+ ((char*)Data)[ jj+kk*result->value.nelem ] =
+ ( result->value.data.strptr[kk][jj]=='1' );
+ }
+ }
+ break;
+ case TSTRING:
+ if( constant ) {
+ for( jj=0; jj<ntodo; jj++ ) {
+ strcpy( ((char**)Data)[jj], result->value.data.str );
+ }
+ } else {
+ for( jj=0; jj<ntodo; jj++ ) {
+ strcpy( ((char**)Data)[jj], result->value.data.strptr[jj] );
+ }
+ }
+ break;
+ default:
+ ffpmsg("Cannot convert bit expression to desired type.");
+ gParse.status = PARSE_BAD_TYPE;
+ break;
+ }
+ if( result->operation>0 ) {
+ FREE( result->value.data.strptr[0] );
+ FREE( result->value.data.strptr );
+ }
+ break;
+
+ case STRING:
+ if( userInfo->datatype==TSTRING ) {
+ if( constant ) {
+ for( jj=0; jj<ntodo; jj++ )
+ strcpy( ((char**)Data)[jj], result->value.data.str );
+ } else {
+ for( jj=0; jj<ntodo; jj++ )
+ if( result->value.undef[jj] ) {
+ anyNullThisTime = 1;
+ strcpy( ((char**)Data)[jj],
+ *(char **)Null );
+ } else {
+ strcpy( ((char**)Data)[jj],
+ result->value.data.strptr[jj] );
+ }
+ }
+ } else {
+ ffpmsg("Cannot convert string expression to desired type.");
+ gParse.status = PARSE_BAD_TYPE;
+ }
+ if( result->operation>0 ) {
+ FREE( result->value.data.strptr[0] );
+ FREE( result->value.data.strptr );
+ }
+ break;
+ }
+
+ if( gParse.status ) break;
+
+ /* Increment Data to point to where the next block should go */
+
+ if( result->type==BITSTR && userInfo->datatype==TBYTE )
+ Data = (char*)Data
+ + datasize * ( (result->value.nelem+7)/8 ) * ntodo;
+ else if( result->type==STRING )
+ Data = (char*)Data + datasize * ntodo;
+ else
+ Data = (char*)Data + datasize * ntodo * repeat;
+ }
+
+ /* If no NULLs encountered during this pass, set Null value to */
+ /* zero to make the writing of the output column data faster */
+
+ if( anyNullThisTime )
+ userInfo->anyNull = 1;
+ else if( userInfo->dataPtr == NULL ) {
+ if( userInfo->datatype == TSTRING )
+ memcpy( *(char **)Null, zeros, 2 );
+ else
+ memcpy( Null, zeros, datasize );
+ }
+
+ /*-------------------------------------------------------*/
+ /* Clean up procedures: after processing all the rows */
+ /*-------------------------------------------------------*/
+
+ /* if the calling routine specified that only a limited number */
+ /* of rows in the table should be processed, return a value of -1 */
+ /* once all the rows have been done, if no other error occurred. */
+
+ if (gParse.hdutype != IMAGE_HDU && firstrow - 1 == lastRow) {
+ if (!gParse.status && userInfo->maxRows<totalrows) {
+ return (-1);
+ }
+ }
+
+ return(gParse.status); /* return successful status */
+}
+
+static void Setup_DataArrays( int nCols, iteratorCol *cols,
+ long fRow, long nRows )
+ /***********************************************************************/
+ /* Setup the varData array in gParse to contain the fits column data. */
+ /* Then, allocate and initialize the necessary UNDEF arrays for each */
+ /* column used by the parser. */
+ /***********************************************************************/
+{
+ int i;
+ long nelem, len, row, idx;
+ char **bitStrs;
+ char **sptr;
+ char *barray;
+ long *iarray;
+ double *rarray;
+ char msg[80];
+
+ gParse.firstDataRow = fRow;
+ gParse.nDataRows = nRows;
+
+ /* Resize and fill in UNDEF arrays for each column */
+
+ for( i=0; i<nCols; i++ ) {
+
+ iteratorCol *icol = cols + i;
+ DataInfo *varData = gParse.varData + i;
+
+ if( icol->iotype == OutputCol ) continue;
+
+ nelem = varData->nelem;
+ len = nelem * nRows;
+
+ switch ( varData->type ) {
+
+ case BITSTR:
+ /* No need for UNDEF array, but must make string DATA array */
+ len = (nelem+1)*nRows; /* Count '\0' */
+ bitStrs = (char**)varData->data;
+ if( bitStrs ) FREE( bitStrs[0] );
+ free( bitStrs );
+ bitStrs = (char**)malloc( nRows*sizeof(char*) );
+ if( bitStrs==NULL ) {
+ varData->data = varData->undef = NULL;
+ gParse.status = MEMORY_ALLOCATION;
+ break;
+ }
+ bitStrs[0] = (char*)malloc( len*sizeof(char) );
+ if( bitStrs[0]==NULL ) {
+ free( bitStrs );
+ varData->data = varData->undef = NULL;
+ gParse.status = MEMORY_ALLOCATION;
+ break;
+ }
+
+ for( row=0; row<nRows; row++ ) {
+ bitStrs[row] = bitStrs[0] + row*(nelem+1);
+ idx = (row)*( (nelem+7)/8 ) + 1;
+ for(len=0; len<nelem; len++) {
+ if( ((char*)icol->array)[idx] & (1<<(7-len%8)) )
+ bitStrs[row][len] = '1';
+ else
+ bitStrs[row][len] = '0';
+ if( len%8==7 ) idx++;
+ }
+ bitStrs[row][len] = '\0';
+ }
+ varData->undef = (char*)bitStrs;
+ varData->data = (char*)bitStrs;
+ break;
+
+ case STRING:
+ sptr = (char**)icol->array;
+ if (varData->undef)
+ free( varData->undef );
+ varData->undef = (char*)malloc( nRows*sizeof(char) );
+ if( varData->undef==NULL ) {
+ gParse.status = MEMORY_ALLOCATION;
+ break;
+ }
+ row = nRows;
+ while( row-- )
+ varData->undef[row] =
+ ( **sptr != '\0' && FSTRCMP( sptr[0], sptr[row+1] )==0 );
+ varData->data = sptr + 1;
+ break;
+
+ case BOOLEAN:
+ barray = (char*)icol->array;
+ if (varData->undef)
+ free( varData->undef );
+ varData->undef = (char*)malloc( len*sizeof(char) );
+ if( varData->undef==NULL ) {
+ gParse.status = MEMORY_ALLOCATION;
+ break;
+ }
+ while( len-- ) {
+ varData->undef[len] =
+ ( barray[0]!=0 && barray[0]==barray[len+1] );
+ }
+ varData->data = barray + 1;
+ break;
+
+ case LONG:
+ iarray = (long*)icol->array;
+ if (varData->undef)
+ free( varData->undef );
+ varData->undef = (char*)malloc( len*sizeof(char) );
+ if( varData->undef==NULL ) {
+ gParse.status = MEMORY_ALLOCATION;
+ break;
+ }
+ while( len-- ) {
+ varData->undef[len] =
+ ( iarray[0]!=0L && iarray[0]==iarray[len+1] );
+ }
+ varData->data = iarray + 1;
+ break;
+
+ case DOUBLE:
+ rarray = (double*)icol->array;
+ if (varData->undef)
+ free( varData->undef );
+ varData->undef = (char*)malloc( len*sizeof(char) );
+ if( varData->undef==NULL ) {
+ gParse.status = MEMORY_ALLOCATION;
+ break;
+ }
+ while( len-- ) {
+ varData->undef[len] =
+ ( rarray[0]!=0.0 && rarray[0]==rarray[len+1]);
+ }
+ varData->data = rarray + 1;
+ break;
+
+ default:
+ sprintf(msg, "SetupDataArrays, unhandled type %d\n",
+ varData->type);
+ ffpmsg(msg);
+ }
+
+ if( gParse.status ) { /* Deallocate NULL arrays of previous columns */
+ while( i-- ) {
+ varData = gParse.varData + i;
+ if( varData->type==BITSTR )
+ FREE( ((char**)varData->data)[0] );
+ FREE( varData->undef );
+ varData->undef = NULL;
+ }
+ return;
+ }
+ }
+}
+
+/*--------------------------------------------------------------------------*/
+int ffcvtn( int inputType, /* I - Data type of input array */
+ void *input, /* I - Input array of type inputType */
+ char *undef, /* I - Array of flags indicating UNDEF elems */
+ long ntodo, /* I - Number of elements to process */
+ int outputType, /* I - Data type of output array */
+ void *nulval, /* I - Ptr to value to use for UNDEF elements */
+ void *output, /* O - Output array of type outputType */
+ int *anynull, /* O - Any nulls flagged? */
+ int *status ) /* O - Error status */
+/* */
+/* Convert an array of any input data type to an array of any output */
+/* data type, using an array of UNDEF flags to assign nulvals to */
+/*--------------------------------------------------------------------------*/
+{
+ long i;
+
+ switch( outputType ) {
+
+ case TLOGICAL:
+ switch( inputType ) {
+ case TLOGICAL:
+ case TBYTE:
+ for( i=0; i<ntodo; i++ )
+ if( ((unsigned char*)input)[i] )
+ ((unsigned char*)output)[i] = 1;
+ else
+ ((unsigned char*)output)[i] = 0;
+ break;
+ case TSHORT:
+ for( i=0; i<ntodo; i++ )
+ if( ((short*)input)[i] )
+ ((unsigned char*)output)[i] = 1;
+ else
+ ((unsigned char*)output)[i] = 0;
+ break;
+ case TLONG:
+ for( i=0; i<ntodo; i++ )
+ if( ((long*)input)[i] )
+ ((unsigned char*)output)[i] = 1;
+ else
+ ((unsigned char*)output)[i] = 0;
+ break;
+ case TFLOAT:
+ for( i=0; i<ntodo; i++ )
+ if( ((float*)input)[i] )
+ ((unsigned char*)output)[i] = 1;
+ else
+ ((unsigned char*)output)[i] = 0;
+ break;
+ case TDOUBLE:
+ for( i=0; i<ntodo; i++ )
+ if( ((double*)input)[i] )
+ ((unsigned char*)output)[i] = 1;
+ else
+ ((unsigned char*)output)[i] = 0;
+ break;
+ default:
+ *status = BAD_DATATYPE;
+ break;
+ }
+ for(i=0;i<ntodo;i++) {
+ if( undef[i] ) {
+ ((unsigned char*)output)[i] = *(unsigned char*)nulval;
+ *anynull = 1;
+ }
+ }
+ break;
+
+ case TBYTE:
+ switch( inputType ) {
+ case TLOGICAL:
+ case TBYTE:
+ for( i=0; i<ntodo; i++ )
+ ((unsigned char*)output)[i] = ((unsigned char*)input)[i];
+ break;
+ case TSHORT:
+ fffi2i1((short*)input,ntodo,1.,0.,0,0,0,NULL,NULL,(unsigned char*)output,status);
+ break;
+ case TLONG:
+ for (i = 0; i < ntodo; i++) {
+ if( undef[i] ) {
+ ((unsigned char*)output)[i] = *(unsigned char*)nulval;
+ *anynull = 1;
+ } else {
+ if( ((long*)input)[i] < 0 ) {
+ *status = OVERFLOW_ERR;
+ ((unsigned char*)output)[i] = 0;
+ } else if( ((long*)input)[i] > UCHAR_MAX ) {
+ *status = OVERFLOW_ERR;
+ ((unsigned char*)output)[i] = UCHAR_MAX;
+ } else
+ ((unsigned char*)output)[i] =
+ (unsigned char) ((long*)input)[i];
+ }
+ }
+ return( *status );
+ case TFLOAT:
+ fffr4i1((float*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (unsigned char*)output,status);
+ break;
+ case TDOUBLE:
+ fffr8i1((double*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (unsigned char*)output,status);
+ break;
+ default:
+ *status = BAD_DATATYPE;
+ break;
+ }
+ for(i=0;i<ntodo;i++) {
+ if( undef[i] ) {
+ ((unsigned char*)output)[i] = *(unsigned char*)nulval;
+ *anynull = 1;
+ }
+ }
+ break;
+
+ case TSHORT:
+ switch( inputType ) {
+ case TLOGICAL:
+ case TBYTE:
+ for( i=0; i<ntodo; i++ )
+ ((short*)output)[i] = ((unsigned char*)input)[i];
+ break;
+ case TSHORT:
+ for( i=0; i<ntodo; i++ )
+ ((short*)output)[i] = ((short*)input)[i];
+ break;
+ case TLONG:
+ for (i = 0; i < ntodo; i++) {
+ if( undef[i] ) {
+ ((short*)output)[i] = *(short*)nulval;
+ *anynull = 1;
+ } else {
+ if( ((long*)input)[i] < SHRT_MIN ) {
+ *status = OVERFLOW_ERR;
+ ((short*)output)[i] = SHRT_MIN;
+ } else if ( ((long*)input)[i] > SHRT_MAX ) {
+ *status = OVERFLOW_ERR;
+ ((short*)output)[i] = SHRT_MAX;
+ } else
+ ((short*)output)[i] = (short) ((long*)input)[i];
+ }
+ }
+ return( *status );
+ case TFLOAT:
+ fffr4i2((float*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (short*)output,status);
+ break;
+ case TDOUBLE:
+ fffr8i2((double*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (short*)output,status);
+ break;
+ default:
+ *status = BAD_DATATYPE;
+ break;
+ }
+ for(i=0;i<ntodo;i++) {
+ if( undef[i] ) {
+ ((short*)output)[i] = *(short*)nulval;
+ *anynull = 1;
+ }
+ }
+ break;
+
+ case TINT:
+ switch( inputType ) {
+ case TLOGICAL:
+ case TBYTE:
+ for( i=0; i<ntodo; i++ )
+ ((int*)output)[i] = ((unsigned char*)input)[i];
+ break;
+ case TSHORT:
+ for( i=0; i<ntodo; i++ )
+ ((int*)output)[i] = ((short*)input)[i];
+ break;
+ case TLONG:
+ for( i=0; i<ntodo; i++ )
+ ((int*)output)[i] = ((long*)input)[i];
+ break;
+ case TFLOAT:
+ fffr4int((float*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (int*)output,status);
+ break;
+ case TDOUBLE:
+ fffr8int((double*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (int*)output,status);
+ break;
+ default:
+ *status = BAD_DATATYPE;
+ break;
+ }
+ for(i=0;i<ntodo;i++) {
+ if( undef[i] ) {
+ ((int*)output)[i] = *(int*)nulval;
+ *anynull = 1;
+ }
+ }
+ break;
+
+ case TLONG:
+ switch( inputType ) {
+ case TLOGICAL:
+ case TBYTE:
+ for( i=0; i<ntodo; i++ )
+ ((long*)output)[i] = ((unsigned char*)input)[i];
+ break;
+ case TSHORT:
+ for( i=0; i<ntodo; i++ )
+ ((long*)output)[i] = ((short*)input)[i];
+ break;
+ case TLONG:
+ for( i=0; i<ntodo; i++ )
+ ((long*)output)[i] = ((long*)input)[i];
+ break;
+ case TFLOAT:
+ fffr4i4((float*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (long*)output,status);
+ break;
+ case TDOUBLE:
+ fffr8i4((double*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (long*)output,status);
+ break;
+ default:
+ *status = BAD_DATATYPE;
+ break;
+ }
+ for(i=0;i<ntodo;i++) {
+ if( undef[i] ) {
+ ((long*)output)[i] = *(long*)nulval;
+ *anynull = 1;
+ }
+ }
+ break;
+
+ case TLONGLONG:
+ switch( inputType ) {
+ case TLOGICAL:
+ case TBYTE:
+ for( i=0; i<ntodo; i++ )
+ ((LONGLONG*)output)[i] = ((unsigned char*)input)[i];
+ break;
+ case TSHORT:
+ for( i=0; i<ntodo; i++ )
+ ((LONGLONG*)output)[i] = ((short*)input)[i];
+ break;
+ case TLONG:
+ for( i=0; i<ntodo; i++ )
+ ((LONGLONG*)output)[i] = ((long*)input)[i];
+ break;
+ case TFLOAT:
+ fffr4i8((float*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (LONGLONG*)output,status);
+ break;
+ case TDOUBLE:
+ fffr8i8((double*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (LONGLONG*)output,status);
+
+ break;
+ default:
+ *status = BAD_DATATYPE;
+ break;
+ }
+ for(i=0;i<ntodo;i++) {
+ if( undef[i] ) {
+ ((LONGLONG*)output)[i] = *(LONGLONG*)nulval;
+ *anynull = 1;
+ }
+ }
+ break;
+
+ case TFLOAT:
+ switch( inputType ) {
+ case TLOGICAL:
+ case TBYTE:
+ for( i=0; i<ntodo; i++ )
+ ((float*)output)[i] = ((unsigned char*)input)[i];
+ break;
+ case TSHORT:
+ for( i=0; i<ntodo; i++ )
+ ((float*)output)[i] = ((short*)input)[i];
+ break;
+ case TLONG:
+ for( i=0; i<ntodo; i++ )
+ ((float*)output)[i] = (float) ((long*)input)[i];
+ break;
+ case TFLOAT:
+ for( i=0; i<ntodo; i++ )
+ ((float*)output)[i] = ((float*)input)[i];
+ break;
+ case TDOUBLE:
+ fffr8r4((double*)input,ntodo,1.,0.,0,0,NULL,NULL,
+ (float*)output,status);
+ break;
+ default:
+ *status = BAD_DATATYPE;
+ break;
+ }
+ for(i=0;i<ntodo;i++) {
+ if( undef[i] ) {
+ ((float*)output)[i] = *(float*)nulval;
+ *anynull = 1;
+ }
+ }
+ break;
+
+ case TDOUBLE:
+ switch( inputType ) {
+ case TLOGICAL:
+ case TBYTE:
+ for( i=0; i<ntodo; i++ )
+ ((double*)output)[i] = ((unsigned char*)input)[i];
+ break;
+ case TSHORT:
+ for( i=0; i<ntodo; i++ )
+ ((double*)output)[i] = ((short*)input)[i];
+ break;
+ case TLONG:
+ for( i=0; i<ntodo; i++ )
+ ((double*)output)[i] = ((long*)input)[i];
+ break;
+ case TFLOAT:
+ for( i=0; i<ntodo; i++ )
+ ((double*)output)[i] = ((float*)input)[i];
+ break;
+ case TDOUBLE:
+ for( i=0; i<ntodo; i++ )
+ ((double*)output)[i] = ((double*)input)[i];
+ break;
+ default:
+ *status = BAD_DATATYPE;
+ break;
+ }
+ for(i=0;i<ntodo;i++) {
+ if( undef[i] ) {
+ ((double*)output)[i] = *(double*)nulval;
+ *anynull = 1;
+ }
+ }
+ break;
+
+ default:
+ *status = BAD_DATATYPE;
+ break;
+ }
+
+ return ( *status );
+}
+
+/*---------------------------------------------------------------------------*/
+int fffrwc( fitsfile *fptr, /* I - Input FITS file */
+ char *expr, /* I - Boolean expression */
+ char *timeCol, /* I - Name of time column */
+ char *parCol, /* I - Name of parameter column */
+ char *valCol, /* I - Name of value column */
+ long ntimes, /* I - Number of distinct times in file */
+ double *times, /* O - Array of times in file */
+ char *time_status, /* O - Array of boolean results */
+ int *status ) /* O - Error status */
+/* */
+/* Evaluate a boolean expression for each time in a compressed file, */
+/* returning an array of flags indicating which times evaluated to TRUE/FALSE*/
+/*---------------------------------------------------------------------------*/
+{
+ parseInfo Info;
+ long alen, width;
+ int parNo, typecode;
+ int naxis, constant, nCol=0;
+ long nelem, naxes[MAXDIMS], elem;
+ char result;
+
+ if( *status ) return( *status );
+
+ fits_get_colnum( fptr, CASEINSEN, timeCol, &gParse.timeCol, status );
+ fits_get_colnum( fptr, CASEINSEN, parCol, &gParse.parCol , status );
+ fits_get_colnum( fptr, CASEINSEN, valCol, &gParse.valCol, status );
+ if( *status ) return( *status );
+
+ if( ffiprs( fptr, 1, expr, MAXDIMS, &Info.datatype, &nelem,
+ &naxis, naxes, status ) ) {
+ ffcprs();
+ return( *status );
+ }
+ if( nelem<0 ) {
+ constant = 1;
+ nelem = -nelem;
+ nCol = gParse.nCols;
+ gParse.nCols = 0; /* Ignore all column references */
+ } else
+ constant = 0;
+
+ if( Info.datatype!=TLOGICAL || nelem!=1 ) {
+ ffcprs();
+ ffpmsg("Expression does not evaluate to a logical scalar.");
+ return( *status = PARSE_BAD_TYPE );
+ }
+
+ /*******************************************/
+ /* Allocate data arrays for each parameter */
+ /*******************************************/
+
+ parNo = gParse.nCols;
+ while( parNo-- ) {
+ switch( gParse.colData[parNo].datatype ) {
+ case TLONG:
+ if( (gParse.colData[parNo].array =
+ (long *)malloc( (ntimes+1)*sizeof(long) )) )
+ ((long*)gParse.colData[parNo].array)[0] = 1234554321;
+ else
+ *status = MEMORY_ALLOCATION;
+ break;
+ case TDOUBLE:
+ if( (gParse.colData[parNo].array =
+ (double *)malloc( (ntimes+1)*sizeof(double) )) )
+ ((double*)gParse.colData[parNo].array)[0] = DOUBLENULLVALUE;
+ else
+ *status = MEMORY_ALLOCATION;
+ break;
+ case TSTRING:
+ if( !fits_get_coltype( fptr, gParse.valCol, &typecode,
+ &alen, &width, status ) ) {
+ alen++;
+ if( (gParse.colData[parNo].array =
+ (char **)malloc( (ntimes+1)*sizeof(char*) )) ) {
+ if( (((char **)gParse.colData[parNo].array)[0] =
+ (char *)malloc( (ntimes+1)*sizeof(char)*alen )) ) {
+ for( elem=1; elem<=ntimes; elem++ )
+ ((char **)gParse.colData[parNo].array)[elem] =
+ ((char **)gParse.colData[parNo].array)[elem-1]+alen;
+ ((char **)gParse.colData[parNo].array)[0][0] = '\0';
+ } else {
+ free( gParse.colData[parNo].array );
+ *status = MEMORY_ALLOCATION;
+ }
+ } else {
+ *status = MEMORY_ALLOCATION;
+ }
+ }
+ break;
+ }
+ if( *status ) {
+ while( parNo-- ) {
+ if( gParse.colData[parNo].datatype==TSTRING )
+ FREE( ((char **)gParse.colData[parNo].array)[0] );
+ FREE( gParse.colData[parNo].array );
+ }
+ return( *status );
+ }
+ }
+
+ /**********************************************************************/
+ /* Read data from columns needed for the expression and then parse it */
+ /**********************************************************************/
+
+ if( !uncompress_hkdata( fptr, ntimes, times, status ) ) {
+ if( constant ) {
+ result = gParse.Nodes[gParse.resultNode].value.data.log;
+ elem = ntimes;
+ while( elem-- ) time_status[elem] = result;
+ } else {
+ Info.dataPtr = time_status;
+ Info.nullPtr = NULL;
+ Info.maxRows = ntimes;
+ *status = parse_data( ntimes, 0, 1, ntimes, gParse.nCols,
+ gParse.colData, (void*)&Info );
+ }
+ }
+
+ /************/
+ /* Clean up */
+ /************/
+
+ parNo = gParse.nCols;
+ while ( parNo-- ) {
+ if( gParse.colData[parNo].datatype==TSTRING )
+ FREE( ((char **)gParse.colData[parNo].array)[0] );
+ FREE( gParse.colData[parNo].array );
+ }
+
+ if( constant ) gParse.nCols = nCol;
+
+ ffcprs();
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int uncompress_hkdata( fitsfile *fptr,
+ long ntimes,
+ double *times,
+ int *status )
+/* */
+/* description */
+/*---------------------------------------------------------------------------*/
+{
+ char parName[256], *sPtr[1], found[1000];
+ int parNo, anynul;
+ long naxis2, row, currelem;
+ double currtime, newtime;
+
+ sPtr[0] = parName;
+ currelem = 0;
+ currtime = -1e38;
+
+ parNo=gParse.nCols;
+ while( parNo-- ) found[parNo] = 0;
+
+ if( ffgkyj( fptr, "NAXIS2", &naxis2, NULL, status ) ) return( *status );
+
+ for( row=1; row<=naxis2; row++ ) {
+ if( ffgcvd( fptr, gParse.timeCol, row, 1L, 1L, 0.0,
+ &newtime, &anynul, status ) ) return( *status );
+ if( newtime != currtime ) {
+ /* New time encountered... propogate parameters to next row */
+ if( currelem==ntimes ) {
+ ffpmsg("Found more unique time stamps than caller indicated");
+ return( *status = PARSE_BAD_COL );
+ }
+ times[currelem++] = currtime = newtime;
+ parNo = gParse.nCols;
+ while( parNo-- ) {
+ switch( gParse.colData[parNo].datatype ) {
+ case TLONG:
+ ((long*)gParse.colData[parNo].array)[currelem] =
+ ((long*)gParse.colData[parNo].array)[currelem-1];
+ break;
+ case TDOUBLE:
+ ((double*)gParse.colData[parNo].array)[currelem] =
+ ((double*)gParse.colData[parNo].array)[currelem-1];
+ break;
+ case TSTRING:
+ strcpy( ((char **)gParse.colData[parNo].array)[currelem],
+ ((char **)gParse.colData[parNo].array)[currelem-1] );
+ break;
+ }
+ }
+ }
+
+ if( ffgcvs( fptr, gParse.parCol, row, 1L, 1L, "",
+ sPtr, &anynul, status ) ) return( *status );
+ parNo = gParse.nCols;
+ while( parNo-- )
+ if( !strcasecmp( parName, gParse.varData[parNo].name ) ) break;
+
+ if( parNo>=0 ) {
+ found[parNo] = 1; /* Flag this parameter as found */
+ switch( gParse.colData[parNo].datatype ) {
+ case TLONG:
+ ffgcvj( fptr, gParse.valCol, row, 1L, 1L,
+ ((long*)gParse.colData[parNo].array)[0],
+ ((long*)gParse.colData[parNo].array)+currelem,
+ &anynul, status );
+ break;
+ case TDOUBLE:
+ ffgcvd( fptr, gParse.valCol, row, 1L, 1L,
+ ((double*)gParse.colData[parNo].array)[0],
+ ((double*)gParse.colData[parNo].array)+currelem,
+ &anynul, status );
+ break;
+ case TSTRING:
+ ffgcvs( fptr, gParse.valCol, row, 1L, 1L,
+ ((char**)gParse.colData[parNo].array)[0],
+ ((char**)gParse.colData[parNo].array)+currelem,
+ &anynul, status );
+ break;
+ }
+ if( *status ) return( *status );
+ }
+ }
+
+ if( currelem<ntimes ) {
+ ffpmsg("Found fewer unique time stamps than caller indicated");
+ return( *status = PARSE_BAD_COL );
+ }
+
+ /* Check for any parameters which were not located in the table */
+ parNo = gParse.nCols;
+ while( parNo-- )
+ if( !found[parNo] ) {
+ sprintf( parName, "Parameter not found: %-30s",
+ gParse.varData[parNo].name );
+ ffpmsg( parName );
+ *status = PARSE_SYNTAX_ERR;
+ }
+ return( *status );
+}
+
+/*---------------------------------------------------------------------------*/
+int ffffrw( fitsfile *fptr, /* I - Input FITS file */
+ char *expr, /* I - Boolean expression */
+ long *rownum, /* O - First row of table to eval to T */
+ int *status ) /* O - Error status */
+/* */
+/* Evaluate a boolean expression, returning the row number of the first */
+/* row which evaluates to TRUE */
+/*---------------------------------------------------------------------------*/
+{
+ int naxis, constant, dtype;
+ long nelem, naxes[MAXDIMS];
+ char result;
+
+ if( *status ) return( *status );
+
+ FFLOCK;
+ if( ffiprs( fptr, 0, expr, MAXDIMS, &dtype, &nelem, &naxis,
+ naxes, status ) ) {
+ ffcprs();
+ FFUNLOCK;
+ return( *status );
+ }
+ if( nelem<0 ) {
+ constant = 1;
+ nelem = -nelem;
+ } else
+ constant = 0;
+
+ if( dtype!=TLOGICAL || nelem!=1 ) {
+ ffcprs();
+ ffpmsg("Expression does not evaluate to a logical scalar.");
+ FFUNLOCK;
+ return( *status = PARSE_BAD_TYPE );
+ }
+
+ *rownum = 0;
+ if( constant ) { /* No need to call parser... have result from ffiprs */
+ result = gParse.Nodes[gParse.resultNode].value.data.log;
+ if( result ) {
+ /* Make sure there is at least 1 row in table */
+ ffgnrw( fptr, &nelem, status );
+ if( nelem )
+ *rownum = 1;
+ }
+ } else {
+ if( ffiter( gParse.nCols, gParse.colData, 0, 0,
+ ffffrw_work, (void*)rownum, status ) == -1 )
+ *status = 0; /* -1 indicates exitted without error before end... OK */
+ }
+
+ ffcprs();
+ FFUNLOCK;
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffffrw_work(long totalrows, /* I - Total rows to be processed */
+ long offset, /* I - Number of rows skipped at start*/
+ long firstrow, /* I - First row of this iteration */
+ long nrows, /* I - Number of rows in this iter */
+ int nCols, /* I - Number of columns in use */
+ iteratorCol *colData, /* IO- Column information/data */
+ void *userPtr ) /* I - Data handling instructions */
+/* */
+/* Iterator work function which calls the parser and searches for the */
+/* first row which evaluates to TRUE. */
+/*---------------------------------------------------------------------------*/
+{
+ long idx;
+ Node *result;
+
+ Evaluate_Parser( firstrow, nrows );
+
+ if( !gParse.status ) {
+
+ result = gParse.Nodes + gParse.resultNode;
+ if( result->operation==CONST_OP ) {
+
+ if( result->value.data.log ) {
+ *(long*)userPtr = firstrow;
+ return( -1 );
+ }
+
+ } else {
+
+ for( idx=0; idx<nrows; idx++ )
+ if( result->value.data.logptr[idx] && !result->value.undef[idx] ) {
+ *(long*)userPtr = firstrow + idx;
+ return( -1 );
+ }
+ }
+ }
+
+ return( gParse.status );
+}
+
+
+static int set_image_col_types (fitsfile * fptr, const char * name, int bitpix,
+ DataInfo * varInfo, iteratorCol *colIter) {
+
+ int istatus;
+ double tscale, tzero;
+ char temp[80];
+
+ switch (bitpix) {
+ case BYTE_IMG:
+ case SHORT_IMG:
+ case LONG_IMG:
+ istatus = 0;
+ if (fits_read_key(fptr, TDOUBLE, "BZERO", &tzero, NULL, &istatus))
+ tzero = 0.0;
+
+ istatus = 0;
+ if (fits_read_key(fptr, TDOUBLE, "BSCALE", &tscale, NULL, &istatus))
+ tscale = 1.0;
+
+ if (tscale == 1.0 && (tzero == 0.0 || tzero == 32768.0 )) {
+ varInfo->type = LONG;
+ colIter->datatype = TLONG;
+ }
+ else {
+ varInfo->type = DOUBLE;
+ colIter->datatype = TDOUBLE;
+ if (DEBUG_PIXFILTER)
+ printf("use DOUBLE for %s with BSCALE=%g/BZERO=%g\n",
+ name, tscale, tzero);
+ }
+ break;
+
+ case LONGLONG_IMG:
+ case FLOAT_IMG:
+ case DOUBLE_IMG:
+ varInfo->type = DOUBLE;
+ colIter->datatype = TDOUBLE;
+ break;
+ default:
+ sprintf(temp, "set_image_col_types: unrecognized image bitpix [%d]\n",
+ bitpix);
+ ffpmsg(temp);
+ return gParse.status = PARSE_BAD_TYPE;
+ }
+ return 0;
+}
+
+
+/*************************************************************************
+
+ Functions used by the evaluator to access FITS data
+ (find_column, find_keywd, allocateCol, load_column)
+
+ *************************************************************************/
+
+static int find_column( char *colName, void *itslval )
+{
+ FFSTYPE *thelval = (FFSTYPE*)itslval;
+ int col_cnt, status;
+ int colnum, typecode, type;
+ long repeat, width;
+ fitsfile *fptr;
+ char temp[80];
+ double tzero,tscale;
+ int istatus;
+ DataInfo *varInfo;
+ iteratorCol *colIter;
+
+if (DEBUG_PIXFILTER)
+ printf("find_column(%s)\n", colName);
+
+ if( *colName == '#' )
+ return( find_keywd( colName + 1, itslval ) );
+
+ fptr = gParse.def_fptr;
+
+ status = 0;
+ col_cnt = gParse.nCols;
+
+if (gParse.hdutype == IMAGE_HDU) {
+ int i;
+ if (!gParse.pixFilter) {
+ gParse.status = COL_NOT_FOUND;
+ ffpmsg("find_column: IMAGE_HDU but no PixelFilter");
+ return pERROR;
+ }
+
+ colnum = -1;
+ for (i = 0; i < gParse.pixFilter->count; ++i) {
+ if (!strcasecmp(colName, gParse.pixFilter->tag[i]))
+ colnum = i;
+ }
+ if (colnum < 0) {
+ sprintf(temp, "find_column: PixelFilter tag %s not found", colName);
+ ffpmsg(temp);
+ gParse.status = COL_NOT_FOUND;
+ return pERROR;
+ }
+
+ if( allocateCol( col_cnt, &gParse.status ) ) return pERROR;
+
+ varInfo = gParse.varData + col_cnt;
+ colIter = gParse.colData + col_cnt;
+
+ fptr = gParse.pixFilter->ifptr[colnum];
+ fits_get_img_param(fptr,
+ MAXDIMS,
+ &typecode, /* actually bitpix */
+ &varInfo->naxis,
+ &varInfo->naxes[0],
+ &status);
+ varInfo->nelem = 1;
+ type = COLUMN;
+ if (set_image_col_types(fptr, colName, typecode, varInfo, colIter))
+ return pERROR;
+ colIter->fptr = fptr;
+ colIter->iotype = InputCol;
+}
+else { /* HDU holds a table */
+ if( gParse.compressed )
+ colnum = gParse.valCol;
+ else
+ if( fits_get_colnum( fptr, CASEINSEN, colName, &colnum, &status ) ) {
+ if( status == COL_NOT_FOUND ) {
+ type = find_keywd( colName, itslval );
+ if( type != pERROR ) ffcmsg();
+ return( type );
+ }
+ gParse.status = status;
+ return pERROR;
+ }
+
+ if( fits_get_coltype( fptr, colnum, &typecode,
+ &repeat, &width, &status ) ) {
+ gParse.status = status;
+ return pERROR;
+ }
+
+ if( allocateCol( col_cnt, &gParse.status ) ) return pERROR;
+
+ varInfo = gParse.varData + col_cnt;
+ colIter = gParse.colData + col_cnt;
+
+ fits_iter_set_by_num( colIter, fptr, colnum, 0, InputCol );
+}
+
+ /* Make sure we don't overflow variable name array */
+ strncpy(varInfo->name,colName,MAXVARNAME);
+ varInfo->name[MAXVARNAME] = '\0';
+
+if (gParse.hdutype != IMAGE_HDU) {
+ switch( typecode ) {
+ case TBIT:
+ varInfo->type = BITSTR;
+ colIter->datatype = TBYTE;
+ type = BITCOL;
+ break;
+ case TBYTE:
+ case TSHORT:
+ case TLONG:
+ /* The datatype of column with TZERO and TSCALE keywords might be
+ float or double.
+ */
+ sprintf(temp,"TZERO%d",colnum);
+ istatus = 0;
+ if(fits_read_key(fptr,TDOUBLE,temp,&tzero,NULL,&istatus)) {
+ tzero = 0.0;
+ }
+ sprintf(temp,"TSCAL%d",colnum);
+ istatus = 0;
+ if(fits_read_key(fptr,TDOUBLE,temp,&tscale,NULL,&istatus)) {
+ tscale = 1.0;
+ }
+ if (tscale == 1.0 && (tzero == 0.0 || tzero == 32768.0 )) {
+ varInfo->type = LONG;
+ colIter->datatype = TLONG;
+/* Reading an unsigned long column as a long can cause overflow errors.
+ Treat the column as a double instead.
+ } else if (tscale == 1.0 && tzero == 2147483648.0 ) {
+ varInfo->type = LONG;
+ colIter->datatype = TULONG;
+ */
+
+ }
+ else {
+ varInfo->type = DOUBLE;
+ colIter->datatype = TDOUBLE;
+ }
+ type = COLUMN;
+ break;
+/*
+ For now, treat 8-byte integer columns as type double.
+ This can lose precision, so the better long term solution
+ will be to add support for TLONGLONG as a separate datatype.
+*/
+ case TLONGLONG:
+ case TFLOAT:
+ case TDOUBLE:
+ varInfo->type = DOUBLE;
+ colIter->datatype = TDOUBLE;
+ type = COLUMN;
+ break;
+ case TLOGICAL:
+ varInfo->type = BOOLEAN;
+ colIter->datatype = TLOGICAL;
+ type = BCOLUMN;
+ break;
+ case TSTRING:
+ varInfo->type = STRING;
+ colIter->datatype = TSTRING;
+ type = SCOLUMN;
+ if ( width >= MAX_STRLEN ) {
+ sprintf(temp, "column %d is wider than maximum %d characters",
+ colnum, MAX_STRLEN-1);
+ ffpmsg(temp);
+ gParse.status = PARSE_LRG_VECTOR;
+ return pERROR;
+ }
+ if( gParse.hdutype == ASCII_TBL ) repeat = width;
+ break;
+ default:
+ if (typecode < 0) {
+ sprintf(temp, "variable-length array columns are not supported. typecode = %d", typecode);
+ ffpmsg(temp);
+ }
+ gParse.status = PARSE_BAD_TYPE;
+ return pERROR;
+ }
+ varInfo->nelem = repeat;
+ if( repeat>1 && typecode!=TSTRING ) {
+ if( fits_read_tdim( fptr, colnum, MAXDIMS,
+ &varInfo->naxis,
+ &varInfo->naxes[0], &status )
+ ) {
+ gParse.status = status;
+ return pERROR;
+ }
+ } else {
+ varInfo->naxis = 1;
+ varInfo->naxes[0] = 1;
+ }
+}
+ gParse.nCols++;
+ thelval->lng = col_cnt;
+
+ return( type );
+}
+
+static int find_keywd(char *keyname, void *itslval )
+{
+ FFSTYPE *thelval = (FFSTYPE*)itslval;
+ int status, type;
+ char keyvalue[FLEN_VALUE], dtype;
+ fitsfile *fptr;
+ double rval;
+ int bval;
+ long ival;
+
+ status = 0;
+ fptr = gParse.def_fptr;
+ if( fits_read_keyword( fptr, keyname, keyvalue, NULL, &status ) ) {
+ if( status == KEY_NO_EXIST ) {
+ /* Do this since ffgkey doesn't put an error message on stack */
+ sprintf(keyvalue, "ffgkey could not find keyword: %s",keyname);
+ ffpmsg(keyvalue);
+ }
+ gParse.status = status;
+ return( pERROR );
+ }
+
+ if( fits_get_keytype( keyvalue, &dtype, &status ) ) {
+ gParse.status = status;
+ return( pERROR );
+ }
+
+ switch( dtype ) {
+ case 'C':
+ fits_read_key_str( fptr, keyname, keyvalue, NULL, &status );
+ type = STRING;
+ strcpy( thelval->str , keyvalue );
+ break;
+ case 'L':
+ fits_read_key_log( fptr, keyname, &bval, NULL, &status );
+ type = BOOLEAN;
+ thelval->log = bval;
+ break;
+ case 'I':
+ fits_read_key_lng( fptr, keyname, &ival, NULL, &status );
+ type = LONG;
+ thelval->lng = ival;
+ break;
+ case 'F':
+ fits_read_key_dbl( fptr, keyname, &rval, NULL, &status );
+ type = DOUBLE;
+ thelval->dbl = rval;
+ break;
+ default:
+ type = pERROR;
+ break;
+ }
+
+ if( status ) {
+ gParse.status=status;
+ return pERROR;
+ }
+
+ return( type );
+}
+
+static int allocateCol( int nCol, int *status )
+{
+ if( (nCol%25)==0 ) {
+ if( nCol ) {
+ gParse.colData = (iteratorCol*) realloc( gParse.colData,
+ (nCol+25)*sizeof(iteratorCol) );
+ gParse.varData = (DataInfo *) realloc( gParse.varData,
+ (nCol+25)*sizeof(DataInfo) );
+ } else {
+ gParse.colData = (iteratorCol*) malloc( 25*sizeof(iteratorCol) );
+ gParse.varData = (DataInfo *) malloc( 25*sizeof(DataInfo) );
+ }
+ if( gParse.colData == NULL
+ || gParse.varData == NULL ) {
+ if( gParse.colData ) free(gParse.colData);
+ if( gParse.varData ) free(gParse.varData);
+ gParse.colData = NULL;
+ gParse.varData = NULL;
+ return( *status = MEMORY_ALLOCATION );
+ }
+ }
+ gParse.varData[nCol].data = NULL;
+ gParse.varData[nCol].undef = NULL;
+ return 0;
+}
+
+static int load_column( int varNum, long fRow, long nRows,
+ void *data, char *undef )
+{
+ iteratorCol *var = gParse.colData+varNum;
+ long nelem,nbytes,row,len,idx;
+ char **bitStrs, msg[80];
+ unsigned char *bytes;
+ int status = 0, anynul;
+
+ if (gParse.hdutype == IMAGE_HDU) {
+ /* This test would need to be on a per varNum basis to support
+ * cross HDU operations */
+ fits_read_imgnull(var->fptr, var->datatype, fRow, nRows,
+ data, undef, &anynul, &status);
+ if (DEBUG_PIXFILTER)
+ printf("load_column: IMAGE_HDU fRow=%ld, nRows=%ld => %d\n",
+ fRow, nRows, status);
+ } else {
+
+ nelem = nRows * var->repeat;
+
+ switch( var->datatype ) {
+ case TBYTE:
+ nbytes = ((var->repeat+7)/8) * nRows;
+ bytes = (unsigned char *)malloc( nbytes * sizeof(char) );
+
+ ffgcvb(var->fptr, var->colnum, fRow, 1L, nbytes,
+ 0, bytes, &anynul, &status);
+
+ nelem = var->repeat;
+ bitStrs = (char **)data;
+ for( row=0; row<nRows; row++ ) {
+ idx = (row)*( (nelem+7)/8 ) + 1;
+ for(len=0; len<nelem; len++) {
+ if( bytes[idx] & (1<<(7-len%8)) )
+ bitStrs[row][len] = '1';
+ else
+ bitStrs[row][len] = '0';
+ if( len%8==7 ) idx++;
+ }
+ bitStrs[row][len] = '\0';
+ }
+
+ FREE( (char *)bytes );
+ break;
+ case TSTRING:
+ ffgcfs(var->fptr, var->colnum, fRow, 1L, nRows,
+ (char **)data, undef, &anynul, &status);
+ break;
+ case TLOGICAL:
+ ffgcfl(var->fptr, var->colnum, fRow, 1L, nelem,
+ (char *)data, undef, &anynul, &status);
+ break;
+ case TLONG:
+ ffgcfj(var->fptr, var->colnum, fRow, 1L, nelem,
+ (long *)data, undef, &anynul, &status);
+ break;
+ case TDOUBLE:
+ ffgcfd(var->fptr, var->colnum, fRow, 1L, nelem,
+ (double *)data, undef, &anynul, &status);
+ break;
+ default:
+ sprintf(msg,"load_column: unexpected datatype %d", var->datatype);
+ ffpmsg(msg);
+ }
+ }
+ if( status ) {
+ gParse.status = status;
+ return pERROR;
+ }
+
+ return 0;
+}
+
+
+/*--------------------------------------------------------------------------*/
+int fits_pixel_filter (PixelFilter * filter, int * status)
+/* Evaluate an expression using the data in the input FITS file(s) */
+/*--------------------------------------------------------------------------*/
+{
+ parseInfo Info = { 0 };
+ int naxis, bitpix;
+ long nelem, naxes[MAXDIMS];
+ int col_cnt;
+ Node *result;
+ int datatype;
+ fitsfile * infptr;
+ fitsfile * outfptr;
+ char * DEFAULT_TAGS[] = { "X" };
+ char msg[256];
+ int writeBlankKwd = 0; /* write BLANK if any output nulls? */
+
+ DEBUG_PIXFILTER = getenv("DEBUG_PIXFILTER") ? 1 : 0;
+
+ if (*status)
+ return (*status);
+
+ FFLOCK;
+ if (!filter->tag || !filter->tag[0] || !filter->tag[0][0]) {
+ filter->tag = DEFAULT_TAGS;
+ if (DEBUG_PIXFILTER)
+ printf("using default tag '%s'\n", filter->tag[0]);
+ }
+
+ infptr = filter->ifptr[0];
+ outfptr = filter->ofptr;
+ gParse.pixFilter = filter;
+
+ if (ffiprs(infptr, 0, filter->expression, MAXDIMS,
+ &Info.datatype, &nelem, &naxis, naxes, status)) {
+ goto CLEANUP;
+ }
+
+ if (nelem < 0) {
+ nelem = -nelem;
+ }
+
+ {
+ /* validate result type */
+ const char * type = 0;
+ switch (Info.datatype) {
+ case TLOGICAL: type = "LOGICAL"; break;
+ case TLONG: type = "LONG"; break;
+ case TDOUBLE: type = "DOUBLE"; break;
+ case TSTRING: type = "STRING";
+ *status = pERROR;
+ ffpmsg("pixel_filter: cannot have string image");
+ case TBIT: type = "BIT";
+ if (DEBUG_PIXFILTER)
+ printf("hmm, image from bits?\n");
+ break;
+ default: type = "UNKNOWN?!";
+ *status = pERROR;
+ ffpmsg("pixel_filter: unexpected result datatype");
+ }
+ if (DEBUG_PIXFILTER)
+ printf("result type is %s [%d]\n", type, Info.datatype);
+ if (*status)
+ goto CLEANUP;
+ }
+
+ if (fits_get_img_param(infptr, MAXDIMS,
+ &bitpix, &naxis, &naxes[0], status)) {
+ ffpmsg("pixel_filter: unable to read input image parameters");
+ goto CLEANUP;
+ }
+
+ if (DEBUG_PIXFILTER)
+ printf("input bitpix %d\n", bitpix);
+
+ if (Info.datatype == TDOUBLE) {
+ /* for floating point expressions, set the default output image to
+ bitpix = -32 (float) unless the default is already a double */
+ if (bitpix != DOUBLE_IMG)
+ bitpix = FLOAT_IMG;
+ }
+
+ /* override output image bitpix if specified by caller */
+ if (filter->bitpix)
+ bitpix = filter->bitpix;
+ if (DEBUG_PIXFILTER)
+ printf("output bitpix %d\n", bitpix);
+
+ if (fits_create_img(outfptr, bitpix, naxis, naxes, status)) {
+ ffpmsg("pixel_filter: unable to create output image");
+ goto CLEANUP;
+ }
+
+ /* transfer keycards */
+ {
+ int i, ncards, more;
+ if (fits_get_hdrspace(infptr, &ncards, &more, status)) {
+ ffpmsg("pixel_filter: unable to determine number of keycards");
+ goto CLEANUP;
+ }
+
+ for (i = 1; i <= ncards; ++i) {
+
+ int keyclass;
+ char card[FLEN_CARD];
+
+ if (fits_read_record(infptr, i, card, status)) {
+ sprintf(msg, "pixel_filter: unable to read keycard %d", i);
+ ffpmsg(msg);
+ goto CLEANUP;
+ }
+
+ keyclass = fits_get_keyclass(card);
+ if (keyclass == TYP_STRUC_KEY) {
+ /* output structure defined by fits_create_img */
+ }
+ else if (keyclass == TYP_COMM_KEY && i < 12) {
+ /* assume this is one of the FITS standard comments */
+ }
+ else if (keyclass == TYP_NULL_KEY && bitpix < 0) {
+ /* do not transfer BLANK to real output image */
+ }
+ else if (keyclass == TYP_SCAL_KEY && bitpix < 0) {
+ /* do not transfer BZERO, BSCALE to real output image */
+ }
+ else if (fits_write_record(outfptr, card, status)) {
+ sprintf(msg, "pixel_filter: unable to write keycard '%s' [%d]\n",
+ card, *status);
+ ffpmsg(msg);
+ goto CLEANUP;
+ }
+ }
+ }
+
+ switch (bitpix) {
+ case BYTE_IMG: datatype = TLONG; Info.datatype = TBYTE; break;
+ case SHORT_IMG: datatype = TLONG; Info.datatype = TSHORT; break;
+ case LONG_IMG: datatype = TLONG; Info.datatype = TLONG; break;
+ case FLOAT_IMG: datatype = TDOUBLE; Info.datatype = TFLOAT; break;
+ case DOUBLE_IMG: datatype = TDOUBLE; Info.datatype = TDOUBLE; break;
+
+ default:
+ sprintf(msg, "pixel_filter: unexpected output bitpix %d\n", bitpix);
+ ffpmsg(msg);
+ *status = pERROR;
+ goto CLEANUP;
+ }
+
+ if (bitpix > 0) { /* arrange for NULLs in output */
+ long nullVal = filter->blank;
+ if (!filter->blank) {
+ int tstatus = 0;
+ if (fits_read_key_lng(infptr, "BLANK", &nullVal, 0, &tstatus)) {
+
+ writeBlankKwd = 1;
+
+ if (bitpix == BYTE_IMG)
+ nullVal = UCHAR_MAX;
+ else if (bitpix == SHORT_IMG)
+ nullVal = SHRT_MIN;
+ else if (bitpix == LONG_IMG)
+ nullVal = LONG_MIN;
+ else
+ printf("unhandled positive output BITPIX %d\n", bitpix);
+ }
+
+ filter->blank = nullVal;
+ }
+
+ fits_set_imgnull(outfptr, filter->blank, status);
+ if (DEBUG_PIXFILTER)
+ printf("using blank %ld\n", nullVal);
+
+ }
+
+ if (!filter->keyword[0]) {
+ iteratorCol * colIter;
+ DataInfo * varInfo;
+
+ /*************************************/
+ /* Create new iterator Output Column */
+ /*************************************/
+ col_cnt = gParse.nCols;
+ if (allocateCol(col_cnt, status))
+ goto CLEANUP;
+ gParse.nCols++;
+
+ colIter = &gParse.colData[col_cnt];
+ colIter->fptr = filter->ofptr;
+ colIter->iotype = OutputCol;
+ varInfo = &gParse.varData[col_cnt];
+ set_image_col_types(colIter->fptr, "CREATED", bitpix, varInfo, colIter);
+
+ Info.maxRows = -1;
+
+ if (ffiter(gParse.nCols, gParse.colData, 0,
+ 0, parse_data, &Info, status) == -1)
+ *status = 0;
+ else if (*status)
+ goto CLEANUP;
+
+ if (Info.anyNull) {
+ if (writeBlankKwd) {
+ fits_update_key_lng(outfptr, "BLANK", filter->blank, "NULL pixel value", status);
+ if (*status)
+ ffpmsg("pixel_filter: unable to write BLANK keyword");
+ if (DEBUG_PIXFILTER) {
+ printf("output has NULLs\n");
+ printf("wrote blank [%d]\n", *status);
+ }
+ }
+ }
+ else if (bitpix > 0) /* never used a null */
+ if (fits_set_imgnull(outfptr, -1234554321, status))
+ ffpmsg("pixel_filter: unable to reset imgnull");
+ }
+ else {
+
+ /* Put constant result into keyword */
+ char * parName = filter->keyword;
+ char * parInfo = filter->comment;
+
+ result = gParse.Nodes + gParse.resultNode;
+ switch (Info.datatype) {
+ case TDOUBLE:
+ ffukyd(outfptr, parName, result->value.data.dbl, 15, parInfo, status);
+ break;
+ case TLONG:
+ ffukyj(outfptr, parName, result->value.data.lng, parInfo, status);
+ break;
+ case TLOGICAL:
+ ffukyl(outfptr, parName, result->value.data.log, parInfo, status);
+ break;
+ case TBIT:
+ case TSTRING:
+ ffukys(outfptr, parName, result->value.data.str, parInfo, status);
+ break;
+ default:
+ sprintf(msg, "pixel_filter: unexpected constant result type [%d]\n",
+ Info.datatype);
+ ffpmsg(msg);
+ }
+ }
+
+CLEANUP:
+ ffcprs();
+ FFUNLOCK;
+ return (*status);
+}
diff --git a/src/plugins/cfitsio/eval_l.c b/src/plugins/cfitsio/eval_l.c
new file mode 100644
index 0000000..7dcb5dc
--- /dev/null
+++ b/src/plugins/cfitsio/eval_l.c
@@ -0,0 +1,2252 @@
+/* A lexical scanner generated by flex */
+
+/* Scanner skeleton version:
+ * $Header: /software/lheasoft/lheavc/hip/cfitsio/eval_l.c,v 3.47 2009/09/04 18:35:05 pence Exp $
+ */
+
+#define FLEX_SCANNER
+#define FF_FLEX_MAJOR_VERSION 2
+#define FF_FLEX_MINOR_VERSION 5
+
+#include <stdio.h>
+
+
+/* cfront 1.2 defines "c_plusplus" instead of "__cplusplus" */
+#ifdef c_plusplus
+#ifndef __cplusplus
+#define __cplusplus
+#endif
+#endif
+
+
+#ifdef __cplusplus
+
+#include <stdlib.h>
+#include <unistd.h>
+
+/* Use prototypes in function declarations. */
+#define FF_USE_PROTOS
+
+/* The "const" storage-class-modifier is valid. */
+#define FF_USE_CONST
+
+#else /* ! __cplusplus */
+
+#if __STDC__
+
+#define FF_USE_PROTOS
+#define FF_USE_CONST
+
+#endif /* __STDC__ */
+#endif /* ! __cplusplus */
+
+#ifdef __TURBOC__
+ #pragma warn -rch
+ #pragma warn -use
+#include <io.h>
+#include <stdlib.h>
+#define FF_USE_CONST
+#define FF_USE_PROTOS
+#endif
+
+#ifdef FF_USE_CONST
+#define ffconst const
+#else
+#define ffconst
+#endif
+
+
+#ifdef FF_USE_PROTOS
+#define FF_PROTO(proto) proto
+#else
+#define FF_PROTO(proto) ()
+#endif
+
+/* Returned upon end-of-file. */
+#define FF_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index. If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define FF_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition. This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN ff_start = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state. The FFSTATE alias is for lex
+ * compatibility.
+ */
+#define FF_START ((ff_start - 1) / 2)
+#define FFSTATE FF_START
+
+/* Action number for EOF rule of a given start state. */
+#define FF_STATE_EOF(state) (FF_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define FF_NEW_FILE ffrestart( ffin )
+
+#define FF_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#define FF_BUF_SIZE 16384
+
+typedef struct ff_buffer_state *FF_BUFFER_STATE;
+
+extern int ffleng;
+extern FILE *ffin, *ffout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+/* The funky do-while in the following #define is used to turn the definition
+ * int a single C statement (which needs a semi-colon terminator). This
+ * avoids problems with code like:
+ *
+ * if ( condition_holds )
+ * ffless( 5 );
+ * else
+ * do_something_else();
+ *
+ * Prior to using the do-while the compiler would get upset at the
+ * "else" because it interpreted the "if" statement as being all
+ * done when it reached the ';' after the ffless() call.
+ */
+
+/* Return all but the first 'n' matched characters back to the input stream. */
+
+#define ffless(n) \
+ do \
+ { \
+ /* Undo effects of setting up fftext. */ \
+ *ff_cp = ff_hold_char; \
+ FF_RESTORE_FF_MORE_OFFSET \
+ ff_c_buf_p = ff_cp = ff_bp + n - FF_MORE_ADJ; \
+ FF_DO_BEFORE_ACTION; /* set up fftext again */ \
+ } \
+ while ( 0 )
+
+#define unput(c) ffunput( c, fftext_ptr )
+
+/* The following is because we cannot portably get our hands on size_t
+ * (without autoconf's help, which isn't available because we want
+ * flex-generated scanners to compile on their own).
+ */
+typedef unsigned int ff_size_t;
+
+
+struct ff_buffer_state
+ {
+ FILE *ff_input_file;
+
+ char *ff_ch_buf; /* input buffer */
+ char *ff_buf_pos; /* current position in input buffer */
+
+ /* Size of input buffer in bytes, not including room for EOB
+ * characters.
+ */
+ ff_size_t ff_buf_size;
+
+ /* Number of characters read into ff_ch_buf, not including EOB
+ * characters.
+ */
+ int ff_n_chars;
+
+ /* Whether we "own" the buffer - i.e., we know we created it,
+ * and can realloc() it to grow it, and should free() it to
+ * delete it.
+ */
+ int ff_is_our_buffer;
+
+ /* Whether this is an "interactive" input source; if so, and
+ * if we're using stdio for input, then we want to use getc()
+ * instead of fread(), to make sure we stop fetching input after
+ * each newline.
+ */
+ int ff_is_interactive;
+
+ /* Whether we're considered to be at the beginning of a line.
+ * If so, '^' rules will be active on the next match, otherwise
+ * not.
+ */
+ int ff_at_bol;
+
+ /* Whether to try to fill the input buffer when we reach the
+ * end of it.
+ */
+ int ff_fill_buffer;
+
+ int ff_buffer_status;
+#define FF_BUFFER_NEW 0
+#define FF_BUFFER_NORMAL 1
+ /* When an EOF's been seen but there's still some text to process
+ * then we mark the buffer as FF_EOF_PENDING, to indicate that we
+ * shouldn't try reading from the input source any more. We might
+ * still have a bunch of tokens to match, though, because of
+ * possible backing-up.
+ *
+ * When we actually see the EOF, we change the status to "new"
+ * (via ffrestart()), so that the user can continue scanning by
+ * just pointing ffin at a new input file.
+ */
+#define FF_BUFFER_EOF_PENDING 2
+ };
+
+static FF_BUFFER_STATE ff_current_buffer = 0;
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ */
+#define FF_CURRENT_BUFFER ff_current_buffer
+
+
+/* ff_hold_char holds the character lost when fftext is formed. */
+static char ff_hold_char;
+
+static int ff_n_chars; /* number of characters read into ff_ch_buf */
+
+
+int ffleng;
+
+/* Points to current character in buffer. */
+static char *ff_c_buf_p = (char *) 0;
+static int ff_init = 1; /* whether we need to initialize */
+static int ff_start = 0; /* start state number */
+
+/* Flag which is used to allow ffwrap()'s to do buffer switches
+ * instead of setting up a fresh ffin. A bit of a hack ...
+ */
+static int ff_did_buffer_switch_on_eof;
+
+void ffrestart FF_PROTO(( FILE *input_file ));
+
+void ff_switch_to_buffer FF_PROTO(( FF_BUFFER_STATE new_buffer ));
+void ff_load_buffer_state FF_PROTO(( void ));
+FF_BUFFER_STATE ff_create_buffer FF_PROTO(( FILE *file, int size ));
+void ff_delete_buffer FF_PROTO(( FF_BUFFER_STATE b ));
+void ff_init_buffer FF_PROTO(( FF_BUFFER_STATE b, FILE *file ));
+void ff_flush_buffer FF_PROTO(( FF_BUFFER_STATE b ));
+#define FF_FLUSH_BUFFER ff_flush_buffer( ff_current_buffer )
+
+FF_BUFFER_STATE ff_scan_buffer FF_PROTO(( char *base, ff_size_t size ));
+FF_BUFFER_STATE ff_scan_string FF_PROTO(( ffconst char *ff_str ));
+FF_BUFFER_STATE ff_scan_bytes FF_PROTO(( ffconst char *bytes, int len ));
+
+static void *ff_flex_alloc FF_PROTO(( ff_size_t ));
+static void *ff_flex_realloc FF_PROTO(( void *, ff_size_t ));
+static void ff_flex_free FF_PROTO(( void * ));
+
+#define ff_new_buffer ff_create_buffer
+
+#define ff_set_interactive(is_interactive) \
+ { \
+ if ( ! ff_current_buffer ) \
+ ff_current_buffer = ff_create_buffer( ffin, FF_BUF_SIZE ); \
+ ff_current_buffer->ff_is_interactive = is_interactive; \
+ }
+
+#define ff_set_bol(at_bol) \
+ { \
+ if ( ! ff_current_buffer ) \
+ ff_current_buffer = ff_create_buffer( ffin, FF_BUF_SIZE ); \
+ ff_current_buffer->ff_at_bol = at_bol; \
+ }
+
+#define FF_AT_BOL() (ff_current_buffer->ff_at_bol)
+
+typedef unsigned char FF_CHAR;
+FILE *ffin = (FILE *) 0, *ffout = (FILE *) 0;
+typedef int ff_state_type;
+extern char *fftext;
+#define fftext_ptr fftext
+
+static ff_state_type ff_get_previous_state FF_PROTO(( void ));
+static ff_state_type ff_try_NUL_trans FF_PROTO(( ff_state_type current_state ));
+static int ff_get_next_buffer FF_PROTO(( void ));
+static void ff_fatal_error FF_PROTO(( ffconst char msg[] ));
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up fftext.
+ */
+#define FF_DO_BEFORE_ACTION \
+ fftext_ptr = ff_bp; \
+ ffleng = (int) (ff_cp - ff_bp); \
+ ff_hold_char = *ff_cp; \
+ *ff_cp = '\0'; \
+ ff_c_buf_p = ff_cp;
+
+#define FF_NUM_RULES 26
+#define FF_END_OF_BUFFER 27
+static ffconst short int ff_accept[160] =
+ { 0,
+ 0, 0, 27, 25, 1, 24, 15, 25, 25, 25,
+ 25, 25, 25, 25, 7, 5, 21, 25, 20, 10,
+ 10, 10, 10, 6, 10, 10, 10, 10, 10, 14,
+ 10, 10, 10, 10, 10, 10, 10, 25, 1, 19,
+ 0, 9, 0, 8, 0, 10, 17, 0, 0, 0,
+ 0, 0, 0, 0, 14, 0, 7, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 7,
+ 5, 0, 23, 18, 22, 10, 10, 10, 2, 10,
+ 10, 10, 4, 10, 10, 10, 10, 3, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 16, 0,
+
+ 8, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 7, 11, 10,
+ 20, 21, 10, 10, 10, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 15, 0, 0, 12, 0,
+ 0, 0, 0, 0, 0, 0, 13, 0, 0
+ } ;
+
+static ffconst int ff_ec[256] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 2, 4, 5, 6, 7, 1, 8, 9, 10,
+ 11, 12, 13, 1, 13, 14, 1, 15, 15, 16,
+ 16, 16, 16, 16, 16, 17, 17, 1, 1, 18,
+ 19, 20, 1, 1, 21, 22, 23, 24, 25, 26,
+ 27, 28, 29, 30, 30, 31, 30, 32, 33, 30,
+ 34, 35, 30, 36, 37, 30, 30, 38, 30, 30,
+ 1, 1, 1, 39, 40, 1, 41, 42, 23, 43,
+
+ 44, 45, 46, 28, 47, 30, 30, 48, 30, 49,
+ 50, 30, 51, 52, 30, 53, 54, 30, 30, 38,
+ 30, 30, 1, 55, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1
+ } ;
+
+static ffconst int ff_meta[56] =
+ { 0,
+ 1, 1, 2, 1, 1, 1, 3, 1, 1, 1,
+ 1, 1, 1, 1, 4, 4, 4, 1, 1, 1,
+ 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 4, 1, 4,
+ 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
+ 4, 4, 4, 4, 1
+ } ;
+
+static ffconst short int ff_base[167] =
+ { 0,
+ 0, 0, 367, 368, 364, 368, 346, 359, 356, 355,
+ 353, 351, 32, 347, 66, 103, 339, 44, 338, 25,
+ 52, 316, 26, 315, 34, 133, 48, 61, 125, 368,
+ 0, 29, 45, 60, 81, 82, 93, 299, 351, 368,
+ 347, 368, 344, 343, 342, 368, 368, 339, 314, 315,
+ 313, 294, 295, 293, 368, 121, 164, 307, 301, 70,
+ 117, 43, 296, 276, 271, 58, 86, 79, 269, 152,
+ 168, 181, 368, 368, 368, 151, 162, 0, 180, 189,
+ 190, 191, 309, 196, 199, 205, 204, 211, 214, 207,
+ 223, 224, 232, 238, 243, 245, 222, 246, 368, 311,
+
+ 310, 279, 282, 278, 259, 262, 258, 252, 286, 295,
+ 294, 293, 292, 291, 290, 267, 288, 258, 285, 284,
+ 278, 270, 268, 259, 218, 252, 264, 272, 368, 251,
+ 368, 368, 260, 280, 283, 236, 222, 230, 193, 184,
+ 212, 208, 202, 173, 156, 368, 133, 126, 368, 104,
+ 98, 119, 132, 80, 94, 92, 368, 78, 368, 323,
+ 325, 329, 333, 68, 67, 337
+ } ;
+
+static ffconst short int ff_def[167] =
+ { 0,
+ 159, 1, 159, 159, 159, 159, 159, 160, 161, 162,
+ 159, 163, 159, 159, 159, 159, 159, 159, 159, 164,
+ 164, 164, 164, 164, 164, 164, 164, 164, 164, 159,
+ 165, 164, 164, 164, 164, 164, 164, 159, 159, 159,
+ 160, 159, 166, 161, 162, 159, 159, 163, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 164, 164, 165, 164, 164,
+ 164, 164, 26, 164, 164, 164, 164, 164, 164, 164,
+ 164, 164, 164, 164, 164, 164, 164, 164, 159, 166,
+
+ 166, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 164,
+ 159, 159, 164, 164, 164, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 0, 159,
+ 159, 159, 159, 159, 159, 159
+ } ;
+
+static ffconst short int ff_nxt[424] =
+ { 0,
+ 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
+ 4, 14, 4, 15, 16, 16, 16, 17, 18, 19,
+ 20, 21, 22, 22, 23, 24, 25, 26, 22, 22,
+ 27, 28, 29, 22, 22, 24, 22, 22, 30, 31,
+ 32, 21, 22, 33, 24, 34, 22, 35, 36, 37,
+ 22, 22, 24, 22, 38, 49, 77, 50, 81, 80,
+ 51, 73, 74, 75, 78, 78, 79, 115, 78, 82,
+ 78, 76, 84, 78, 52, 116, 53, 90, 54, 56,
+ 57, 57, 57, 85, 78, 86, 58, 78, 157, 79,
+ 59, 78, 60, 87, 111, 91, 61, 62, 63, 78,
+
+ 78, 120, 157, 92, 157, 112, 64, 88, 88, 65,
+ 121, 66, 93, 67, 68, 69, 70, 71, 71, 71,
+ 78, 78, 124, 158, 94, 96, 72, 72, 125, 122,
+ 88, 97, 78, 95, 56, 108, 108, 108, 123, 88,
+ 88, 113, 157, 156, 98, 72, 72, 83, 83, 83,
+ 155, 154, 114, 83, 83, 83, 83, 83, 83, 89,
+ 129, 153, 88, 152, 78, 56, 57, 57, 57, 146,
+ 83, 129, 78, 83, 83, 83, 83, 83, 57, 57,
+ 57, 70, 71, 71, 71, 130, 47, 72, 72, 129,
+ 78, 72, 72, 127, 79, 128, 128, 128, 129, 129,
+
+ 129, 78, 74, 75, 131, 129, 72, 72, 129, 73,
+ 72, 72, 132, 129, 129, 146, 129, 79, 40, 78,
+ 129, 47, 149, 129, 151, 88, 88, 99, 78, 78,
+ 78, 129, 129, 129, 150, 78, 74, 75, 78, 133,
+ 149, 129, 148, 78, 78, 131, 78, 129, 88, 134,
+ 78, 73, 129, 78, 129, 129, 132, 147, 40, 99,
+ 129, 78, 78, 78, 47, 99, 108, 108, 108, 129,
+ 145, 78, 40, 146, 135, 72, 72, 78, 128, 128,
+ 128, 132, 78, 73, 78, 78, 128, 128, 128, 129,
+ 78, 131, 129, 47, 72, 72, 146, 75, 74, 78,
+
+ 144, 99, 143, 40, 132, 73, 131, 75, 74, 142,
+ 141, 140, 139, 138, 137, 136, 101, 101, 129, 78,
+ 126, 119, 78, 41, 118, 41, 41, 44, 44, 45,
+ 117, 45, 45, 48, 110, 48, 48, 100, 109, 100,
+ 100, 107, 106, 105, 104, 103, 102, 42, 46, 159,
+ 101, 42, 39, 99, 78, 78, 75, 73, 55, 42,
+ 47, 46, 43, 42, 40, 39, 159, 3, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159
+ } ;
+
+static ffconst short int ff_chk[424] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 13, 20, 13, 25, 23,
+ 13, 18, 18, 18, 20, 23, 21, 62, 32, 25,
+ 165, 164, 27, 25, 13, 62, 13, 32, 13, 15,
+ 15, 15, 15, 27, 33, 28, 15, 27, 158, 21,
+ 15, 21, 15, 28, 60, 33, 15, 15, 15, 34,
+
+ 28, 66, 156, 34, 155, 60, 15, 37, 37, 15,
+ 66, 15, 34, 15, 15, 15, 16, 16, 16, 16,
+ 35, 36, 68, 154, 35, 36, 16, 16, 68, 67,
+ 37, 36, 37, 35, 56, 56, 56, 56, 67, 29,
+ 29, 61, 153, 152, 37, 16, 16, 26, 26, 26,
+ 151, 150, 61, 26, 26, 26, 26, 26, 26, 29,
+ 76, 148, 29, 147, 29, 70, 70, 70, 70, 145,
+ 26, 77, 26, 26, 26, 26, 26, 26, 57, 57,
+ 57, 71, 71, 71, 71, 77, 144, 57, 57, 79,
+ 76, 71, 71, 72, 79, 72, 72, 72, 80, 81,
+
+ 82, 77, 80, 81, 82, 84, 57, 57, 85, 84,
+ 71, 71, 85, 87, 86, 143, 90, 79, 86, 79,
+ 88, 142, 141, 89, 140, 88, 88, 89, 80, 81,
+ 82, 97, 91, 92, 139, 84, 91, 92, 85, 87,
+ 138, 93, 137, 87, 86, 93, 90, 94, 88, 90,
+ 88, 94, 95, 89, 96, 98, 95, 136, 96, 98,
+ 130, 97, 91, 92, 130, 126, 108, 108, 108, 133,
+ 125, 93, 124, 133, 97, 108, 108, 94, 127, 127,
+ 127, 123, 95, 122, 96, 98, 128, 128, 128, 134,
+ 130, 121, 135, 134, 108, 108, 135, 120, 119, 133,
+
+ 118, 117, 116, 115, 114, 113, 112, 111, 110, 109,
+ 107, 106, 105, 104, 103, 102, 101, 100, 83, 134,
+ 69, 65, 135, 160, 64, 160, 160, 161, 161, 162,
+ 63, 162, 162, 163, 59, 163, 163, 166, 58, 166,
+ 166, 54, 53, 52, 51, 50, 49, 48, 45, 44,
+ 43, 41, 39, 38, 24, 22, 19, 17, 14, 12,
+ 11, 10, 9, 8, 7, 5, 3, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159, 159, 159, 159, 159, 159, 159, 159,
+ 159, 159, 159
+ } ;
+
+static ff_state_type ff_last_accepting_state;
+static char *ff_last_accepting_cpos;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define ffmore() ffmore_used_but_not_detected
+#define FF_MORE_ADJ 0
+#define FF_RESTORE_FF_MORE_OFFSET
+char *fftext;
+#line 1 "eval.l"
+#define INITIAL 0
+#line 2 "eval.l"
+/************************************************************************/
+/* */
+/* 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 ffGetVariable( char *varName, FFSTYPE *varVal );
+
+static int find_variable( char *varName );
+static int expr_read( char *buf, int nbytes );
+
+/***** Definitions *****/
+
+#define FF_NO_UNPUT /* Don't include FFUNPUT function */
+#define FF_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 FF_INPUT
+#define FF_INPUT(buf,result,max_size) \
+ if ( (result = expr_read( (char *) buf, max_size )) < 0 ) \
+ FF_FATAL_ERROR( "read() in flex scanner failed" );
+
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef FF_SKIP_FFWRAP
+#ifdef __cplusplus
+extern "C" int ffwrap FF_PROTO(( void ));
+#else
+extern int ffwrap FF_PROTO(( void ));
+#endif
+#endif
+
+#ifndef FF_NO_UNPUT
+static void ffunput FF_PROTO(( int c, char *buf_ptr ));
+#endif
+
+#ifndef fftext_ptr
+static void ff_flex_strncpy FF_PROTO(( char *, ffconst char *, int ));
+#endif
+
+#ifdef FF_NEED_STRLEN
+static int ff_flex_strlen FF_PROTO(( ffconst char * ));
+#endif
+
+#ifndef FF_NO_INPUT
+#ifdef __cplusplus
+static int ffinput FF_PROTO(( void ));
+#else
+static int input FF_PROTO(( void ));
+#endif
+#endif
+
+#if FF_STACK_USED
+static int ff_start_stack_ptr = 0;
+static int ff_start_stack_depth = 0;
+static int *ff_start_stack = 0;
+#ifndef FF_NO_PUSH_STATE
+static void ff_push_state FF_PROTO(( int new_state ));
+#endif
+#ifndef FF_NO_POP_STATE
+static void ff_pop_state FF_PROTO(( void ));
+#endif
+#ifndef FF_NO_TOP_STATE
+static int ff_top_state FF_PROTO(( void ));
+#endif
+
+#else
+#define FF_NO_PUSH_STATE 1
+#define FF_NO_POP_STATE 1
+#define FF_NO_TOP_STATE 1
+#endif
+
+#ifdef FF_MALLOC_DECL
+FF_MALLOC_DECL
+#else
+#if __STDC__
+#ifndef __cplusplus
+#include <stdlib.h>
+#endif
+#else
+/* Just try to get by without declaring the routines. This will fail
+ * miserably on non-ANSI systems for which sizeof(size_t) != sizeof(int)
+ * or sizeof(void*) != sizeof(int).
+ */
+#endif
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef FF_READ_BUF_SIZE
+#define FF_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO (void) fwrite( fftext, ffleng, 1, ffout )
+#endif
+
+/* Gets input and stuffs it into "buf". number of characters read, or FF_NULL,
+ * is returned in "result".
+ */
+#ifndef FF_INPUT
+#define FF_INPUT(buf,result,max_size) \
+ if ( ff_current_buffer->ff_is_interactive ) \
+ { \
+ int c = '*', n; \
+ for ( n = 0; n < max_size && \
+ (c = getc( ffin )) != EOF && c != '\n'; ++n ) \
+ buf[n] = (char) c; \
+ if ( c == '\n' ) \
+ buf[n++] = (char) c; \
+ if ( c == EOF && ferror( ffin ) ) \
+ FF_FATAL_ERROR( "input in flex scanner failed" ); \
+ result = n; \
+ } \
+ else if ( ((result = fread( buf, 1, max_size, ffin )) == 0) \
+ && ferror( ffin ) ) \
+ FF_FATAL_ERROR( "input in flex scanner failed" );
+#endif
+
+/* No semi-colon after return; correct usage is to write "ffterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef ffterminate
+#define ffterminate() return FF_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef FF_START_STACK_INCR
+#define FF_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef FF_FATAL_ERROR
+#define FF_FATAL_ERROR(msg) ff_fatal_error( msg )
+#endif
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef FF_DECL
+#define FF_DECL int fflex FF_PROTO(( void ))
+#endif
+
+/* Code executed at the beginning of each rule, after fftext and ffleng
+ * have been set up.
+ */
+#ifndef FF_USER_ACTION
+#define FF_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef FF_BREAK
+#define FF_BREAK break;
+#endif
+
+#define FF_RULE_SETUP \
+ FF_USER_ACTION
+
+FF_DECL
+ {
+ register ff_state_type ff_current_state;
+ register char *ff_cp, *ff_bp;
+ register int ff_act;
+
+#line 142 "eval.l"
+
+
+
+ if ( ff_init )
+ {
+ ff_init = 0;
+
+#ifdef FF_USER_INIT
+ FF_USER_INIT;
+#endif
+
+ if ( ! ff_start )
+ ff_start = 1; /* first start state */
+
+ if ( ! ffin )
+ ffin = stdin;
+
+ if ( ! ffout )
+ ffout = stdout;
+
+ if ( ! ff_current_buffer )
+ ff_current_buffer =
+ ff_create_buffer( ffin, FF_BUF_SIZE );
+
+ ff_load_buffer_state();
+ }
+
+ while ( 1 ) /* loops until end-of-file is reached */
+ {
+ ff_cp = ff_c_buf_p;
+
+ /* Support of fftext. */
+ *ff_cp = ff_hold_char;
+
+ /* ff_bp points to the position in ff_ch_buf of the start of
+ * the current run.
+ */
+ ff_bp = ff_cp;
+
+ ff_current_state = ff_start;
+ff_match:
+ do
+ {
+ register FF_CHAR ff_c = ff_ec[FF_SC_TO_UI(*ff_cp)];
+ if ( ff_accept[ff_current_state] )
+ {
+ ff_last_accepting_state = ff_current_state;
+ ff_last_accepting_cpos = ff_cp;
+ }
+ while ( ff_chk[ff_base[ff_current_state] + ff_c] != ff_current_state )
+ {
+ ff_current_state = (int) ff_def[ff_current_state];
+ if ( ff_current_state >= 160 )
+ ff_c = ff_meta[(unsigned int) ff_c];
+ }
+ ff_current_state = ff_nxt[ff_base[ff_current_state] + (unsigned int) ff_c];
+ ++ff_cp;
+ }
+ while ( ff_base[ff_current_state] != 368 );
+
+ff_find_action:
+ ff_act = ff_accept[ff_current_state];
+ if ( ff_act == 0 )
+ { /* have to back up */
+ ff_cp = ff_last_accepting_cpos;
+ ff_current_state = ff_last_accepting_state;
+ ff_act = ff_accept[ff_current_state];
+ }
+
+ FF_DO_BEFORE_ACTION;
+
+
+do_action: /* This label is used only to access EOF actions. */
+
+
+ switch ( ff_act )
+ { /* beginning of action switch */
+ case 0: /* must back up */
+ /* undo the effects of FF_DO_BEFORE_ACTION */
+ *ff_cp = ff_hold_char;
+ ff_cp = ff_last_accepting_cpos;
+ ff_current_state = ff_last_accepting_state;
+ goto ff_find_action;
+
+case 1:
+FF_RULE_SETUP
+#line 144 "eval.l"
+;
+ FF_BREAK
+case 2:
+FF_RULE_SETUP
+#line 145 "eval.l"
+{
+ int len;
+ len = strlen(fftext);
+ while (fftext[len] == ' ')
+ len--;
+ len = len - 1;
+ strncpy(fflval.str,&fftext[1],len);
+ fflval.str[len] = '\0';
+ return( BITSTR );
+ }
+ FF_BREAK
+case 3:
+FF_RULE_SETUP
+#line 155 "eval.l"
+{
+ int len;
+ char tmpstring[256];
+ char bitstring[256];
+ len = strlen(fftext);
+ if (len >= 256) {
+ char errMsg[100];
+ gParse.status = PARSE_SYNTAX_ERR;
+ strcpy (errMsg,"Bit string exceeds maximum length: '");
+ strncat(errMsg, &(fftext[0]), 20);
+ strcat (errMsg,"...'");
+ ffpmsg (errMsg);
+ len = 0;
+ } else {
+ while (fftext[len] == ' ')
+ len--;
+ len = len - 1;
+ strncpy(tmpstring,&fftext[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( fflval.str, bitstring );
+ return( BITSTR );
+ }
+ FF_BREAK
+case 4:
+FF_RULE_SETUP
+#line 215 "eval.l"
+{
+ int len;
+ char tmpstring[256];
+ char bitstring[256];
+ len = strlen(fftext);
+ if (len >= 256) {
+ char errMsg[100];
+ gParse.status = PARSE_SYNTAX_ERR;
+ strcpy (errMsg,"Hex string exceeds maximum length: '");
+ strncat(errMsg, &(fftext[0]), 20);
+ strcat (errMsg,"...'");
+ ffpmsg (errMsg);
+ len = 0;
+ } else {
+ while (fftext[len] == ' ')
+ len--;
+ len = len - 1;
+ strncpy(tmpstring,&fftext[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( fflval.str, bitstring );
+ return( BITSTR );
+ }
+ FF_BREAK
+case 5:
+FF_RULE_SETUP
+#line 306 "eval.l"
+{
+ fflval.lng = atol(fftext);
+ return( LONG );
+ }
+ FF_BREAK
+case 6:
+FF_RULE_SETUP
+#line 310 "eval.l"
+{
+ if ((fftext[0] == 't') || (fftext[0] == 'T'))
+ fflval.log = 1;
+ else
+ fflval.log = 0;
+ return( BOOLEAN );
+ }
+ FF_BREAK
+case 7:
+FF_RULE_SETUP
+#line 317 "eval.l"
+{
+ fflval.dbl = atof(fftext);
+ return( DOUBLE );
+ }
+ FF_BREAK
+case 8:
+FF_RULE_SETUP
+#line 321 "eval.l"
+{
+ if( !strcasecmp(fftext,"#PI") ) {
+ fflval.dbl = (double)(4) * atan((double)(1));
+ return( DOUBLE );
+ } else if( !strcasecmp(fftext,"#E") ) {
+ fflval.dbl = exp((double)(1));
+ return( DOUBLE );
+ } else if( !strcasecmp(fftext,"#DEG") ) {
+ fflval.dbl = ((double)4)*atan((double)1)/((double)180);
+ return( DOUBLE );
+ } else if( !strcasecmp(fftext,"#ROW") ) {
+ return( ROWREF );
+ } else if( !strcasecmp(fftext,"#NULL") ) {
+ return( NULLREF );
+ } else if( !strcasecmp(fftext,"#SNULL") ) {
+ return( SNULLREF );
+ } else {
+ int len;
+ if (fftext[1] == '$') {
+ len = strlen(fftext) - 3;
+ fflval.str[0] = '#';
+ strncpy(fflval.str+1,&fftext[2],len);
+ fflval.str[len+1] = '\0';
+ fftext = fflval.str;
+ }
+ return( (*gParse.getData)(fftext, &fflval) );
+ }
+ }
+ FF_BREAK
+case 9:
+FF_RULE_SETUP
+#line 349 "eval.l"
+{
+ int len;
+ len = strlen(fftext) - 2;
+ if (len >= MAX_STRLEN) {
+ char errMsg[100];
+ gParse.status = PARSE_SYNTAX_ERR;
+ strcpy (errMsg,"String exceeds maximum length: '");
+ strncat(errMsg, &(fftext[1]), 20);
+ strcat (errMsg,"...'");
+ ffpmsg (errMsg);
+ len = 0;
+ } else {
+ strncpy(fflval.str,&fftext[1],len);
+ }
+ fflval.str[len] = '\0';
+ return( STRING );
+ }
+ FF_BREAK
+case 10:
+FF_RULE_SETUP
+#line 366 "eval.l"
+{
+ int len,type;
+
+ if (fftext[0] == '$') {
+ len = strlen(fftext) - 2;
+ strncpy(fflval.str,&fftext[1],len);
+ fflval.str[len] = '\0';
+ fftext = fflval.str;
+ }
+ type = ffGetVariable(fftext, &fflval);
+ return( type );
+ }
+ FF_BREAK
+case 11:
+FF_RULE_SETUP
+#line 378 "eval.l"
+{
+ char *fname;
+ int len=0;
+ fname = &fflval.str[0];
+ while( (fname[len]=toupper(fftext[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 );
+ }
+ FF_BREAK
+case 12:
+FF_RULE_SETUP
+#line 405 "eval.l"
+{ return( INTCAST ); }
+ FF_BREAK
+case 13:
+FF_RULE_SETUP
+#line 406 "eval.l"
+{ return( FLTCAST ); }
+ FF_BREAK
+case 14:
+FF_RULE_SETUP
+#line 407 "eval.l"
+{ return( POWER ); }
+ FF_BREAK
+case 15:
+FF_RULE_SETUP
+#line 408 "eval.l"
+{ return( NOT ); }
+ FF_BREAK
+case 16:
+FF_RULE_SETUP
+#line 409 "eval.l"
+{ return( OR ); }
+ FF_BREAK
+case 17:
+FF_RULE_SETUP
+#line 410 "eval.l"
+{ return( AND ); }
+ FF_BREAK
+case 18:
+FF_RULE_SETUP
+#line 411 "eval.l"
+{ return( EQ ); }
+ FF_BREAK
+case 19:
+FF_RULE_SETUP
+#line 412 "eval.l"
+{ return( NE ); }
+ FF_BREAK
+case 20:
+FF_RULE_SETUP
+#line 413 "eval.l"
+{ return( GT ); }
+ FF_BREAK
+case 21:
+FF_RULE_SETUP
+#line 414 "eval.l"
+{ return( LT ); }
+ FF_BREAK
+case 22:
+FF_RULE_SETUP
+#line 415 "eval.l"
+{ return( GTE ); }
+ FF_BREAK
+case 23:
+FF_RULE_SETUP
+#line 416 "eval.l"
+{ return( LTE ); }
+ FF_BREAK
+case 24:
+FF_RULE_SETUP
+#line 417 "eval.l"
+{ return( '\n' ); }
+ FF_BREAK
+case 25:
+FF_RULE_SETUP
+#line 418 "eval.l"
+{ return( fftext[0] ); }
+ FF_BREAK
+case 26:
+FF_RULE_SETUP
+#line 419 "eval.l"
+ECHO;
+ FF_BREAK
+case FF_STATE_EOF(INITIAL):
+ ffterminate();
+
+ case FF_END_OF_BUFFER:
+ {
+ /* Amount of text matched not including the EOB char. */
+ int ff_amount_of_matched_text = (int) (ff_cp - fftext_ptr) - 1;
+
+ /* Undo the effects of FF_DO_BEFORE_ACTION. */
+ *ff_cp = ff_hold_char;
+ FF_RESTORE_FF_MORE_OFFSET
+
+ if ( ff_current_buffer->ff_buffer_status == FF_BUFFER_NEW )
+ {
+ /* We're scanning a new file or input source. It's
+ * possible that this happened because the user
+ * just pointed ffin at a new source and called
+ * fflex(). If so, then we have to assure
+ * consistency between ff_current_buffer and our
+ * globals. Here is the right place to do so, because
+ * this is the first action (other than possibly a
+ * back-up) that will match for the new input source.
+ */
+ ff_n_chars = ff_current_buffer->ff_n_chars;
+ ff_current_buffer->ff_input_file = ffin;
+ ff_current_buffer->ff_buffer_status = FF_BUFFER_NORMAL;
+ }
+
+ /* Note that here we test for ff_c_buf_p "<=" to the position
+ * of the first EOB in the buffer, since ff_c_buf_p will
+ * already have been incremented past the NUL character
+ * (since all states make transitions on EOB to the
+ * end-of-buffer state). Contrast this with the test
+ * in input().
+ */
+ if ( ff_c_buf_p <= &ff_current_buffer->ff_ch_buf[ff_n_chars] )
+ { /* This was really a NUL. */
+ ff_state_type ff_next_state;
+
+ ff_c_buf_p = fftext_ptr + ff_amount_of_matched_text;
+
+ ff_current_state = ff_get_previous_state();
+
+ /* Okay, we're now positioned to make the NUL
+ * transition. We couldn't have
+ * ff_get_previous_state() go ahead and do it
+ * for us because it doesn't know how to deal
+ * with the possibility of jamming (and we don't
+ * want to build jamming into it because then it
+ * will run more slowly).
+ */
+
+ ff_next_state = ff_try_NUL_trans( ff_current_state );
+
+ ff_bp = fftext_ptr + FF_MORE_ADJ;
+
+ if ( ff_next_state )
+ {
+ /* Consume the NUL. */
+ ff_cp = ++ff_c_buf_p;
+ ff_current_state = ff_next_state;
+ goto ff_match;
+ }
+
+ else
+ {
+ ff_cp = ff_c_buf_p;
+ goto ff_find_action;
+ }
+ }
+
+ else switch ( ff_get_next_buffer() )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ ff_did_buffer_switch_on_eof = 0;
+
+ if ( ffwrap() )
+ {
+ /* Note: because we've taken care in
+ * ff_get_next_buffer() to have set up
+ * fftext, we can now set up
+ * ff_c_buf_p so that if some total
+ * hoser (like flex itself) wants to
+ * call the scanner after we return the
+ * FF_NULL, it'll still work - another
+ * FF_NULL will get returned.
+ */
+ ff_c_buf_p = fftext_ptr + FF_MORE_ADJ;
+
+ ff_act = FF_STATE_EOF(FF_START);
+ goto do_action;
+ }
+
+ else
+ {
+ if ( ! ff_did_buffer_switch_on_eof )
+ FF_NEW_FILE;
+ }
+ break;
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ ff_c_buf_p =
+ fftext_ptr + ff_amount_of_matched_text;
+
+ ff_current_state = ff_get_previous_state();
+
+ ff_cp = ff_c_buf_p;
+ ff_bp = fftext_ptr + FF_MORE_ADJ;
+ goto ff_match;
+
+ case EOB_ACT_LAST_MATCH:
+ ff_c_buf_p =
+ &ff_current_buffer->ff_ch_buf[ff_n_chars];
+
+ ff_current_state = ff_get_previous_state();
+
+ ff_cp = ff_c_buf_p;
+ ff_bp = fftext_ptr + FF_MORE_ADJ;
+ goto ff_find_action;
+ }
+ break;
+ }
+
+ default:
+ FF_FATAL_ERROR(
+ "fatal flex scanner internal error--no action found" );
+ } /* end of action switch */
+ } /* end of scanning one token */
+ } /* end of fflex */
+
+
+/* ff_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ * EOB_ACT_LAST_MATCH -
+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ * EOB_ACT_END_OF_FILE - end of file
+ */
+
+static int ff_get_next_buffer()
+ {
+ register char *dest = ff_current_buffer->ff_ch_buf;
+ register char *source = fftext_ptr;
+ register int number_to_move, i;
+ int ret_val;
+
+ if ( ff_c_buf_p > &ff_current_buffer->ff_ch_buf[ff_n_chars + 1] )
+ FF_FATAL_ERROR(
+ "fatal flex scanner internal error--end of buffer missed" );
+
+ if ( ff_current_buffer->ff_fill_buffer == 0 )
+ { /* Don't try to fill the buffer, so this is an EOF. */
+ if ( ff_c_buf_p - fftext_ptr - FF_MORE_ADJ == 1 )
+ {
+ /* We matched a single character, the EOB, so
+ * treat this as a final EOF.
+ */
+ return EOB_ACT_END_OF_FILE;
+ }
+
+ else
+ {
+ /* We matched some text prior to the EOB, first
+ * process it.
+ */
+ return EOB_ACT_LAST_MATCH;
+ }
+ }
+
+ /* Try to read more data. */
+
+ /* First move last chars to start of buffer. */
+ number_to_move = (int) (ff_c_buf_p - fftext_ptr) - 1;
+
+ for ( i = 0; i < number_to_move; ++i )
+ *(dest++) = *(source++);
+
+ if ( ff_current_buffer->ff_buffer_status == FF_BUFFER_EOF_PENDING )
+ /* don't do the read, it's not guaranteed to return an EOF,
+ * just force an EOF
+ */
+ ff_current_buffer->ff_n_chars = ff_n_chars = 0;
+
+ else
+ {
+ int num_to_read =
+ ff_current_buffer->ff_buf_size - number_to_move - 1;
+
+ while ( num_to_read <= 0 )
+ { /* Not enough room in the buffer - grow it. */
+#ifdef FF_USES_REJECT
+ FF_FATAL_ERROR(
+"input buffer overflow, can't enlarge buffer because scanner uses REJECT" );
+#else
+
+ /* just a shorter name for the current buffer */
+ FF_BUFFER_STATE b = ff_current_buffer;
+
+ int ff_c_buf_p_offset =
+ (int) (ff_c_buf_p - b->ff_ch_buf);
+
+ if ( b->ff_is_our_buffer )
+ {
+ int new_size = b->ff_buf_size * 2;
+
+ if ( new_size <= 0 )
+ b->ff_buf_size += b->ff_buf_size / 8;
+ else
+ b->ff_buf_size *= 2;
+
+ b->ff_ch_buf = (char *)
+ /* Include room in for 2 EOB chars. */
+ ff_flex_realloc( (void *) b->ff_ch_buf,
+ b->ff_buf_size + 2 );
+ }
+ else
+ /* Can't grow it, we don't own it. */
+ b->ff_ch_buf = 0;
+
+ if ( ! b->ff_ch_buf )
+ FF_FATAL_ERROR(
+ "fatal error - scanner input buffer overflow" );
+
+ ff_c_buf_p = &b->ff_ch_buf[ff_c_buf_p_offset];
+
+ num_to_read = ff_current_buffer->ff_buf_size -
+ number_to_move - 1;
+#endif
+ }
+
+ if ( num_to_read > FF_READ_BUF_SIZE )
+ num_to_read = FF_READ_BUF_SIZE;
+
+ /* Read in more data. */
+ FF_INPUT( (&ff_current_buffer->ff_ch_buf[number_to_move]),
+ ff_n_chars, num_to_read );
+
+ ff_current_buffer->ff_n_chars = ff_n_chars;
+ }
+
+ if ( ff_n_chars == 0 )
+ {
+ if ( number_to_move == FF_MORE_ADJ )
+ {
+ ret_val = EOB_ACT_END_OF_FILE;
+ ffrestart( ffin );
+ }
+
+ else
+ {
+ ret_val = EOB_ACT_LAST_MATCH;
+ ff_current_buffer->ff_buffer_status =
+ FF_BUFFER_EOF_PENDING;
+ }
+ }
+
+ else
+ ret_val = EOB_ACT_CONTINUE_SCAN;
+
+ ff_n_chars += number_to_move;
+ ff_current_buffer->ff_ch_buf[ff_n_chars] = FF_END_OF_BUFFER_CHAR;
+ ff_current_buffer->ff_ch_buf[ff_n_chars + 1] = FF_END_OF_BUFFER_CHAR;
+
+ fftext_ptr = &ff_current_buffer->ff_ch_buf[0];
+
+ return ret_val;
+ }
+
+
+/* ff_get_previous_state - get the state just before the EOB char was reached */
+
+static ff_state_type ff_get_previous_state()
+ {
+ register ff_state_type ff_current_state;
+ register char *ff_cp;
+
+ ff_current_state = ff_start;
+
+ for ( ff_cp = fftext_ptr + FF_MORE_ADJ; ff_cp < ff_c_buf_p; ++ff_cp )
+ {
+ register FF_CHAR ff_c = (*ff_cp ? ff_ec[FF_SC_TO_UI(*ff_cp)] : 1);
+ if ( ff_accept[ff_current_state] )
+ {
+ ff_last_accepting_state = ff_current_state;
+ ff_last_accepting_cpos = ff_cp;
+ }
+ while ( ff_chk[ff_base[ff_current_state] + ff_c] != ff_current_state )
+ {
+ ff_current_state = (int) ff_def[ff_current_state];
+ if ( ff_current_state >= 160 )
+ ff_c = ff_meta[(unsigned int) ff_c];
+ }
+ ff_current_state = ff_nxt[ff_base[ff_current_state] + (unsigned int) ff_c];
+ }
+
+ return ff_current_state;
+ }
+
+
+/* ff_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ * next_state = ff_try_NUL_trans( current_state );
+ */
+
+#ifdef FF_USE_PROTOS
+static ff_state_type ff_try_NUL_trans( ff_state_type ff_current_state )
+#else
+static ff_state_type ff_try_NUL_trans( ff_current_state )
+ff_state_type ff_current_state;
+#endif
+ {
+ register int ff_is_jam;
+ register char *ff_cp = ff_c_buf_p;
+
+ register FF_CHAR ff_c = 1;
+ if ( ff_accept[ff_current_state] )
+ {
+ ff_last_accepting_state = ff_current_state;
+ ff_last_accepting_cpos = ff_cp;
+ }
+ while ( ff_chk[ff_base[ff_current_state] + ff_c] != ff_current_state )
+ {
+ ff_current_state = (int) ff_def[ff_current_state];
+ if ( ff_current_state >= 160 )
+ ff_c = ff_meta[(unsigned int) ff_c];
+ }
+ ff_current_state = ff_nxt[ff_base[ff_current_state] + (unsigned int) ff_c];
+ ff_is_jam = (ff_current_state == 159);
+
+ return ff_is_jam ? 0 : ff_current_state;
+ }
+
+
+#ifndef FF_NO_UNPUT
+#ifdef FF_USE_PROTOS
+static void ffunput( int c, register char *ff_bp )
+#else
+static void ffunput( c, ff_bp )
+int c;
+register char *ff_bp;
+#endif
+ {
+ register char *ff_cp = ff_c_buf_p;
+
+ /* undo effects of setting up fftext */
+ *ff_cp = ff_hold_char;
+
+ if ( ff_cp < ff_current_buffer->ff_ch_buf + 2 )
+ { /* need to shift things up to make room */
+ /* +2 for EOB chars. */
+ register int number_to_move = ff_n_chars + 2;
+ register char *dest = &ff_current_buffer->ff_ch_buf[
+ ff_current_buffer->ff_buf_size + 2];
+ register char *source =
+ &ff_current_buffer->ff_ch_buf[number_to_move];
+
+ while ( source > ff_current_buffer->ff_ch_buf )
+ *--dest = *--source;
+
+ ff_cp += (int) (dest - source);
+ ff_bp += (int) (dest - source);
+ ff_current_buffer->ff_n_chars =
+ ff_n_chars = ff_current_buffer->ff_buf_size;
+
+ if ( ff_cp < ff_current_buffer->ff_ch_buf + 2 )
+ FF_FATAL_ERROR( "flex scanner push-back overflow" );
+ }
+
+ *--ff_cp = (char) c;
+
+
+ fftext_ptr = ff_bp;
+ ff_hold_char = *ff_cp;
+ ff_c_buf_p = ff_cp;
+ }
+#endif /* ifndef FF_NO_UNPUT */
+
+
+#ifdef __cplusplus
+static int ffinput()
+#else
+static int input()
+#endif
+ {
+ int c;
+
+ *ff_c_buf_p = ff_hold_char;
+
+ if ( *ff_c_buf_p == FF_END_OF_BUFFER_CHAR )
+ {
+ /* ff_c_buf_p now points to the character we want to return.
+ * If this occurs *before* the EOB characters, then it's a
+ * valid NUL; if not, then we've hit the end of the buffer.
+ */
+ if ( ff_c_buf_p < &ff_current_buffer->ff_ch_buf[ff_n_chars] )
+ /* This was really a NUL. */
+ *ff_c_buf_p = '\0';
+
+ else
+ { /* need more input */
+ int offset = ff_c_buf_p - fftext_ptr;
+ ++ff_c_buf_p;
+
+ switch ( ff_get_next_buffer() )
+ {
+ case EOB_ACT_LAST_MATCH:
+ /* This happens because ff_g_n_b()
+ * sees that we've accumulated a
+ * token and flags that we need to
+ * try matching the token before
+ * proceeding. But for input(),
+ * there's no matching to consider.
+ * So convert the EOB_ACT_LAST_MATCH
+ * to EOB_ACT_END_OF_FILE.
+ */
+
+ /* Reset buffer status. */
+ ffrestart( ffin );
+
+ /* fall through */
+
+ case EOB_ACT_END_OF_FILE:
+ {
+ if ( ffwrap() )
+ return EOF;
+
+ if ( ! ff_did_buffer_switch_on_eof )
+ FF_NEW_FILE;
+#ifdef __cplusplus
+ return ffinput();
+#else
+ return input();
+#endif
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ ff_c_buf_p = fftext_ptr + offset;
+ break;
+ }
+ }
+ }
+
+ c = *(unsigned char *) ff_c_buf_p; /* cast for 8-bit char's */
+ *ff_c_buf_p = '\0'; /* preserve fftext */
+ ff_hold_char = *++ff_c_buf_p;
+
+
+ return c;
+ }
+
+
+#ifdef FF_USE_PROTOS
+void ffrestart( FILE *input_file )
+#else
+void ffrestart( input_file )
+FILE *input_file;
+#endif
+ {
+ if ( ! ff_current_buffer )
+ ff_current_buffer = ff_create_buffer( ffin, FF_BUF_SIZE );
+
+ ff_init_buffer( ff_current_buffer, input_file );
+ ff_load_buffer_state();
+ }
+
+
+#ifdef FF_USE_PROTOS
+void ff_switch_to_buffer( FF_BUFFER_STATE new_buffer )
+#else
+void ff_switch_to_buffer( new_buffer )
+FF_BUFFER_STATE new_buffer;
+#endif
+ {
+ if ( ff_current_buffer == new_buffer )
+ return;
+
+ if ( ff_current_buffer )
+ {
+ /* Flush out information for old buffer. */
+ *ff_c_buf_p = ff_hold_char;
+ ff_current_buffer->ff_buf_pos = ff_c_buf_p;
+ ff_current_buffer->ff_n_chars = ff_n_chars;
+ }
+
+ ff_current_buffer = new_buffer;
+ ff_load_buffer_state();
+
+ /* We don't actually know whether we did this switch during
+ * EOF (ffwrap()) processing, but the only time this flag
+ * is looked at is after ffwrap() is called, so it's safe
+ * to go ahead and always set it.
+ */
+ ff_did_buffer_switch_on_eof = 1;
+ }
+
+
+#ifdef FF_USE_PROTOS
+void ff_load_buffer_state( void )
+#else
+void ff_load_buffer_state()
+#endif
+ {
+ ff_n_chars = ff_current_buffer->ff_n_chars;
+ fftext_ptr = ff_c_buf_p = ff_current_buffer->ff_buf_pos;
+ ffin = ff_current_buffer->ff_input_file;
+ ff_hold_char = *ff_c_buf_p;
+ }
+
+
+#ifdef FF_USE_PROTOS
+FF_BUFFER_STATE ff_create_buffer( FILE *file, int size )
+#else
+FF_BUFFER_STATE ff_create_buffer( file, size )
+FILE *file;
+int size;
+#endif
+ {
+ FF_BUFFER_STATE b;
+
+ b = (FF_BUFFER_STATE) ff_flex_alloc( sizeof( struct ff_buffer_state ) );
+ if ( ! b )
+ FF_FATAL_ERROR( "out of dynamic memory in ff_create_buffer()" );
+
+ b->ff_buf_size = size;
+
+ /* ff_ch_buf has to be 2 characters longer than the size given because
+ * we need to put in 2 end-of-buffer characters.
+ */
+ b->ff_ch_buf = (char *) ff_flex_alloc( b->ff_buf_size + 2 );
+ if ( ! b->ff_ch_buf )
+ FF_FATAL_ERROR( "out of dynamic memory in ff_create_buffer()" );
+
+ b->ff_is_our_buffer = 1;
+
+ ff_init_buffer( b, file );
+
+ return b;
+ }
+
+
+#ifdef FF_USE_PROTOS
+void ff_delete_buffer( FF_BUFFER_STATE b )
+#else
+void ff_delete_buffer( b )
+FF_BUFFER_STATE b;
+#endif
+ {
+ if ( ! b )
+ return;
+
+ if ( b == ff_current_buffer )
+ ff_current_buffer = (FF_BUFFER_STATE) 0;
+
+ if ( b->ff_is_our_buffer )
+ ff_flex_free( (void *) b->ff_ch_buf );
+
+ ff_flex_free( (void *) b );
+ }
+
+
+#ifndef FF_ALWAYS_INTERACTIVE
+#ifndef FF_NEVER_INTERACTIVE
+extern int isatty FF_PROTO(( int ));
+#endif
+#endif
+
+#ifdef FF_USE_PROTOS
+void ff_init_buffer( FF_BUFFER_STATE b, FILE *file )
+#else
+void ff_init_buffer( b, file )
+FF_BUFFER_STATE b;
+FILE *file;
+#endif
+
+
+ {
+ ff_flush_buffer( b );
+
+ b->ff_input_file = file;
+ b->ff_fill_buffer = 1;
+
+#if FF_ALWAYS_INTERACTIVE
+ b->ff_is_interactive = 1;
+#else
+#if FF_NEVER_INTERACTIVE
+ b->ff_is_interactive = 0;
+#else
+ b->ff_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+#endif
+#endif
+ }
+
+
+#ifdef FF_USE_PROTOS
+void ff_flush_buffer( FF_BUFFER_STATE b )
+#else
+void ff_flush_buffer( b )
+FF_BUFFER_STATE b;
+#endif
+
+ {
+ if ( ! b )
+ return;
+
+ b->ff_n_chars = 0;
+
+ /* We always need two end-of-buffer characters. The first causes
+ * a transition to the end-of-buffer state. The second causes
+ * a jam in that state.
+ */
+ b->ff_ch_buf[0] = FF_END_OF_BUFFER_CHAR;
+ b->ff_ch_buf[1] = FF_END_OF_BUFFER_CHAR;
+
+ b->ff_buf_pos = &b->ff_ch_buf[0];
+
+ b->ff_at_bol = 1;
+ b->ff_buffer_status = FF_BUFFER_NEW;
+
+ if ( b == ff_current_buffer )
+ ff_load_buffer_state();
+ }
+
+
+#ifndef FF_NO_SCAN_BUFFER
+#ifdef FF_USE_PROTOS
+FF_BUFFER_STATE ff_scan_buffer( char *base, ff_size_t size )
+#else
+FF_BUFFER_STATE ff_scan_buffer( base, size )
+char *base;
+ff_size_t size;
+#endif
+ {
+ FF_BUFFER_STATE b;
+
+ if ( size < 2 ||
+ base[size-2] != FF_END_OF_BUFFER_CHAR ||
+ base[size-1] != FF_END_OF_BUFFER_CHAR )
+ /* They forgot to leave room for the EOB's. */
+ return 0;
+
+ b = (FF_BUFFER_STATE) ff_flex_alloc( sizeof( struct ff_buffer_state ) );
+ if ( ! b )
+ FF_FATAL_ERROR( "out of dynamic memory in ff_scan_buffer()" );
+
+ b->ff_buf_size = size - 2; /* "- 2" to take care of EOB's */
+ b->ff_buf_pos = b->ff_ch_buf = base;
+ b->ff_is_our_buffer = 0;
+ b->ff_input_file = 0;
+ b->ff_n_chars = b->ff_buf_size;
+ b->ff_is_interactive = 0;
+ b->ff_at_bol = 1;
+ b->ff_fill_buffer = 0;
+ b->ff_buffer_status = FF_BUFFER_NEW;
+
+ ff_switch_to_buffer( b );
+
+ return b;
+ }
+#endif
+
+
+#ifndef FF_NO_SCAN_STRING
+#ifdef FF_USE_PROTOS
+FF_BUFFER_STATE ff_scan_string( ffconst char *ff_str )
+#else
+FF_BUFFER_STATE ff_scan_string( ff_str )
+ffconst char *ff_str;
+#endif
+ {
+ int len;
+ for ( len = 0; ff_str[len]; ++len )
+ ;
+
+ return ff_scan_bytes( ff_str, len );
+ }
+#endif
+
+
+#ifndef FF_NO_SCAN_BYTES
+#ifdef FF_USE_PROTOS
+FF_BUFFER_STATE ff_scan_bytes( ffconst char *bytes, int len )
+#else
+FF_BUFFER_STATE ff_scan_bytes( bytes, len )
+ffconst char *bytes;
+int len;
+#endif
+ {
+ FF_BUFFER_STATE b;
+ char *buf;
+ ff_size_t n;
+ int i;
+
+ /* Get memory for full buffer, including space for trailing EOB's. */
+ n = len + 2;
+ buf = (char *) ff_flex_alloc( n );
+ if ( ! buf )
+ FF_FATAL_ERROR( "out of dynamic memory in ff_scan_bytes()" );
+
+ for ( i = 0; i < len; ++i )
+ buf[i] = bytes[i];
+
+ buf[len] = buf[len+1] = FF_END_OF_BUFFER_CHAR;
+
+ b = ff_scan_buffer( buf, n );
+ if ( ! b )
+ FF_FATAL_ERROR( "bad buffer in ff_scan_bytes()" );
+
+ /* It's okay to grow etc. this buffer, and we should throw it
+ * away when we're done.
+ */
+ b->ff_is_our_buffer = 1;
+
+ return b;
+ }
+#endif
+
+
+#ifndef FF_NO_PUSH_STATE
+#ifdef FF_USE_PROTOS
+static void ff_push_state( int new_state )
+#else
+static void ff_push_state( new_state )
+int new_state;
+#endif
+ {
+ if ( ff_start_stack_ptr >= ff_start_stack_depth )
+ {
+ ff_size_t new_size;
+
+ ff_start_stack_depth += FF_START_STACK_INCR;
+ new_size = ff_start_stack_depth * sizeof( int );
+
+ if ( ! ff_start_stack )
+ ff_start_stack = (int *) ff_flex_alloc( new_size );
+
+ else
+ ff_start_stack = (int *) ff_flex_realloc(
+ (void *) ff_start_stack, new_size );
+
+ if ( ! ff_start_stack )
+ FF_FATAL_ERROR(
+ "out of memory expanding start-condition stack" );
+ }
+
+ ff_start_stack[ff_start_stack_ptr++] = FF_START;
+
+ BEGIN(new_state);
+ }
+#endif
+
+
+#ifndef FF_NO_POP_STATE
+static void ff_pop_state()
+ {
+ if ( --ff_start_stack_ptr < 0 )
+ FF_FATAL_ERROR( "start-condition stack underflow" );
+
+ BEGIN(ff_start_stack[ff_start_stack_ptr]);
+ }
+#endif
+
+
+#ifndef FF_NO_TOP_STATE
+static int ff_top_state()
+ {
+ return ff_start_stack[ff_start_stack_ptr - 1];
+ }
+#endif
+
+#ifndef FF_EXIT_FAILURE
+#define FF_EXIT_FAILURE 2
+#endif
+
+#ifdef FF_USE_PROTOS
+static void ff_fatal_error( ffconst char msg[] )
+#else
+static void ff_fatal_error( msg )
+char msg[];
+#endif
+ {
+ (void) fprintf( stderr, "%s\n", msg );
+ exit( FF_EXIT_FAILURE );
+ }
+
+
+
+/* Redefine ffless() so it works in section 3 code. */
+
+#undef ffless
+#define ffless(n) \
+ do \
+ { \
+ /* Undo effects of setting up fftext. */ \
+ fftext[ffleng] = ff_hold_char; \
+ ff_c_buf_p = fftext + n; \
+ ff_hold_char = *ff_c_buf_p; \
+ *ff_c_buf_p = '\0'; \
+ ffleng = n; \
+ } \
+ while ( 0 )
+
+
+/* Internal utility routines. */
+
+#ifndef fftext_ptr
+#ifdef FF_USE_PROTOS
+static void ff_flex_strncpy( char *s1, ffconst char *s2, int n )
+#else
+static void ff_flex_strncpy( s1, s2, n )
+char *s1;
+ffconst char *s2;
+int n;
+#endif
+ {
+ register int i;
+ for ( i = 0; i < n; ++i )
+ s1[i] = s2[i];
+ }
+#endif
+
+#ifdef FF_NEED_STRLEN
+#ifdef FF_USE_PROTOS
+static int ff_flex_strlen( ffconst char *s )
+#else
+static int ff_flex_strlen( s )
+ffconst char *s;
+#endif
+ {
+ register int n;
+ for ( n = 0; s[n]; ++n )
+ ;
+
+ return n;
+ }
+#endif
+
+
+#ifdef FF_USE_PROTOS
+static void *ff_flex_alloc( ff_size_t size )
+#else
+static void *ff_flex_alloc( size )
+ff_size_t size;
+#endif
+ {
+ return (void *) malloc( size );
+ }
+
+#ifdef FF_USE_PROTOS
+static void *ff_flex_realloc( void *ptr, ff_size_t size )
+#else
+static void *ff_flex_realloc( ptr, size )
+void *ptr;
+ff_size_t size;
+#endif
+ {
+ /* The cast to (char *) in the following accommodates both
+ * implementations that use char* generic pointers, and those
+ * that use void* generic pointers. It works with the latter
+ * because both ANSI C and C++ allow castless assignment from
+ * any pointer type to void*, and deal with argument conversions
+ * as though doing an assignment.
+ */
+ return (void *) realloc( (char *) ptr, size );
+ }
+
+#ifdef FF_USE_PROTOS
+static void ff_flex_free( void *ptr )
+#else
+static void ff_flex_free( ptr )
+void *ptr;
+#endif
+ {
+ free( ptr );
+ }
+
+#if FF_MAIN
+int main()
+ {
+ fflex();
+ return 0;
+ }
+#endif
+#line 419 "eval.l"
+
+
+int ffwrap()
+{
+ /* MJT -- 13 June 1996
+ Supplied for compatibility with
+ pre-2.5.1 versions of flex which
+ do not recognize %option noffwrap
+ */
+ 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 ffGetVariable( char *varName, FFSTYPE *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
diff --git a/src/plugins/cfitsio/eval_tab.h b/src/plugins/cfitsio/eval_tab.h
new file mode 100644
index 0000000..aed4459
--- /dev/null
+++ b/src/plugins/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;
diff --git a/src/plugins/cfitsio/eval_y.c b/src/plugins/cfitsio/eval_y.c
new file mode 100644
index 0000000..e18cf11
--- /dev/null
+++ b/src/plugins/cfitsio/eval_y.c
@@ -0,0 +1,7333 @@
+
+/* A Bison parser, made from eval.y
+ by GNU Bison version 1.25
+ */
+
+#define FFBISON 1 /* Identify Bison output. */
+
+#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
+
+#line 1 "eval.y"
+
+/************************************************************************/
+/* */
+/* 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 */
+/* Craig B Markwardt Jun 2004 Add MEDIAN() function */
+/* Craig B Markwardt Jun 2004 Add SUM(), and MIN/MAX() for bit arrays */
+/* Craig B Markwardt Jun 2004 Allow subscripting of nX bit arrays */
+/* Craig B Markwardt Jun 2004 Implement statistical functions */
+/* NVALID(), AVERAGE(), and STDDEV() */
+/* for integer and floating point vectors */
+/* Craig B Markwardt Jun 2004 Use NULL values for range errors instead*/
+/* of throwing a parse error */
+/* Craig B Markwardt Oct 2004 Add ACCUM() and SEQDIFF() functions */
+/* Craig B Markwardt Feb 2005 Add ANGSEP() function */
+/* Craig B Markwardt Aug 2005 CIRCLE, BOX, ELLIPSE, NEAR and REGFILTER*/
+/* functions now accept vector arguments */
+/* Craig B Markwardt Sum 2006 Add RANDOMN() and RANDOMP() functions */
+/* Craig B Markwardt Mar 2007 Allow arguments to RANDOM and RANDOMN to*/
+/* determine the output dimensions */
+/* Craig B Markwardt Aug 2009 Add substring STRMID() and string search*/
+/* STRSTR() functions; more overflow checks*/
+/* */
+/************************************************************************/
+
+#define APPROX 1.0e-7
+#include "eval_defs.h"
+#include "region.h"
+#include <time.h>
+
+#include <stdlib.h>
+
+#ifndef alloca
+#define alloca malloc
+#endif
+
+ /* Shrink the initial stack depth to keep local data <32K (mac limit) */
+ /* yacc will allocate more space if needed, though. */
+#define FFINITDEPTH 100
+
+/***************************************************************/
+/* Replace Bison's BACKUP macro with one that fixes a bug -- */
+/* must update state after popping the stack -- and allows */
+/* popping multiple terms at one time. */
+/***************************************************************/
+
+#define FFNEWBACKUP(token, value) \
+ do \
+ if (ffchar == FFEMPTY ) \
+ { ffchar = (token); \
+ memcpy( &fflval, &(value), sizeof(value) ); \
+ ffchar1 = FFTRANSLATE (ffchar); \
+ while (fflen--) FFPOPSTACK; \
+ ffstate = *ffssp; \
+ goto ffbackup; \
+ } \
+ else \
+ { fferror ("syntax error: cannot back up"); FFERROR; } \
+ while (0)
+
+/***************************************************************/
+/* Useful macros for accessing/testing Nodes */
+/***************************************************************/
+
+#define TEST(a) if( (a)<0 ) FFERROR
+#define SIZE(a) gParse.Nodes[ a ].value.nelem
+#define TYPE(a) gParse.Nodes[ a ].type
+#define OPER(a) gParse.Nodes[ a ].operation
+#define PROMOTE(a,b) if( TYPE(a) > TYPE(b) ) \
+ b = New_Unary( TYPE(a), 0, b ); \
+ else if( TYPE(a) < TYPE(b) ) \
+ a = New_Unary( TYPE(b), 0, a );
+
+/***** Internal functions *****/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+static int Alloc_Node ( void );
+static void Free_Last_Node( void );
+static void Evaluate_Node ( int thisNode );
+
+static int New_Const ( int returnType, void *value, long len );
+static int New_Column( int ColNum );
+static int New_Offset( int ColNum, int offset );
+static int New_Unary ( int returnType, int Op, int Node1 );
+static int New_BinOp ( int returnType, int Node1, int Op, int Node2 );
+static int New_Func ( int returnType, funcOp Op, int nNodes,
+ int Node1, int Node2, int Node3, int Node4,
+ int Node5, int Node6, int Node7 );
+static int New_FuncSize( int returnType, funcOp Op, int nNodes,
+ int Node1, int Node2, int Node3, int Node4,
+ int Node5, int Node6, int Node7, int Size);
+static int New_Deref ( int Var, int nDim,
+ int Dim1, int Dim2, int Dim3, int Dim4, int Dim5 );
+static int New_GTI ( char *fname, int Node1, char *start, char *stop );
+static int New_REG ( char *fname, int NodeX, int NodeY, char *colNames );
+static int New_Vector( int subNode );
+static int Close_Vec ( int vecNode );
+static int Locate_Col( Node *this );
+static int Test_Dims ( int Node1, int Node2 );
+static void Copy_Dims ( int Node1, int Node2 );
+
+static void Allocate_Ptrs( Node *this );
+static void Do_Unary ( Node *this );
+static void Do_Offset ( Node *this );
+static void Do_BinOp_bit ( Node *this );
+static void Do_BinOp_str ( Node *this );
+static void Do_BinOp_log ( Node *this );
+static void Do_BinOp_lng ( Node *this );
+static void Do_BinOp_dbl ( Node *this );
+static void Do_Func ( Node *this );
+static void Do_Deref ( Node *this );
+static void Do_GTI ( Node *this );
+static void Do_REG ( Node *this );
+static void Do_Vector ( Node *this );
+
+static long Search_GTI ( double evtTime, long nGTI, double *start,
+ double *stop, int ordered );
+
+static char saobox (double xcen, double ycen, double xwid, double ywid,
+ double rot, double xcol, double ycol);
+static char ellipse(double xcen, double ycen, double xrad, double yrad,
+ double rot, double xcol, double ycol);
+static char circle (double xcen, double ycen, double rad,
+ double xcol, double ycol);
+static char bnear (double x, double y, double tolerance);
+static char bitcmp (char *bitstrm1, char *bitstrm2);
+static char bitlgte(char *bits1, int oper, char *bits2);
+
+static void bitand(char *result, char *bitstrm1, char *bitstrm2);
+static void bitor (char *result, char *bitstrm1, char *bitstrm2);
+static void bitnot(char *result, char *bits);
+static int cstrmid(char *dest_str, int dest_len,
+ char *src_str, int src_len, int pos);
+
+static void fferror(char *msg);
+
+#ifdef __cplusplus
+ }
+#endif
+
+
+#line 189 "eval.y"
+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;
+#include <stdio.h>
+
+#ifndef __cplusplus
+#ifndef __STDC__
+#define const
+#endif
+#endif
+
+
+
+#define FFFINAL 290
+#define FFFLAG -32768
+#define FFNTBASE 54
+
+#define FFTRANSLATE(x) ((unsigned)(x) <= 289 ? fftranslate[x] : 62)
+
+static const char fftranslate[] = { 0,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 50,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 37, 41, 2, 52,
+ 53, 38, 35, 20, 36, 2, 39, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 22, 2, 2,
+ 21, 2, 25, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 47, 2, 51, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 23, 40, 24, 30, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 1, 2, 3, 4, 5,
+ 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 26, 27, 28, 29, 31, 32,
+ 33, 34, 42, 43, 44, 45, 46, 48, 49
+};
+
+#if FFDEBUG != 0
+static const short ffprhs[] = { 0,
+ 0, 1, 4, 6, 9, 12, 15, 18, 21, 24,
+ 28, 31, 35, 39, 43, 46, 49, 51, 53, 58,
+ 62, 66, 70, 75, 82, 91, 102, 115, 118, 122,
+ 124, 126, 128, 133, 135, 137, 141, 145, 149, 153,
+ 157, 161, 164, 167, 171, 175, 179, 185, 191, 197,
+ 200, 204, 208, 212, 216, 222, 228, 238, 243, 250,
+ 259, 270, 283, 286, 289, 292, 295, 297, 299, 304,
+ 308, 312, 316, 320, 324, 328, 332, 336, 340, 344,
+ 348, 352, 356, 360, 364, 368, 372, 376, 380, 384,
+ 388, 392, 396, 402, 408, 412, 416, 420, 426, 434,
+ 446, 462, 465, 469, 475, 485, 489, 497, 507, 512,
+ 519, 528, 539, 552, 555, 559, 561, 563, 568, 570,
+ 574, 578, 584, 590
+};
+
+static const short ffrhs[] = { -1,
+ 54, 55, 0, 50, 0, 58, 50, 0, 59, 50,
+ 0, 61, 50, 0, 60, 50, 0, 1, 50, 0,
+ 23, 59, 0, 56, 20, 59, 0, 23, 58, 0,
+ 57, 20, 58, 0, 57, 20, 59, 0, 56, 20,
+ 58, 0, 57, 24, 0, 56, 24, 0, 7, 0,
+ 16, 0, 16, 23, 58, 24, 0, 60, 41, 60,
+ 0, 60, 40, 60, 0, 60, 35, 60, 0, 60,
+ 47, 58, 51, 0, 60, 47, 58, 20, 58, 51,
+ 0, 60, 47, 58, 20, 58, 20, 58, 51, 0,
+ 60, 47, 58, 20, 58, 20, 58, 20, 58, 51,
+ 0, 60, 47, 58, 20, 58, 20, 58, 20, 58,
+ 20, 58, 51, 0, 43, 60, 0, 52, 60, 53,
+ 0, 4, 0, 5, 0, 13, 0, 13, 23, 58,
+ 24, 0, 17, 0, 18, 0, 58, 37, 58, 0,
+ 58, 35, 58, 0, 58, 36, 58, 0, 58, 38,
+ 58, 0, 58, 39, 58, 0, 58, 42, 58, 0,
+ 35, 58, 0, 36, 58, 0, 52, 58, 53, 0,
+ 58, 38, 59, 0, 59, 38, 58, 0, 59, 25,
+ 58, 22, 58, 0, 59, 25, 59, 22, 58, 0,
+ 59, 25, 58, 22, 59, 0, 8, 53, 0, 8,
+ 59, 53, 0, 8, 61, 53, 0, 8, 60, 53,
+ 0, 8, 58, 53, 0, 10, 61, 20, 61, 53,
+ 0, 8, 58, 20, 58, 53, 0, 8, 58, 20,
+ 58, 20, 58, 20, 58, 53, 0, 58, 47, 58,
+ 51, 0, 58, 47, 58, 20, 58, 51, 0, 58,
+ 47, 58, 20, 58, 20, 58, 51, 0, 58, 47,
+ 58, 20, 58, 20, 58, 20, 58, 51, 0, 58,
+ 47, 58, 20, 58, 20, 58, 20, 58, 20, 58,
+ 51, 0, 44, 58, 0, 44, 59, 0, 45, 58,
+ 0, 45, 59, 0, 3, 0, 14, 0, 14, 23,
+ 58, 24, 0, 60, 28, 60, 0, 60, 29, 60,
+ 0, 60, 32, 60, 0, 60, 33, 60, 0, 60,
+ 31, 60, 0, 60, 34, 60, 0, 58, 31, 58,
+ 0, 58, 32, 58, 0, 58, 34, 58, 0, 58,
+ 33, 58, 0, 58, 30, 58, 0, 58, 28, 58,
+ 0, 58, 29, 58, 0, 61, 28, 61, 0, 61,
+ 29, 61, 0, 61, 31, 61, 0, 61, 34, 61,
+ 0, 61, 32, 61, 0, 61, 33, 61, 0, 59,
+ 27, 59, 0, 59, 26, 59, 0, 59, 28, 59,
+ 0, 59, 29, 59, 0, 58, 21, 58, 22, 58,
+ 0, 59, 25, 59, 22, 59, 0, 9, 58, 53,
+ 0, 9, 59, 53, 0, 9, 61, 53, 0, 8,
+ 59, 20, 59, 53, 0, 9, 58, 20, 58, 20,
+ 58, 53, 0, 9, 58, 20, 58, 20, 58, 20,
+ 58, 20, 58, 53, 0, 9, 58, 20, 58, 20,
+ 58, 20, 58, 20, 58, 20, 58, 20, 58, 53,
+ 0, 11, 53, 0, 11, 6, 53, 0, 11, 6,
+ 20, 58, 53, 0, 11, 6, 20, 58, 20, 6,
+ 20, 6, 53, 0, 12, 6, 53, 0, 12, 6,
+ 20, 58, 20, 58, 53, 0, 12, 6, 20, 58,
+ 20, 58, 20, 6, 53, 0, 59, 47, 58, 51,
+ 0, 59, 47, 58, 20, 58, 51, 0, 59, 47,
+ 58, 20, 58, 20, 58, 51, 0, 59, 47, 58,
+ 20, 58, 20, 58, 20, 58, 51, 0, 59, 47,
+ 58, 20, 58, 20, 58, 20, 58, 20, 58, 51,
+ 0, 43, 59, 0, 52, 59, 53, 0, 6, 0,
+ 15, 0, 15, 23, 58, 24, 0, 19, 0, 52,
+ 61, 53, 0, 61, 35, 61, 0, 59, 25, 61,
+ 22, 61, 0, 8, 61, 20, 61, 53, 0, 8,
+ 61, 20, 58, 20, 58, 53, 0
+};
+
+#endif
+
+#if FFDEBUG != 0
+static const short ffrline[] = { 0,
+ 241, 242, 245, 246, 252, 258, 264, 270, 273, 275,
+ 288, 290, 303, 314, 328, 332, 336, 340, 342, 351,
+ 354, 357, 366, 368, 370, 372, 374, 376, 379, 383,
+ 385, 387, 389, 398, 400, 402, 405, 408, 411, 414,
+ 417, 420, 422, 424, 426, 430, 434, 453, 472, 491,
+ 504, 518, 530, 561, 659, 667, 729, 753, 755, 757,
+ 759, 761, 763, 765, 767, 769, 773, 775, 777, 786,
+ 789, 792, 795, 798, 801, 804, 807, 810, 813, 816,
+ 819, 822, 825, 828, 831, 834, 837, 840, 843, 845,
+ 847, 849, 852, 859, 876, 889, 902, 913, 929, 953,
+ 981, 1018, 1022, 1026, 1029, 1033, 1037, 1040, 1044, 1046,
+ 1048, 1050, 1052, 1054, 1056, 1060, 1063, 1065, 1074, 1076,
+ 1078, 1087, 1106, 1125
+};
+#endif
+
+
+#if FFDEBUG != 0 || defined (FFERROR_VERBOSE)
+
+static const char * const fftname[] = { "$","error","$undefined.","BOOLEAN",
+"LONG","DOUBLE","STRING","BITSTR","FUNCTION","BFUNCTION","IFUNCTION","GTIFILTER",
+"REGFILTER","COLUMN","BCOLUMN","SCOLUMN","BITCOL","ROWREF","NULLREF","SNULLREF",
+"','","'='","':'","'{'","'}'","'?'","OR","AND","EQ","NE","'~'","GT","LT","LTE",
+"GTE","'+'","'-'","'%'","'*'","'/'","'|'","'&'","POWER","NOT","INTCAST","FLTCAST",
+"UMINUS","'['","ACCUM","DIFF","'\\n'","']'","'('","')'","lines","line","bvector",
+"vector","expr","bexpr","bits","sexpr", NULL
+};
+#endif
+
+static const short ffr1[] = { 0,
+ 54, 54, 55, 55, 55, 55, 55, 55, 56, 56,
+ 57, 57, 57, 57, 58, 59, 60, 60, 60, 60,
+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 58,
+ 58, 58, 58, 58, 58, 58, 58, 58, 58, 58,
+ 58, 58, 58, 58, 58, 58, 58, 58, 58, 58,
+ 58, 58, 58, 58, 58, 58, 58, 58, 58, 58,
+ 58, 58, 58, 58, 58, 58, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 59, 59, 59, 61, 61, 61, 61, 61,
+ 61, 61, 61, 61
+};
+
+static const short ffr2[] = { 0,
+ 0, 2, 1, 2, 2, 2, 2, 2, 2, 3,
+ 2, 3, 3, 3, 2, 2, 1, 1, 4, 3,
+ 3, 3, 4, 6, 8, 10, 12, 2, 3, 1,
+ 1, 1, 4, 1, 1, 3, 3, 3, 3, 3,
+ 3, 2, 2, 3, 3, 3, 5, 5, 5, 2,
+ 3, 3, 3, 3, 5, 5, 9, 4, 6, 8,
+ 10, 12, 2, 2, 2, 2, 1, 1, 4, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 5, 5, 3, 3, 3, 5, 7, 11,
+ 15, 2, 3, 5, 9, 3, 7, 9, 4, 6,
+ 8, 10, 12, 2, 3, 1, 1, 4, 1, 3,
+ 3, 5, 5, 7
+};
+
+static const short ffdefact[] = { 1,
+ 0, 0, 67, 30, 31, 116, 17, 0, 0, 0,
+ 0, 0, 32, 68, 117, 18, 34, 35, 119, 0,
+ 0, 0, 0, 0, 0, 3, 0, 2, 0, 0,
+ 0, 0, 0, 0, 8, 50, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 102, 0,
+ 0, 0, 0, 0, 11, 9, 0, 42, 43, 114,
+ 28, 63, 64, 65, 66, 0, 0, 0, 0, 0,
+ 16, 0, 15, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 4, 0,
+ 0, 0, 0, 0, 0, 0, 5, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 7, 0, 0,
+ 0, 0, 0, 0, 0, 6, 0, 54, 0, 51,
+ 53, 0, 52, 0, 95, 96, 97, 0, 0, 103,
+ 0, 106, 0, 0, 0, 0, 44, 115, 29, 120,
+ 14, 10, 12, 13, 0, 81, 82, 80, 76, 77,
+ 79, 78, 37, 38, 36, 39, 45, 40, 41, 0,
+ 0, 0, 0, 90, 89, 91, 92, 46, 0, 0,
+ 0, 70, 71, 74, 72, 73, 75, 22, 21, 20,
+ 0, 83, 84, 85, 87, 88, 86, 121, 0, 0,
+ 0, 0, 0, 0, 0, 0, 33, 69, 118, 19,
+ 0, 0, 58, 0, 0, 0, 0, 109, 28, 0,
+ 0, 23, 0, 56, 98, 0, 123, 0, 55, 0,
+ 104, 0, 93, 0, 47, 49, 48, 94, 122, 0,
+ 0, 0, 0, 0, 0, 0, 0, 59, 0, 110,
+ 0, 24, 0, 124, 0, 99, 0, 0, 107, 0,
+ 0, 0, 0, 0, 0, 0, 0, 60, 0, 111,
+ 0, 25, 57, 0, 105, 108, 0, 0, 0, 0,
+ 0, 61, 0, 112, 0, 26, 0, 100, 0, 0,
+ 0, 0, 62, 113, 27, 0, 0, 101, 0, 0
+};
+
+static const short ffdefgoto[] = { 1,
+ 28, 29, 30, 45, 46, 43, 57
+};
+
+static const short ffpact[] = {-32768,
+ 301, -41,-32768,-32768,-32768,-32768,-32768, 351, 402, 402,
+ -5, 12, 8, 33, 34, 41,-32768,-32768,-32768, 402,
+ 402, 402, 402, 402, 402,-32768, 402,-32768, -18, 9,
+ 1092, 403, 1438, 79,-32768,-32768, 428, 143, 294, 10,
+ 456, 224, 1478, 125, 1390, 1436, 1523, -6,-32768, 2,
+ 402, 402, 402, 402, 1390, 1436, 1129, 19, 19, 20,
+ 21, 19, 20, 19, 20, 623, 240, 344, 1120, 402,
+-32768, 402,-32768, 402, 402, 402, 402, 402, 402, 402,
+ 402, 402, 402, 402, 402, 402, 402, 402,-32768, 402,
+ 402, 402, 402, 402, 402, 402,-32768, -3, -3, -3,
+ -3, -3, -3, -3, -3, -3, 402,-32768, 402, 402,
+ 402, 402, 402, 402, 402,-32768, 402,-32768, 402,-32768,
+-32768, 402,-32768, 402,-32768,-32768,-32768, 402, 402,-32768,
+ 402,-32768, 1266, 1286, 1306, 1326,-32768,-32768,-32768,-32768,
+ 1390, 1436, 1390, 1436, 1348, 1503, 1503, 1503, 23, 23,
+ 23, 23, 160, 160, 160, -15, 20, -15, -15, 732,
+ 1370, 1413, 1531, 146, -13, -35, -35, -15, 756, -3,
+ -3, -30, -30, -30, -30, -30, -30, 50, 21, 21,
+ 780, 67, 67, 11, 11, 11, 11,-32768, 484, 1118,
+ 1146, 1415, 1166, 1424, 512, 1186,-32768,-32768,-32768,-32768,
+ 402, 402,-32768, 402, 402, 402, 402,-32768, 21, 1480,
+ 402,-32768, 402,-32768,-32768, 402,-32768, 402,-32768, 66,
+-32768, 402, 1461, 804, 1461, 1436, 1461, 1436, 1129, 828,
+ 852, 1206, 650, 540, 68, 568, 402,-32768, 402,-32768,
+ 402,-32768, 402,-32768, 402,-32768, 86, 87,-32768, 876,
+ 900, 924, 677, 1226, 52, 56, 402,-32768, 402,-32768,
+ 402,-32768,-32768, 402,-32768,-32768, 948, 972, 996, 596,
+ 402,-32768, 402,-32768, 402,-32768, 402,-32768, 1020, 1044,
+ 1068, 1246,-32768,-32768,-32768, 402, 704,-32768, 126,-32768
+};
+
+static const short ffpgoto[] = {-32768,
+-32768,-32768,-32768, -1, 95, 124, 27
+};
+
+
+#define FFLAST 1566
+
+
+static const short fftable[] = { 31,
+ 48, 70, 95, 7, 104, 71, 37, 41, 35, 105,
+ 106, 96, 16, 129, 93, 94, 107, 50, 55, 58,
+ 59, 131, 62, 64, 95, 66, 87, 34, 72, 122,
+ 51, 88, 73, 96, 40, 44, 47, 109, 110, 170,
+ 111, 112, 113, 114, 115, 115, 130, 49, 171, 133,
+ 134, 135, 136, 69, 132, 52, 53, 82, 83, 84,
+ 85, 86, 123, 54, 87, 88, 96, 107, 141, 88,
+ 143, 235, 145, 146, 147, 148, 149, 150, 151, 152,
+ 153, 154, 155, 156, 158, 159, 160, 247, 161, 105,
+ 106, 255, 256, 168, 169, 32, 107, 111, 112, 113,
+ 114, 115, 38, 42, 265, 181, 109, 110, 266, 111,
+ 112, 113, 114, 115, 56, 189, 163, 60, 63, 65,
+ 191, 67, 193, 0, 33, 290, 0, 195, 116, 196,
+ 0, 39, 0, 0, 0, 182, 183, 184, 185, 186,
+ 187, 188, 0, 0, 0, 0, 61, 0, 192, 0,
+ 68, 0, 109, 110, 194, 111, 112, 113, 114, 115,
+ 0, 0, 119, 0, 142, 0, 144, 90, 91, 92,
+ 93, 94, 92, 93, 94, 0, 0, 127, 0, 157,
+ 95, 0, 0, 95, 162, 164, 165, 166, 167, 96,
+ 0, 0, 96, 0, 0, 120, 0, 85, 86, 223,
+ 224, 87, 225, 227, 0, 230, 88, 0, 0, 231,
+ 0, 232, 0, 190, 233, 0, 234, 0, 0, 0,
+ 236, 172, 173, 174, 175, 176, 177, 178, 179, 180,
+ 0, 0, 229, 0, 0, 250, 0, 251, 0, 252,
+ 0, 253, 0, 254, 0, 0, 0, 0, 90, 91,
+ 92, 93, 94, 0, 0, 267, 0, 268, 0, 269,
+ 0, 95, 270, 0, 90, 91, 92, 93, 94, 279,
+ 96, 280, 0, 281, 0, 282, 126, 95, 0, 0,
+ 0, 0, 0, 0, 287, 0, 96, 0, 0, 0,
+ 0, 0, 138, 209, 210, 0, 0, 0, 226, 228,
+ 289, 2, 0, 3, 4, 5, 6, 7, 8, 9,
+ 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
+ 0, 98, 99, 20, 100, 101, 102, 103, 104, 0,
+ 0, 0, 0, 105, 106, 21, 22, 0, 0, 0,
+ 107, 0, 0, 23, 24, 25, 121, 0, 0, 0,
+ 26, 0, 27, 3, 4, 5, 6, 7, 8, 9,
+ 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
+ 0, 98, 99, 20, 100, 101, 102, 103, 104, 0,
+ 0, 0, 0, 105, 106, 21, 22, 0, 0, 0,
+ 107, 0, 0, 23, 24, 25, 139, 0, 0, 0,
+ 0, 0, 27, 36, 3, 4, 5, 6, 7, 8,
+ 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,
+ 19, 0, 0, 0, 20, 0, 0, 90, 91, 92,
+ 93, 94, 0, 0, 0, 0, 21, 22, 0, 0,
+ 95, 0, 0, 0, 23, 24, 25, 117, 74, 96,
+ 0, 0, 97, 27, 0, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 0, 0, 87,
+ 0, 0, 0, 0, 88, 124, 74, 0, 0, 0,
+ 118, 0, 0, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 0, 87, 0, 0,
+ 0, 0, 88, 213, 74, 0, 0, 0, 125, 0,
+ 0, 75, 76, 77, 78, 79, 80, 81, 82, 83,
+ 84, 85, 86, 0, 0, 87, 0, 0, 0, 0,
+ 88, 220, 74, 0, 0, 0, 214, 0, 0, 75,
+ 76, 77, 78, 79, 80, 81, 82, 83, 84, 85,
+ 86, 0, 0, 87, 0, 0, 0, 0, 88, 245,
+ 74, 0, 0, 0, 221, 0, 0, 75, 76, 77,
+ 78, 79, 80, 81, 82, 83, 84, 85, 86, 0,
+ 0, 87, 0, 0, 0, 0, 88, 248, 74, 0,
+ 0, 0, 246, 0, 0, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 0, 0, 87,
+ 0, 0, 0, 0, 88, 277, 74, 0, 0, 0,
+ 249, 0, 0, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 0, 87, 0, 0,
+ 0, 0, 88, 74, 0, 0, 0, 0, 278, 0,
+ 75, 76, 77, 78, 79, 80, 81, 82, 83, 84,
+ 85, 86, 0, 0, 87, 0, 0, 0, 0, 88,
+ 74, 0, 0, 0, 0, 137, 0, 75, 76, 77,
+ 78, 79, 80, 81, 82, 83, 84, 85, 86, 0,
+ 0, 87, 0, 0, 0, 0, 88, 74, 0, 0,
+ 0, 0, 244, 0, 75, 76, 77, 78, 79, 80,
+ 81, 82, 83, 84, 85, 86, 0, 0, 87, 0,
+ 0, 0, 0, 88, 74, 0, 0, 0, 0, 263,
+ 0, 75, 76, 77, 78, 79, 80, 81, 82, 83,
+ 84, 85, 86, 0, 0, 87, 0, 0, 0, 0,
+ 88, 202, 74, 0, 0, 0, 288, 0, 0, 75,
+ 76, 77, 78, 79, 80, 81, 82, 83, 84, 85,
+ 86, 0, 0, 87, 0, 207, 74, 0, 88, 0,
+ 0, 0, 203, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 0, 87, 0, 211,
+ 74, 0, 88, 0, 0, 0, 208, 75, 76, 77,
+ 78, 79, 80, 81, 82, 83, 84, 85, 86, 0,
+ 0, 87, 0, 237, 74, 0, 88, 0, 0, 0,
+ 212, 75, 76, 77, 78, 79, 80, 81, 82, 83,
+ 84, 85, 86, 0, 0, 87, 0, 239, 74, 0,
+ 88, 0, 0, 0, 238, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 0, 0, 87,
+ 0, 241, 74, 0, 88, 0, 0, 0, 240, 75,
+ 76, 77, 78, 79, 80, 81, 82, 83, 84, 85,
+ 86, 0, 0, 87, 0, 257, 74, 0, 88, 0,
+ 0, 0, 242, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 0, 87, 0, 259,
+ 74, 0, 88, 0, 0, 0, 258, 75, 76, 77,
+ 78, 79, 80, 81, 82, 83, 84, 85, 86, 0,
+ 0, 87, 0, 261, 74, 0, 88, 0, 0, 0,
+ 260, 75, 76, 77, 78, 79, 80, 81, 82, 83,
+ 84, 85, 86, 0, 0, 87, 0, 271, 74, 0,
+ 88, 0, 0, 0, 262, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 0, 0, 87,
+ 0, 273, 74, 0, 88, 0, 0, 0, 272, 75,
+ 76, 77, 78, 79, 80, 81, 82, 83, 84, 85,
+ 86, 0, 0, 87, 0, 275, 74, 0, 88, 0,
+ 0, 0, 274, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 0, 87, 0, 0,
+ 74, 0, 88, 0, 0, 0, 276, 75, 76, 77,
+ 78, 79, 80, 81, 82, 83, 84, 85, 86, 0,
+ 0, 87, 0, 0, 74, 0, 88, 0, 0, 0,
+ 283, 75, 76, 77, 78, 79, 80, 81, 82, 83,
+ 84, 85, 86, 0, 0, 87, 0, 0, 74, 0,
+ 88, 0, 0, 0, 284, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 0, 0, 87,
+ 0, 0, 74, 0, 88, 0, 0, 0, 285, 75,
+ 76, 77, 78, 79, 80, 81, 82, 83, 84, 85,
+ 86, 0, 0, 87, 0, 0, 0, 0, 88, 0,
+ 0, 89, 90, 91, 92, 93, 94, 109, 110, 0,
+ 111, 112, 113, 114, 115, 95, 109, 110, 0, 111,
+ 112, 113, 114, 115, 96, 216, 74, 0, 0, 0,
+ 215, 0, 140, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 218, 74, 87, 0, 0,
+ 0, 0, 88, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 222, 74, 87, 0, 0,
+ 0, 0, 88, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 243, 74, 87, 0, 0,
+ 0, 0, 88, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 264, 74, 87, 0, 0,
+ 0, 0, 88, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 286, 74, 87, 0, 0,
+ 0, 0, 88, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 74, 87, 0, 197,
+ 0, 0, 88, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 74, 87, 0, 198,
+ 0, 0, 88, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 74, 87, 0, 199,
+ 0, 0, 88, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 74, 87, 0, 200,
+ 0, 0, 88, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 0, 0, 87, 74, 201,
+ 0, 0, 88, 0, 0, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 0, 0, 87,
+ 74, 204, 0, 0, 88, 0, 0, 75, 76, 77,
+ 78, 79, 80, 81, 82, 83, 84, 85, 86, 0,
+ 74, 87, 0, 0, 0, 0, 88, 75, 76, 77,
+ 78, 79, 80, 81, 82, 83, 84, 85, 86, 0,
+ 0, 87, 0, 0, 205, 0, 88, 90, 91, 92,
+ 93, 94, 109, 110, 0, 111, 112, 113, 114, 115,
+ 95, 109, 110, 0, 111, 112, 113, 114, 115, 96,
+ 90, 91, 92, 93, 94, 98, 99, 217, 100, 101,
+ 102, 103, 104, 95, 0, 0, 219, 105, 106, 0,
+ 0, 0, 96, 0, 107, 0, 0, 108, 75, 76,
+ 77, 78, 79, 80, 81, 82, 83, 84, 85, 86,
+ 0, 0, 87, 0, 0, 98, 99, 88, 100, 101,
+ 102, 103, 104, 0, 104, 0, 0, 105, 106, 105,
+ 106, 0, 0, 0, 107, 0, 107, 0, 0, 0,
+ 0, 0, 139, 78, 79, 80, 81, 82, 83, 84,
+ 85, 86, 128, 0, 87, 0, 0, 0, 0, 88,
+ 109, 110, 206, 111, 112, 113, 114, 115, 109, 110,
+ 0, 111, 112, 113, 114, 115
+};
+
+static const short ffcheck[] = { 1,
+ 6, 20, 38, 7, 35, 24, 8, 9, 50, 40,
+ 41, 47, 16, 20, 28, 29, 47, 6, 20, 21,
+ 22, 20, 24, 25, 38, 27, 42, 1, 20, 20,
+ 23, 47, 24, 47, 8, 9, 10, 28, 29, 43,
+ 31, 32, 33, 34, 35, 35, 53, 53, 52, 51,
+ 52, 53, 54, 27, 53, 23, 23, 35, 36, 37,
+ 38, 39, 53, 23, 42, 47, 47, 47, 70, 47,
+ 72, 6, 74, 75, 76, 77, 78, 79, 80, 81,
+ 82, 83, 84, 85, 86, 87, 88, 20, 90, 40,
+ 41, 6, 6, 95, 96, 1, 47, 31, 32, 33,
+ 34, 35, 8, 9, 53, 107, 28, 29, 53, 31,
+ 32, 33, 34, 35, 20, 117, 90, 23, 24, 25,
+ 122, 27, 124, -1, 1, 0, -1, 129, 50, 131,
+ -1, 8, -1, -1, -1, 109, 110, 111, 112, 113,
+ 114, 115, -1, -1, -1, -1, 23, -1, 122, -1,
+ 27, -1, 28, 29, 128, 31, 32, 33, 34, 35,
+ -1, -1, 20, -1, 70, -1, 72, 25, 26, 27,
+ 28, 29, 27, 28, 29, -1, -1, 53, -1, 85,
+ 38, -1, -1, 38, 90, 91, 92, 93, 94, 47,
+ -1, -1, 47, -1, -1, 53, -1, 38, 39, 201,
+ 202, 42, 204, 205, -1, 207, 47, -1, -1, 211,
+ -1, 213, -1, 119, 216, -1, 218, -1, -1, -1,
+ 222, 98, 99, 100, 101, 102, 103, 104, 105, 106,
+ -1, -1, 206, -1, -1, 237, -1, 239, -1, 241,
+ -1, 243, -1, 245, -1, -1, -1, -1, 25, 26,
+ 27, 28, 29, -1, -1, 257, -1, 259, -1, 261,
+ -1, 38, 264, -1, 25, 26, 27, 28, 29, 271,
+ 47, 273, -1, 275, -1, 277, 53, 38, -1, -1,
+ -1, -1, -1, -1, 286, -1, 47, -1, -1, -1,
+ -1, -1, 53, 170, 171, -1, -1, -1, 204, 205,
+ 0, 1, -1, 3, 4, 5, 6, 7, 8, 9,
+ 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
+ -1, 28, 29, 23, 31, 32, 33, 34, 35, -1,
+ -1, -1, -1, 40, 41, 35, 36, -1, -1, -1,
+ 47, -1, -1, 43, 44, 45, 53, -1, -1, -1,
+ 50, -1, 52, 3, 4, 5, 6, 7, 8, 9,
+ 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
+ -1, 28, 29, 23, 31, 32, 33, 34, 35, -1,
+ -1, -1, -1, 40, 41, 35, 36, -1, -1, -1,
+ 47, -1, -1, 43, 44, 45, 53, -1, -1, -1,
+ -1, -1, 52, 53, 3, 4, 5, 6, 7, 8,
+ 9, 10, 11, 12, 13, 14, 15, 16, 17, 18,
+ 19, -1, -1, -1, 23, -1, -1, 25, 26, 27,
+ 28, 29, -1, -1, -1, -1, 35, 36, -1, -1,
+ 38, -1, -1, -1, 43, 44, 45, 20, 21, 47,
+ -1, -1, 50, 52, -1, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, -1, -1, 42,
+ -1, -1, -1, -1, 47, 20, 21, -1, -1, -1,
+ 53, -1, -1, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, -1, 42, -1, -1,
+ -1, -1, 47, 20, 21, -1, -1, -1, 53, -1,
+ -1, 28, 29, 30, 31, 32, 33, 34, 35, 36,
+ 37, 38, 39, -1, -1, 42, -1, -1, -1, -1,
+ 47, 20, 21, -1, -1, -1, 53, -1, -1, 28,
+ 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,
+ 39, -1, -1, 42, -1, -1, -1, -1, 47, 20,
+ 21, -1, -1, -1, 53, -1, -1, 28, 29, 30,
+ 31, 32, 33, 34, 35, 36, 37, 38, 39, -1,
+ -1, 42, -1, -1, -1, -1, 47, 20, 21, -1,
+ -1, -1, 53, -1, -1, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, -1, -1, 42,
+ -1, -1, -1, -1, 47, 20, 21, -1, -1, -1,
+ 53, -1, -1, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, -1, 42, -1, -1,
+ -1, -1, 47, 21, -1, -1, -1, -1, 53, -1,
+ 28, 29, 30, 31, 32, 33, 34, 35, 36, 37,
+ 38, 39, -1, -1, 42, -1, -1, -1, -1, 47,
+ 21, -1, -1, -1, -1, 53, -1, 28, 29, 30,
+ 31, 32, 33, 34, 35, 36, 37, 38, 39, -1,
+ -1, 42, -1, -1, -1, -1, 47, 21, -1, -1,
+ -1, -1, 53, -1, 28, 29, 30, 31, 32, 33,
+ 34, 35, 36, 37, 38, 39, -1, -1, 42, -1,
+ -1, -1, -1, 47, 21, -1, -1, -1, -1, 53,
+ -1, 28, 29, 30, 31, 32, 33, 34, 35, 36,
+ 37, 38, 39, -1, -1, 42, -1, -1, -1, -1,
+ 47, 20, 21, -1, -1, -1, 53, -1, -1, 28,
+ 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,
+ 39, -1, -1, 42, -1, 20, 21, -1, 47, -1,
+ -1, -1, 51, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, -1, 42, -1, 20,
+ 21, -1, 47, -1, -1, -1, 51, 28, 29, 30,
+ 31, 32, 33, 34, 35, 36, 37, 38, 39, -1,
+ -1, 42, -1, 20, 21, -1, 47, -1, -1, -1,
+ 51, 28, 29, 30, 31, 32, 33, 34, 35, 36,
+ 37, 38, 39, -1, -1, 42, -1, 20, 21, -1,
+ 47, -1, -1, -1, 51, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, -1, -1, 42,
+ -1, 20, 21, -1, 47, -1, -1, -1, 51, 28,
+ 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,
+ 39, -1, -1, 42, -1, 20, 21, -1, 47, -1,
+ -1, -1, 51, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, -1, 42, -1, 20,
+ 21, -1, 47, -1, -1, -1, 51, 28, 29, 30,
+ 31, 32, 33, 34, 35, 36, 37, 38, 39, -1,
+ -1, 42, -1, 20, 21, -1, 47, -1, -1, -1,
+ 51, 28, 29, 30, 31, 32, 33, 34, 35, 36,
+ 37, 38, 39, -1, -1, 42, -1, 20, 21, -1,
+ 47, -1, -1, -1, 51, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, -1, -1, 42,
+ -1, 20, 21, -1, 47, -1, -1, -1, 51, 28,
+ 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,
+ 39, -1, -1, 42, -1, 20, 21, -1, 47, -1,
+ -1, -1, 51, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, -1, 42, -1, -1,
+ 21, -1, 47, -1, -1, -1, 51, 28, 29, 30,
+ 31, 32, 33, 34, 35, 36, 37, 38, 39, -1,
+ -1, 42, -1, -1, 21, -1, 47, -1, -1, -1,
+ 51, 28, 29, 30, 31, 32, 33, 34, 35, 36,
+ 37, 38, 39, -1, -1, 42, -1, -1, 21, -1,
+ 47, -1, -1, -1, 51, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, -1, -1, 42,
+ -1, -1, 21, -1, 47, -1, -1, -1, 51, 28,
+ 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,
+ 39, -1, -1, 42, -1, -1, -1, -1, 47, -1,
+ -1, 50, 25, 26, 27, 28, 29, 28, 29, -1,
+ 31, 32, 33, 34, 35, 38, 28, 29, -1, 31,
+ 32, 33, 34, 35, 47, 20, 21, -1, -1, -1,
+ 53, -1, 53, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, 20, 21, 42, -1, -1,
+ -1, -1, 47, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, 20, 21, 42, -1, -1,
+ -1, -1, 47, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, 20, 21, 42, -1, -1,
+ -1, -1, 47, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, 20, 21, 42, -1, -1,
+ -1, -1, 47, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, 20, 21, 42, -1, -1,
+ -1, -1, 47, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, 21, 42, -1, 24,
+ -1, -1, 47, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, 21, 42, -1, 24,
+ -1, -1, 47, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, 21, 42, -1, 24,
+ -1, -1, 47, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, 21, 42, -1, 24,
+ -1, -1, 47, 28, 29, 30, 31, 32, 33, 34,
+ 35, 36, 37, 38, 39, -1, -1, 42, 21, 22,
+ -1, -1, 47, -1, -1, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 37, 38, 39, -1, -1, 42,
+ 21, 22, -1, -1, 47, -1, -1, 28, 29, 30,
+ 31, 32, 33, 34, 35, 36, 37, 38, 39, -1,
+ 21, 42, -1, -1, -1, -1, 47, 28, 29, 30,
+ 31, 32, 33, 34, 35, 36, 37, 38, 39, -1,
+ -1, 42, -1, -1, 22, -1, 47, 25, 26, 27,
+ 28, 29, 28, 29, -1, 31, 32, 33, 34, 35,
+ 38, 28, 29, -1, 31, 32, 33, 34, 35, 47,
+ 25, 26, 27, 28, 29, 28, 29, 53, 31, 32,
+ 33, 34, 35, 38, -1, -1, 53, 40, 41, -1,
+ -1, -1, 47, -1, 47, -1, -1, 50, 28, 29,
+ 30, 31, 32, 33, 34, 35, 36, 37, 38, 39,
+ -1, -1, 42, -1, -1, 28, 29, 47, 31, 32,
+ 33, 34, 35, -1, 35, -1, -1, 40, 41, 40,
+ 41, -1, -1, -1, 47, -1, 47, -1, -1, -1,
+ -1, -1, 53, 31, 32, 33, 34, 35, 36, 37,
+ 38, 39, 20, -1, 42, -1, -1, -1, -1, 47,
+ 28, 29, 22, 31, 32, 33, 34, 35, 28, 29,
+ -1, 31, 32, 33, 34, 35
+};
+/* -*-C-*- Note some compilers choke on comments on `#line' lines. */
+#line 3 "/usr1/local/share/bison.simple"
+
+/* Skeleton output parser for bison,
+ Copyright (C) 1984, 1989, 1990 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+#ifndef alloca
+#ifdef __GNUC__
+#define alloca __builtin_alloca
+#else /* not GNU C. */
+#if (!defined (__STDC__) && defined (sparc)) || defined (__sparc__) || defined (__sparc) || defined (__sgi)
+#include <alloca.h>
+#else /* not sparc */
+#if defined (MSDOS) && !defined (__TURBOC__)
+#include <malloc.h>
+#else /* not MSDOS, or __TURBOC__ */
+#if defined(_AIX)
+#include <malloc.h>
+ #pragma alloca
+#else /* not MSDOS, __TURBOC__, or _AIX */
+#ifdef __hpux
+#ifdef __cplusplus
+extern "C" {
+void *alloca (unsigned int);
+};
+#else /* not __cplusplus */
+void *alloca ();
+#endif /* not __cplusplus */
+#endif /* __hpux */
+#endif /* not _AIX */
+#endif /* not MSDOS, or __TURBOC__ */
+#endif /* not sparc. */
+#endif /* not GNU C. */
+#endif /* alloca not defined. */
+
+/* This is the parser code that is written into each bison parser
+ when the %semantic_parser declaration is not specified in the grammar.
+ It was written by Richard Stallman by simplifying the hairy parser
+ used when %semantic_parser is specified. */
+
+/* Note: there must be only one dollar sign in this file.
+ It is replaced by the list of actions, each action
+ as one case of the switch. */
+
+#define fferrok (fferrstatus = 0)
+#define ffclearin (ffchar = FFEMPTY)
+#define FFEMPTY -2
+#define FFEOF 0
+#define FFACCEPT return(0)
+#define FFABORT return(1)
+#define FFERROR goto fferrlab1
+/* Like FFERROR except do call fferror.
+ This remains here temporarily to ease the
+ transition to the new meaning of FFERROR, for GCC.
+ Once GCC version 2 has supplanted version 1, this can go. */
+#define FFFAIL goto fferrlab
+#define FFRECOVERING() (!!fferrstatus)
+#define FFBACKUP(token, value) \
+do \
+ if (ffchar == FFEMPTY && fflen == 1) \
+ { ffchar = (token), fflval = (value); \
+ ffchar1 = FFTRANSLATE (ffchar); \
+ FFPOPSTACK; \
+ goto ffbackup; \
+ } \
+ else \
+ { fferror ("syntax error: cannot back up"); FFERROR; } \
+while (0)
+
+#define FFTERROR 1
+#define FFERRCODE 256
+
+#ifndef FFPURE
+#define FFLEX fflex()
+#endif
+
+#ifdef FFPURE
+#ifdef FFLSP_NEEDED
+#ifdef FFLEX_PARAM
+#define FFLEX fflex(&fflval, &fflloc, FFLEX_PARAM)
+#else
+#define FFLEX fflex(&fflval, &fflloc)
+#endif
+#else /* not FFLSP_NEEDED */
+#ifdef FFLEX_PARAM
+#define FFLEX fflex(&fflval, FFLEX_PARAM)
+#else
+#define FFLEX fflex(&fflval)
+#endif
+#endif /* not FFLSP_NEEDED */
+#endif
+
+/* If nonreentrant, generate the variables here */
+
+#ifndef FFPURE
+
+int ffchar; /* the lookahead symbol */
+FFSTYPE fflval; /* the semantic value of the */
+ /* lookahead symbol */
+
+#ifdef FFLSP_NEEDED
+FFLTYPE fflloc; /* location data for the lookahead */
+ /* symbol */
+#endif
+
+int ffnerrs; /* number of parse errors so far */
+#endif /* not FFPURE */
+
+#if FFDEBUG != 0
+int ffdebug; /* nonzero means print parse trace */
+/* Since this is uninitialized, it does not stop multiple parsers
+ from coexisting. */
+#endif
+
+/* FFINITDEPTH indicates the initial size of the parser's stacks */
+
+#ifndef FFINITDEPTH
+#define FFINITDEPTH 200
+#endif
+
+/* FFMAXDEPTH is the maximum size the stacks can grow to
+ (effective only if the built-in stack extension method is used). */
+
+#if FFMAXDEPTH == 0
+#undef FFMAXDEPTH
+#endif
+
+#ifndef FFMAXDEPTH
+#define FFMAXDEPTH 10000
+#endif
+
+/* Prevent warning if -Wstrict-prototypes. */
+#ifdef __GNUC__
+int ffparse (void);
+#endif
+
+#if __GNUC__ > 1 /* GNU C and GNU C++ define this. */
+#define __ff_memcpy(TO,FROM,COUNT) __builtin_memcpy(TO,FROM,COUNT)
+#else /* not GNU C or C++ */
+#ifndef __cplusplus
+
+/* This is the most reliable way to avoid incompatibilities
+ in available built-in functions on various systems. */
+static void
+__ff_memcpy (to, from, count)
+ char *to;
+ char *from;
+ int count;
+{
+ register char *f = from;
+ register char *t = to;
+ register int i = count;
+
+ while (i-- > 0)
+ *t++ = *f++;
+}
+
+#else /* __cplusplus */
+
+/* This is the most reliable way to avoid incompatibilities
+ in available built-in functions on various systems. */
+static void
+__ff_memcpy (char *to, char *from, int count)
+{
+ register char *f = from;
+ register char *t = to;
+ register int i = count;
+
+ while (i-- > 0)
+ *t++ = *f++;
+}
+
+#endif
+#endif
+
+#line 196 "/usr1/local/share/bison.simple"
+
+/* The user can define FFPARSE_PARAM as the name of an argument to be passed
+ into ffparse. The argument should have type void *.
+ It should actually point to an object.
+ Grammar actions can access the variable by casting it
+ to the proper pointer type. */
+
+#ifdef FFPARSE_PARAM
+#ifdef __cplusplus
+#define FFPARSE_PARAM_ARG void *FFPARSE_PARAM
+#define FFPARSE_PARAM_DECL
+#else /* not __cplusplus */
+#define FFPARSE_PARAM_ARG FFPARSE_PARAM
+#define FFPARSE_PARAM_DECL void *FFPARSE_PARAM;
+#endif /* not __cplusplus */
+#else /* not FFPARSE_PARAM */
+#define FFPARSE_PARAM_ARG
+#define FFPARSE_PARAM_DECL
+#endif /* not FFPARSE_PARAM */
+
+int
+ffparse(FFPARSE_PARAM_ARG)
+ FFPARSE_PARAM_DECL
+{
+ register int ffstate;
+ register int ffn;
+ register short *ffssp;
+ register FFSTYPE *ffvsp;
+ int fferrstatus; /* number of tokens to shift before error messages enabled */
+ int ffchar1 = 0; /* lookahead token as an internal (translated) token number */
+
+ short ffssa[FFINITDEPTH]; /* the state stack */
+ FFSTYPE ffvsa[FFINITDEPTH]; /* the semantic value stack */
+
+ short *ffss = ffssa; /* refer to the stacks thru separate pointers */
+ FFSTYPE *ffvs = ffvsa; /* to allow ffoverflow to reallocate them elsewhere */
+
+#ifdef FFLSP_NEEDED
+ FFLTYPE fflsa[FFINITDEPTH]; /* the location stack */
+ FFLTYPE *ffls = fflsa;
+ FFLTYPE *fflsp;
+
+#define FFPOPSTACK (ffvsp--, ffssp--, fflsp--)
+#else
+#define FFPOPSTACK (ffvsp--, ffssp--)
+#endif
+
+ int ffstacksize = FFINITDEPTH;
+
+#ifdef FFPURE
+ int ffchar;
+ FFSTYPE fflval;
+ int ffnerrs;
+#ifdef FFLSP_NEEDED
+ FFLTYPE fflloc;
+#endif
+#endif
+
+ FFSTYPE ffval; /* the variable used to return */
+ /* semantic values from the action */
+ /* routines */
+
+ int fflen;
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ fprintf(stderr, "Starting parse\n");
+#endif
+
+ ffstate = 0;
+ fferrstatus = 0;
+ ffnerrs = 0;
+ ffchar = FFEMPTY; /* Cause a token to be read. */
+
+ /* Initialize stack pointers.
+ Waste one element of value and location stack
+ so that they stay on the same level as the state stack.
+ The wasted elements are never initialized. */
+
+ ffssp = ffss - 1;
+ ffvsp = ffvs;
+#ifdef FFLSP_NEEDED
+ fflsp = ffls;
+#endif
+
+/* Push a new state, which is found in ffstate . */
+/* In all cases, when you get here, the value and location stacks
+ have just been pushed. so pushing a state here evens the stacks. */
+ffnewstate:
+
+ *++ffssp = ffstate;
+
+ if (ffssp >= ffss + ffstacksize - 1)
+ {
+ /* Give user a chance to reallocate the stack */
+ /* Use copies of these so that the &'s don't force the real ones into memory. */
+ FFSTYPE *ffvs1 = ffvs;
+ short *ffss1 = ffss;
+#ifdef FFLSP_NEEDED
+ FFLTYPE *ffls1 = ffls;
+#endif
+
+ /* Get the current used size of the three stacks, in elements. */
+ int size = ffssp - ffss + 1;
+
+#ifdef ffoverflow
+ /* Each stack pointer address is followed by the size of
+ the data in use in that stack, in bytes. */
+#ifdef FFLSP_NEEDED
+ /* This used to be a conditional around just the two extra args,
+ but that might be undefined if ffoverflow is a macro. */
+ ffoverflow("parser stack overflow",
+ &ffss1, size * sizeof (*ffssp),
+ &ffvs1, size * sizeof (*ffvsp),
+ &ffls1, size * sizeof (*fflsp),
+ &ffstacksize);
+#else
+ ffoverflow("parser stack overflow",
+ &ffss1, size * sizeof (*ffssp),
+ &ffvs1, size * sizeof (*ffvsp),
+ &ffstacksize);
+#endif
+
+ ffss = ffss1; ffvs = ffvs1;
+#ifdef FFLSP_NEEDED
+ ffls = ffls1;
+#endif
+#else /* no ffoverflow */
+ /* Extend the stack our own way. */
+ if (ffstacksize >= FFMAXDEPTH)
+ {
+ fferror("parser stack overflow");
+ return 2;
+ }
+ ffstacksize *= 2;
+ if (ffstacksize > FFMAXDEPTH)
+ ffstacksize = FFMAXDEPTH;
+ ffss = (short *) alloca (ffstacksize * sizeof (*ffssp));
+ __ff_memcpy ((char *)ffss, (char *)ffss1, size * sizeof (*ffssp));
+ ffvs = (FFSTYPE *) alloca (ffstacksize * sizeof (*ffvsp));
+ __ff_memcpy ((char *)ffvs, (char *)ffvs1, size * sizeof (*ffvsp));
+#ifdef FFLSP_NEEDED
+ ffls = (FFLTYPE *) alloca (ffstacksize * sizeof (*fflsp));
+ __ff_memcpy ((char *)ffls, (char *)ffls1, size * sizeof (*fflsp));
+#endif
+#endif /* no ffoverflow */
+
+ ffssp = ffss + size - 1;
+ ffvsp = ffvs + size - 1;
+#ifdef FFLSP_NEEDED
+ fflsp = ffls + size - 1;
+#endif
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ fprintf(stderr, "Stack size increased to %d\n", ffstacksize);
+#endif
+
+ if (ffssp >= ffss + ffstacksize - 1)
+ FFABORT;
+ }
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ fprintf(stderr, "Entering state %d\n", ffstate);
+#endif
+
+ goto ffbackup;
+ ffbackup:
+
+/* Do appropriate processing given the current state. */
+/* Read a lookahead token if we need one and don't already have one. */
+/* ffresume: */
+
+ /* First try to decide what to do without reference to lookahead token. */
+
+ ffn = ffpact[ffstate];
+ if (ffn == FFFLAG)
+ goto ffdefault;
+
+ /* Not known => get a lookahead token if don't already have one. */
+
+ /* ffchar is either FFEMPTY or FFEOF
+ or a valid token in external form. */
+
+ if (ffchar == FFEMPTY)
+ {
+#if FFDEBUG != 0
+ if (ffdebug)
+ fprintf(stderr, "Reading a token: ");
+#endif
+ ffchar = FFLEX;
+ }
+
+ /* Convert token to internal form (in ffchar1) for indexing tables with */
+
+ if (ffchar <= 0) /* This means end of input. */
+ {
+ ffchar1 = 0;
+ ffchar = FFEOF; /* Don't call FFLEX any more */
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ fprintf(stderr, "Now at end of input.\n");
+#endif
+ }
+ else
+ {
+ ffchar1 = FFTRANSLATE(ffchar);
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ {
+ fprintf (stderr, "Next token is %d (%s", ffchar, fftname[ffchar1]);
+ /* Give the individual parser a way to print the precise meaning
+ of a token, for further debugging info. */
+#ifdef FFPRINT
+ FFPRINT (stderr, ffchar, fflval);
+#endif
+ fprintf (stderr, ")\n");
+ }
+#endif
+ }
+
+ ffn += ffchar1;
+ if (ffn < 0 || ffn > FFLAST || ffcheck[ffn] != ffchar1)
+ goto ffdefault;
+
+ ffn = fftable[ffn];
+
+ /* ffn is what to do for this token type in this state.
+ Negative => reduce, -ffn is rule number.
+ Positive => shift, ffn is new state.
+ New state is final state => don't bother to shift,
+ just return success.
+ 0, or most negative number => error. */
+
+ if (ffn < 0)
+ {
+ if (ffn == FFFLAG)
+ goto fferrlab;
+ ffn = -ffn;
+ goto ffreduce;
+ }
+ else if (ffn == 0)
+ goto fferrlab;
+
+ if (ffn == FFFINAL)
+ FFACCEPT;
+
+ /* Shift the lookahead token. */
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ fprintf(stderr, "Shifting token %d (%s), ", ffchar, fftname[ffchar1]);
+#endif
+
+ /* Discard the token being shifted unless it is eof. */
+ if (ffchar != FFEOF)
+ ffchar = FFEMPTY;
+
+ *++ffvsp = fflval;
+#ifdef FFLSP_NEEDED
+ *++fflsp = fflloc;
+#endif
+
+ /* count tokens shifted since error; after three, turn off error status. */
+ if (fferrstatus) fferrstatus--;
+
+ ffstate = ffn;
+ goto ffnewstate;
+
+/* Do the default action for the current state. */
+ffdefault:
+
+ ffn = ffdefact[ffstate];
+ if (ffn == 0)
+ goto fferrlab;
+
+/* Do a reduction. ffn is the number of a rule to reduce with. */
+ffreduce:
+ fflen = ffr2[ffn];
+ if (fflen > 0)
+ ffval = ffvsp[1-fflen]; /* implement default value of the action */
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ {
+ int i;
+
+ fprintf (stderr, "Reducing via rule %d (line %d), ",
+ ffn, ffrline[ffn]);
+
+ /* Print the symbols being reduced, and their result. */
+ for (i = ffprhs[ffn]; ffrhs[i] > 0; i++)
+ fprintf (stderr, "%s ", fftname[ffrhs[i]]);
+ fprintf (stderr, " -> %s\n", fftname[ffr1[ffn]]);
+ }
+#endif
+
+
+ switch (ffn) {
+
+case 3:
+#line 245 "eval.y"
+{;
+ break;}
+case 4:
+#line 247 "eval.y"
+{ if( ffvsp[-1].Node<0 ) {
+ fferror("Couldn't build node structure: out of memory?");
+ FFERROR; }
+ gParse.resultNode = ffvsp[-1].Node;
+ ;
+ break;}
+case 5:
+#line 253 "eval.y"
+{ if( ffvsp[-1].Node<0 ) {
+ fferror("Couldn't build node structure: out of memory?");
+ FFERROR; }
+ gParse.resultNode = ffvsp[-1].Node;
+ ;
+ break;}
+case 6:
+#line 259 "eval.y"
+{ if( ffvsp[-1].Node<0 ) {
+ fferror("Couldn't build node structure: out of memory?");
+ FFERROR; }
+ gParse.resultNode = ffvsp[-1].Node;
+ ;
+ break;}
+case 7:
+#line 265 "eval.y"
+{ if( ffvsp[-1].Node<0 ) {
+ fferror("Couldn't build node structure: out of memory?");
+ FFERROR; }
+ gParse.resultNode = ffvsp[-1].Node;
+ ;
+ break;}
+case 8:
+#line 270 "eval.y"
+{ fferrok; ;
+ break;}
+case 9:
+#line 274 "eval.y"
+{ ffval.Node = New_Vector( ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 10:
+#line 276 "eval.y"
+{
+ if( gParse.Nodes[ffvsp[-2].Node].nSubNodes >= MAXSUBS ) {
+ ffvsp[-2].Node = Close_Vec( ffvsp[-2].Node ); TEST(ffvsp[-2].Node);
+ ffval.Node = New_Vector( ffvsp[-2].Node ); TEST(ffval.Node);
+ } else {
+ ffval.Node = ffvsp[-2].Node;
+ }
+ gParse.Nodes[ffval.Node].SubNodes[ gParse.Nodes[ffval.Node].nSubNodes++ ]
+ = ffvsp[0].Node;
+ ;
+ break;}
+case 11:
+#line 289 "eval.y"
+{ ffval.Node = New_Vector( ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 12:
+#line 291 "eval.y"
+{
+ if( TYPE(ffvsp[-2].Node) < TYPE(ffvsp[0].Node) )
+ TYPE(ffvsp[-2].Node) = TYPE(ffvsp[0].Node);
+ if( gParse.Nodes[ffvsp[-2].Node].nSubNodes >= MAXSUBS ) {
+ ffvsp[-2].Node = Close_Vec( ffvsp[-2].Node ); TEST(ffvsp[-2].Node);
+ ffval.Node = New_Vector( ffvsp[-2].Node ); TEST(ffval.Node);
+ } else {
+ ffval.Node = ffvsp[-2].Node;
+ }
+ gParse.Nodes[ffval.Node].SubNodes[ gParse.Nodes[ffval.Node].nSubNodes++ ]
+ = ffvsp[0].Node;
+ ;
+ break;}
+case 13:
+#line 304 "eval.y"
+{
+ if( gParse.Nodes[ffvsp[-2].Node].nSubNodes >= MAXSUBS ) {
+ ffvsp[-2].Node = Close_Vec( ffvsp[-2].Node ); TEST(ffvsp[-2].Node);
+ ffval.Node = New_Vector( ffvsp[-2].Node ); TEST(ffval.Node);
+ } else {
+ ffval.Node = ffvsp[-2].Node;
+ }
+ gParse.Nodes[ffval.Node].SubNodes[ gParse.Nodes[ffval.Node].nSubNodes++ ]
+ = ffvsp[0].Node;
+ ;
+ break;}
+case 14:
+#line 315 "eval.y"
+{
+ TYPE(ffvsp[-2].Node) = TYPE(ffvsp[0].Node);
+ if( gParse.Nodes[ffvsp[-2].Node].nSubNodes >= MAXSUBS ) {
+ ffvsp[-2].Node = Close_Vec( ffvsp[-2].Node ); TEST(ffvsp[-2].Node);
+ ffval.Node = New_Vector( ffvsp[-2].Node ); TEST(ffval.Node);
+ } else {
+ ffval.Node = ffvsp[-2].Node;
+ }
+ gParse.Nodes[ffval.Node].SubNodes[ gParse.Nodes[ffval.Node].nSubNodes++ ]
+ = ffvsp[0].Node;
+ ;
+ break;}
+case 15:
+#line 329 "eval.y"
+{ ffval.Node = Close_Vec( ffvsp[-1].Node ); TEST(ffval.Node); ;
+ break;}
+case 16:
+#line 333 "eval.y"
+{ ffval.Node = Close_Vec( ffvsp[-1].Node ); TEST(ffval.Node); ;
+ break;}
+case 17:
+#line 337 "eval.y"
+{
+ ffval.Node = New_Const( BITSTR, ffvsp[0].str, strlen(ffvsp[0].str)+1 ); TEST(ffval.Node);
+ SIZE(ffval.Node) = strlen(ffvsp[0].str); ;
+ break;}
+case 18:
+#line 341 "eval.y"
+{ ffval.Node = New_Column( ffvsp[0].lng ); TEST(ffval.Node); ;
+ break;}
+case 19:
+#line 343 "eval.y"
+{
+ if( TYPE(ffvsp[-1].Node) != LONG
+ || OPER(ffvsp[-1].Node) != CONST_OP ) {
+ fferror("Offset argument must be a constant integer");
+ FFERROR;
+ }
+ ffval.Node = New_Offset( ffvsp[-3].lng, ffvsp[-1].Node ); TEST(ffval.Node);
+ ;
+ break;}
+case 20:
+#line 352 "eval.y"
+{ ffval.Node = New_BinOp( BITSTR, ffvsp[-2].Node, '&', ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = ( SIZE(ffvsp[-2].Node)>SIZE(ffvsp[0].Node) ? SIZE(ffvsp[-2].Node) : SIZE(ffvsp[0].Node) ); ;
+ break;}
+case 21:
+#line 355 "eval.y"
+{ ffval.Node = New_BinOp( BITSTR, ffvsp[-2].Node, '|', ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = ( SIZE(ffvsp[-2].Node)>SIZE(ffvsp[0].Node) ? SIZE(ffvsp[-2].Node) : SIZE(ffvsp[0].Node) ); ;
+ break;}
+case 22:
+#line 358 "eval.y"
+{
+ if (SIZE(ffvsp[-2].Node)+SIZE(ffvsp[0].Node) >= MAX_STRLEN) {
+ fferror("Combined bit string size exceeds " MAX_STRLEN_S " bits");
+ FFERROR;
+ }
+ ffval.Node = New_BinOp( BITSTR, ffvsp[-2].Node, '+', ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = SIZE(ffvsp[-2].Node) + SIZE(ffvsp[0].Node);
+ ;
+ break;}
+case 23:
+#line 367 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-3].Node, 1, ffvsp[-1].Node, 0, 0, 0, 0 ); TEST(ffval.Node); ;
+ break;}
+case 24:
+#line 369 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-5].Node, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0, 0 ); TEST(ffval.Node); ;
+ break;}
+case 25:
+#line 371 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-7].Node, 3, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0 ); TEST(ffval.Node); ;
+ break;}
+case 26:
+#line 373 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-9].Node, 4, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0 ); TEST(ffval.Node); ;
+ break;}
+case 27:
+#line 375 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-11].Node, 5, ffvsp[-9].Node, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node ); TEST(ffval.Node); ;
+ break;}
+case 28:
+#line 377 "eval.y"
+{ ffval.Node = New_Unary( BITSTR, NOT, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 29:
+#line 380 "eval.y"
+{ ffval.Node = ffvsp[-1].Node; ;
+ break;}
+case 30:
+#line 384 "eval.y"
+{ ffval.Node = New_Const( LONG, &(ffvsp[0].lng), sizeof(long) ); TEST(ffval.Node); ;
+ break;}
+case 31:
+#line 386 "eval.y"
+{ ffval.Node = New_Const( DOUBLE, &(ffvsp[0].dbl), sizeof(double) ); TEST(ffval.Node); ;
+ break;}
+case 32:
+#line 388 "eval.y"
+{ ffval.Node = New_Column( ffvsp[0].lng ); TEST(ffval.Node); ;
+ break;}
+case 33:
+#line 390 "eval.y"
+{
+ if( TYPE(ffvsp[-1].Node) != LONG
+ || OPER(ffvsp[-1].Node) != CONST_OP ) {
+ fferror("Offset argument must be a constant integer");
+ FFERROR;
+ }
+ ffval.Node = New_Offset( ffvsp[-3].lng, ffvsp[-1].Node ); TEST(ffval.Node);
+ ;
+ break;}
+case 34:
+#line 399 "eval.y"
+{ ffval.Node = New_Func( LONG, row_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); ;
+ break;}
+case 35:
+#line 401 "eval.y"
+{ ffval.Node = New_Func( LONG, null_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); ;
+ break;}
+case 36:
+#line 403 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '%', ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 37:
+#line 406 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '+', ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 38:
+#line 409 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '-', ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 39:
+#line 412 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '*', ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 40:
+#line 415 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '/', ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 41:
+#line 418 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, POWER, ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 42:
+#line 421 "eval.y"
+{ ffval.Node = ffvsp[0].Node; ;
+ break;}
+case 43:
+#line 423 "eval.y"
+{ ffval.Node = New_Unary( TYPE(ffvsp[0].Node), UMINUS, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 44:
+#line 425 "eval.y"
+{ ffval.Node = ffvsp[-1].Node; ;
+ break;}
+case 45:
+#line 427 "eval.y"
+{ ffvsp[0].Node = New_Unary( TYPE(ffvsp[-2].Node), 0, ffvsp[0].Node );
+ ffval.Node = New_BinOp( TYPE(ffvsp[-2].Node), ffvsp[-2].Node, '*', ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 46:
+#line 431 "eval.y"
+{ ffvsp[-2].Node = New_Unary( TYPE(ffvsp[0].Node), 0, ffvsp[-2].Node );
+ ffval.Node = New_BinOp( TYPE(ffvsp[0].Node), ffvsp[-2].Node, '*', ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 47:
+#line 435 "eval.y"
+{
+ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node);
+ if( ! Test_Dims(ffvsp[-2].Node,ffvsp[0].Node) ) {
+ fferror("Incompatible dimensions in '?:' arguments");
+ FFERROR;
+ }
+ ffval.Node = New_Func( 0, ifthenelse_fct, 3, ffvsp[-2].Node, ffvsp[0].Node, ffvsp[-4].Node,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-2].Node)<SIZE(ffvsp[0].Node) ) Copy_Dims(ffval.Node, ffvsp[0].Node);
+ TYPE(ffvsp[-4].Node) = TYPE(ffvsp[-2].Node);
+ if( ! Test_Dims(ffvsp[-4].Node,ffval.Node) ) {
+ fferror("Incompatible dimensions in '?:' condition");
+ FFERROR;
+ }
+ TYPE(ffvsp[-4].Node) = BOOLEAN;
+ if( SIZE(ffval.Node)<SIZE(ffvsp[-4].Node) ) Copy_Dims(ffval.Node, ffvsp[-4].Node);
+ ;
+ break;}
+case 48:
+#line 454 "eval.y"
+{
+ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node);
+ if( ! Test_Dims(ffvsp[-2].Node,ffvsp[0].Node) ) {
+ fferror("Incompatible dimensions in '?:' arguments");
+ FFERROR;
+ }
+ ffval.Node = New_Func( 0, ifthenelse_fct, 3, ffvsp[-2].Node, ffvsp[0].Node, ffvsp[-4].Node,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-2].Node)<SIZE(ffvsp[0].Node) ) Copy_Dims(ffval.Node, ffvsp[0].Node);
+ TYPE(ffvsp[-4].Node) = TYPE(ffvsp[-2].Node);
+ if( ! Test_Dims(ffvsp[-4].Node,ffval.Node) ) {
+ fferror("Incompatible dimensions in '?:' condition");
+ FFERROR;
+ }
+ TYPE(ffvsp[-4].Node) = BOOLEAN;
+ if( SIZE(ffval.Node)<SIZE(ffvsp[-4].Node) ) Copy_Dims(ffval.Node, ffvsp[-4].Node);
+ ;
+ break;}
+case 49:
+#line 473 "eval.y"
+{
+ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node);
+ if( ! Test_Dims(ffvsp[-2].Node,ffvsp[0].Node) ) {
+ fferror("Incompatible dimensions in '?:' arguments");
+ FFERROR;
+ }
+ ffval.Node = New_Func( 0, ifthenelse_fct, 3, ffvsp[-2].Node, ffvsp[0].Node, ffvsp[-4].Node,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-2].Node)<SIZE(ffvsp[0].Node) ) Copy_Dims(ffval.Node, ffvsp[0].Node);
+ TYPE(ffvsp[-4].Node) = TYPE(ffvsp[-2].Node);
+ if( ! Test_Dims(ffvsp[-4].Node,ffval.Node) ) {
+ fferror("Incompatible dimensions in '?:' condition");
+ FFERROR;
+ }
+ TYPE(ffvsp[-4].Node) = BOOLEAN;
+ if( SIZE(ffval.Node)<SIZE(ffvsp[-4].Node) ) Copy_Dims(ffval.Node, ffvsp[-4].Node);
+ ;
+ break;}
+case 50:
+#line 492 "eval.y"
+{ if (FSTRCMP(ffvsp[-1].str,"RANDOM(") == 0) { /* Scalar RANDOM() */
+ srand( (unsigned int) time(NULL) );
+ ffval.Node = New_Func( DOUBLE, rnd_fct, 0, 0, 0, 0, 0, 0, 0, 0 );
+ } else if (FSTRCMP(ffvsp[-1].str,"RANDOMN(") == 0) {/*Scalar RANDOMN()*/
+ srand( (unsigned int) time(NULL) );
+ ffval.Node = New_Func( DOUBLE, gasrnd_fct, 0, 0, 0, 0, 0, 0, 0, 0 );
+ } else {
+ fferror("Function() not supported");
+ FFERROR;
+ }
+ TEST(ffval.Node);
+ ;
+ break;}
+case 51:
+#line 505 "eval.y"
+{ if (FSTRCMP(ffvsp[-2].str,"SUM(") == 0) {
+ ffval.Node = New_Func( LONG, sum_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ } else if (FSTRCMP(ffvsp[-2].str,"NELEM(") == 0) {
+ ffval.Node = New_Const( LONG, &( SIZE(ffvsp[-1].Node) ), sizeof(long) );
+ } else if (FSTRCMP(ffvsp[-2].str,"ACCUM(") == 0) {
+ long zero = 0;
+ ffval.Node = New_BinOp( LONG , ffvsp[-1].Node, ACCUM, New_Const( LONG, &zero, sizeof(zero) ));
+ } else {
+ fferror("Function(bool) not supported");
+ FFERROR;
+ }
+ TEST(ffval.Node);
+ ;
+ break;}
+case 52:
+#line 519 "eval.y"
+{ if (FSTRCMP(ffvsp[-2].str,"NELEM(") == 0) {
+ ffval.Node = New_Const( LONG, &( SIZE(ffvsp[-1].Node) ), sizeof(long) );
+ } else if (FSTRCMP(ffvsp[-2].str,"NVALID(") == 0) {
+ ffval.Node = New_Func( LONG, nonnull_fct, 1, ffvsp[-1].Node,
+ 0, 0, 0, 0, 0, 0 );
+ } else {
+ fferror("Function(str) not supported");
+ FFERROR;
+ }
+ TEST(ffval.Node);
+ ;
+ break;}
+case 53:
+#line 531 "eval.y"
+{ if (FSTRCMP(ffvsp[-2].str,"NELEM(") == 0) {
+ ffval.Node = New_Const( LONG, &( SIZE(ffvsp[-1].Node) ), sizeof(long) );
+ } else if (FSTRCMP(ffvsp[-2].str,"NVALID(") == 0) { /* Bit arrays do not have NULL */
+ ffval.Node = New_Const( LONG, &( SIZE(ffvsp[-1].Node) ), sizeof(long) );
+ } else if (FSTRCMP(ffvsp[-2].str,"SUM(") == 0) {
+ ffval.Node = New_Func( LONG, sum_fct, 1, ffvsp[-1].Node,
+ 0, 0, 0, 0, 0, 0 );
+ } else if (FSTRCMP(ffvsp[-2].str,"MIN(") == 0) {
+ ffval.Node = New_Func( TYPE(ffvsp[-1].Node), /* Force 1D result */
+ min1_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ /* Note: $2 is a vector so the result can never
+ be a constant. Therefore it will never be set
+ inside New_Func(), and it is safe to set SIZE() */
+ SIZE(ffval.Node) = 1;
+ } else if (FSTRCMP(ffvsp[-2].str,"ACCUM(") == 0) {
+ long zero = 0;
+ ffval.Node = New_BinOp( LONG , ffvsp[-1].Node, ACCUM, New_Const( LONG, &zero, sizeof(zero) ));
+ } else if (FSTRCMP(ffvsp[-2].str,"MAX(") == 0) {
+ ffval.Node = New_Func( TYPE(ffvsp[-1].Node), /* Force 1D result */
+ max1_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ /* Note: $2 is a vector so the result can never
+ be a constant. Therefore it will never be set
+ inside New_Func(), and it is safe to set SIZE() */
+ SIZE(ffval.Node) = 1;
+ } else {
+ fferror("Function(bits) not supported");
+ FFERROR;
+ }
+ TEST(ffval.Node);
+ ;
+ break;}
+case 54:
+#line 562 "eval.y"
+{ if (FSTRCMP(ffvsp[-2].str,"SUM(") == 0)
+ ffval.Node = New_Func( TYPE(ffvsp[-1].Node), sum_fct, 1, ffvsp[-1].Node,
+ 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"AVERAGE(") == 0)
+ ffval.Node = New_Func( DOUBLE, average_fct, 1, ffvsp[-1].Node,
+ 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"STDDEV(") == 0)
+ ffval.Node = New_Func( DOUBLE, stddev_fct, 1, ffvsp[-1].Node,
+ 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"MEDIAN(") == 0)
+ ffval.Node = New_Func( TYPE(ffvsp[-1].Node), median_fct, 1, ffvsp[-1].Node,
+ 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"NELEM(") == 0)
+ ffval.Node = New_Const( LONG, &( SIZE(ffvsp[-1].Node) ), sizeof(long) );
+ else if (FSTRCMP(ffvsp[-2].str,"NVALID(") == 0)
+ ffval.Node = New_Func( LONG, nonnull_fct, 1, ffvsp[-1].Node,
+ 0, 0, 0, 0, 0, 0 );
+ else if ((FSTRCMP(ffvsp[-2].str,"ACCUM(") == 0) && (TYPE(ffvsp[-1].Node) == LONG)) {
+ long zero = 0;
+ ffval.Node = New_BinOp( LONG , ffvsp[-1].Node, ACCUM, New_Const( LONG, &zero, sizeof(zero) ));
+ } else if ((FSTRCMP(ffvsp[-2].str,"ACCUM(") == 0) && (TYPE(ffvsp[-1].Node) == DOUBLE)) {
+ double zero = 0;
+ ffval.Node = New_BinOp( DOUBLE , ffvsp[-1].Node, ACCUM, New_Const( DOUBLE, &zero, sizeof(zero) ));
+ } else if ((FSTRCMP(ffvsp[-2].str,"SEQDIFF(") == 0) && (TYPE(ffvsp[-1].Node) == LONG)) {
+ long zero = 0;
+ ffval.Node = New_BinOp( LONG , ffvsp[-1].Node, DIFF, New_Const( LONG, &zero, sizeof(zero) ));
+ } else if ((FSTRCMP(ffvsp[-2].str,"SEQDIFF(") == 0) && (TYPE(ffvsp[-1].Node) == DOUBLE)) {
+ double zero = 0;
+ ffval.Node = New_BinOp( DOUBLE , ffvsp[-1].Node, DIFF, New_Const( DOUBLE, &zero, sizeof(zero) ));
+ } else if (FSTRCMP(ffvsp[-2].str,"ABS(") == 0)
+ ffval.Node = New_Func( 0, abs_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"MIN(") == 0)
+ ffval.Node = New_Func( TYPE(ffvsp[-1].Node), /* Force 1D result */
+ min1_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"MAX(") == 0)
+ ffval.Node = New_Func( TYPE(ffvsp[-1].Node), /* Force 1D result */
+ max1_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"RANDOM(") == 0) { /* Vector RANDOM() */
+ srand( (unsigned int) time(NULL) );
+ ffval.Node = New_Func( 0, rnd_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ TYPE(ffval.Node) = DOUBLE;
+ } else if (FSTRCMP(ffvsp[-2].str,"RANDOMN(") == 0) {
+ srand( (unsigned int) time(NULL) ); /* Vector RANDOMN() */
+ ffval.Node = New_Func( 0, gasrnd_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ TYPE(ffval.Node) = DOUBLE;
+ }
+ else { /* These all take DOUBLE arguments */
+ if( TYPE(ffvsp[-1].Node) != DOUBLE ) ffvsp[-1].Node = New_Unary( DOUBLE, 0, ffvsp[-1].Node );
+ if (FSTRCMP(ffvsp[-2].str,"SIN(") == 0)
+ ffval.Node = New_Func( 0, sin_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"COS(") == 0)
+ ffval.Node = New_Func( 0, cos_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"TAN(") == 0)
+ ffval.Node = New_Func( 0, tan_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"ARCSIN(") == 0
+ || FSTRCMP(ffvsp[-2].str,"ASIN(") == 0)
+ ffval.Node = New_Func( 0, asin_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"ARCCOS(") == 0
+ || FSTRCMP(ffvsp[-2].str,"ACOS(") == 0)
+ ffval.Node = New_Func( 0, acos_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"ARCTAN(") == 0
+ || FSTRCMP(ffvsp[-2].str,"ATAN(") == 0)
+ ffval.Node = New_Func( 0, atan_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"SINH(") == 0)
+ ffval.Node = New_Func( 0, sinh_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"COSH(") == 0)
+ ffval.Node = New_Func( 0, cosh_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"TANH(") == 0)
+ ffval.Node = New_Func( 0, tanh_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"EXP(") == 0)
+ ffval.Node = New_Func( 0, exp_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"LOG(") == 0)
+ ffval.Node = New_Func( 0, log_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"LOG10(") == 0)
+ ffval.Node = New_Func( 0, log10_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"SQRT(") == 0)
+ ffval.Node = New_Func( 0, sqrt_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"ROUND(") == 0)
+ ffval.Node = New_Func( 0, round_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"FLOOR(") == 0)
+ ffval.Node = New_Func( 0, floor_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"CEIL(") == 0)
+ ffval.Node = New_Func( 0, ceil_fct, 1, ffvsp[-1].Node, 0, 0, 0, 0, 0, 0 );
+ else if (FSTRCMP(ffvsp[-2].str,"RANDOMP(") == 0) {
+ srand( (unsigned int) time(NULL) );
+ ffval.Node = New_Func( 0, poirnd_fct, 1, ffvsp[-1].Node,
+ 0, 0, 0, 0, 0, 0 );
+ TYPE(ffval.Node) = LONG;
+ } else {
+ fferror("Function(expr) not supported");
+ FFERROR;
+ }
+ }
+ TEST(ffval.Node);
+ ;
+ break;}
+case 55:
+#line 660 "eval.y"
+{
+ if (FSTRCMP(ffvsp[-4].str,"STRSTR(") == 0) {
+ ffval.Node = New_Func( LONG, strpos_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ }
+ ;
+ break;}
+case 56:
+#line 668 "eval.y"
+{
+ if (FSTRCMP(ffvsp[-4].str,"DEFNULL(") == 0) {
+ if( SIZE(ffvsp[-3].Node)>=SIZE(ffvsp[-1].Node) && Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) {
+ PROMOTE(ffvsp[-3].Node,ffvsp[-1].Node);
+ ffval.Node = New_Func( 0, defnull_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ } else {
+ fferror("Dimensions of DEFNULL arguments "
+ "are not compatible");
+ FFERROR;
+ }
+ } else if (FSTRCMP(ffvsp[-4].str,"ARCTAN2(") == 0) {
+ if( TYPE(ffvsp[-3].Node) != DOUBLE ) ffvsp[-3].Node = New_Unary( DOUBLE, 0, ffvsp[-3].Node );
+ if( TYPE(ffvsp[-1].Node) != DOUBLE ) ffvsp[-1].Node = New_Unary( DOUBLE, 0, ffvsp[-1].Node );
+ if( Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) {
+ ffval.Node = New_Func( 0, atan2_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-3].Node)<SIZE(ffvsp[-1].Node) ) Copy_Dims(ffval.Node, ffvsp[-1].Node);
+ } else {
+ fferror("Dimensions of arctan2 arguments "
+ "are not compatible");
+ FFERROR;
+ }
+ } else if (FSTRCMP(ffvsp[-4].str,"MIN(") == 0) {
+ PROMOTE( ffvsp[-3].Node, ffvsp[-1].Node );
+ if( Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) {
+ ffval.Node = New_Func( 0, min2_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-3].Node)<SIZE(ffvsp[-1].Node) ) Copy_Dims(ffval.Node, ffvsp[-1].Node);
+ } else {
+ fferror("Dimensions of min(a,b) arguments "
+ "are not compatible");
+ FFERROR;
+ }
+ } else if (FSTRCMP(ffvsp[-4].str,"MAX(") == 0) {
+ PROMOTE( ffvsp[-3].Node, ffvsp[-1].Node );
+ if( Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) {
+ ffval.Node = New_Func( 0, max2_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-3].Node)<SIZE(ffvsp[-1].Node) ) Copy_Dims(ffval.Node, ffvsp[-1].Node);
+ } else {
+ fferror("Dimensions of max(a,b) arguments "
+ "are not compatible");
+ FFERROR;
+ }
+#if 0
+ } else if (FSTRCMP(ffvsp[-4].str,"STRSTR(") == 0) {
+ if( TYPE(ffvsp[-3].Node) != STRING || TYPE(ffvsp[-1].Node) != STRING) {
+ fferror("Arguments to strstr(s,r) must be strings");
+ FFERROR;
+ }
+ ffval.Node = New_Func( LONG, strpos_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+#endif
+ } else {
+ fferror("Function(expr,expr) not supported");
+ FFERROR;
+ }
+ ;
+ break;}
+case 57:
+#line 730 "eval.y"
+{
+ if (FSTRCMP(ffvsp[-8].str,"ANGSEP(") == 0) {
+ if( TYPE(ffvsp[-7].Node) != DOUBLE ) ffvsp[-7].Node = New_Unary( DOUBLE, 0, ffvsp[-7].Node );
+ if( TYPE(ffvsp[-5].Node) != DOUBLE ) ffvsp[-5].Node = New_Unary( DOUBLE, 0, ffvsp[-5].Node );
+ if( TYPE(ffvsp[-3].Node) != DOUBLE ) ffvsp[-3].Node = New_Unary( DOUBLE, 0, ffvsp[-3].Node );
+ if( TYPE(ffvsp[-1].Node) != DOUBLE ) ffvsp[-1].Node = New_Unary( DOUBLE, 0, ffvsp[-1].Node );
+ if( Test_Dims( ffvsp[-7].Node, ffvsp[-5].Node ) && Test_Dims( ffvsp[-5].Node, ffvsp[-3].Node ) &&
+ Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) {
+ ffval.Node = New_Func( 0, angsep_fct, 4, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node,0,0,0 );
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-7].Node)<SIZE(ffvsp[-5].Node) ) Copy_Dims(ffval.Node, ffvsp[-5].Node);
+ if( SIZE(ffvsp[-5].Node)<SIZE(ffvsp[-3].Node) ) Copy_Dims(ffval.Node, ffvsp[-3].Node);
+ if( SIZE(ffvsp[-3].Node)<SIZE(ffvsp[-1].Node) ) Copy_Dims(ffval.Node, ffvsp[-1].Node);
+ } else {
+ fferror("Dimensions of ANGSEP arguments "
+ "are not compatible");
+ FFERROR;
+ }
+ } else {
+ fferror("Function(expr,expr,expr,expr) not supported");
+ FFERROR;
+ }
+ ;
+ break;}
+case 58:
+#line 754 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-3].Node, 1, ffvsp[-1].Node, 0, 0, 0, 0 ); TEST(ffval.Node); ;
+ break;}
+case 59:
+#line 756 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-5].Node, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0, 0 ); TEST(ffval.Node); ;
+ break;}
+case 60:
+#line 758 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-7].Node, 3, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0 ); TEST(ffval.Node); ;
+ break;}
+case 61:
+#line 760 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-9].Node, 4, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0 ); TEST(ffval.Node); ;
+ break;}
+case 62:
+#line 762 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-11].Node, 5, ffvsp[-9].Node, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node ); TEST(ffval.Node); ;
+ break;}
+case 63:
+#line 764 "eval.y"
+{ ffval.Node = New_Unary( LONG, INTCAST, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 64:
+#line 766 "eval.y"
+{ ffval.Node = New_Unary( LONG, INTCAST, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 65:
+#line 768 "eval.y"
+{ ffval.Node = New_Unary( DOUBLE, FLTCAST, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 66:
+#line 770 "eval.y"
+{ ffval.Node = New_Unary( DOUBLE, FLTCAST, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 67:
+#line 774 "eval.y"
+{ ffval.Node = New_Const( BOOLEAN, &(ffvsp[0].log), sizeof(char) ); TEST(ffval.Node); ;
+ break;}
+case 68:
+#line 776 "eval.y"
+{ ffval.Node = New_Column( ffvsp[0].lng ); TEST(ffval.Node); ;
+ break;}
+case 69:
+#line 778 "eval.y"
+{
+ if( TYPE(ffvsp[-1].Node) != LONG
+ || OPER(ffvsp[-1].Node) != CONST_OP ) {
+ fferror("Offset argument must be a constant integer");
+ FFERROR;
+ }
+ ffval.Node = New_Offset( ffvsp[-3].lng, ffvsp[-1].Node ); TEST(ffval.Node);
+ ;
+ break;}
+case 70:
+#line 787 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, EQ, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 71:
+#line 790 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, NE, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 72:
+#line 793 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, LT, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 73:
+#line 796 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, LTE, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 74:
+#line 799 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, GT, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 75:
+#line 802 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, GTE, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 76:
+#line 805 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, GT, ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 77:
+#line 808 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, LT, ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 78:
+#line 811 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, GTE, ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 79:
+#line 814 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, LTE, ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 80:
+#line 817 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, '~', ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 81:
+#line 820 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, EQ, ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 82:
+#line 823 "eval.y"
+{ PROMOTE(ffvsp[-2].Node,ffvsp[0].Node); ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, NE, ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 83:
+#line 826 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, EQ, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 84:
+#line 829 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, NE, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 85:
+#line 832 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, GT, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 86:
+#line 835 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, GTE, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 87:
+#line 838 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, LT, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 88:
+#line 841 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, LTE, ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = 1; ;
+ break;}
+case 89:
+#line 844 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, AND, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 90:
+#line 846 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, OR, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 91:
+#line 848 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, EQ, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 92:
+#line 850 "eval.y"
+{ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, NE, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 93:
+#line 853 "eval.y"
+{ PROMOTE(ffvsp[-4].Node,ffvsp[-2].Node); PROMOTE(ffvsp[-4].Node,ffvsp[0].Node); PROMOTE(ffvsp[-2].Node,ffvsp[0].Node);
+ ffvsp[-2].Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, LTE, ffvsp[-4].Node );
+ ffvsp[0].Node = New_BinOp( BOOLEAN, ffvsp[-4].Node, LTE, ffvsp[0].Node );
+ ffval.Node = New_BinOp( BOOLEAN, ffvsp[-2].Node, AND, ffvsp[0].Node );
+ TEST(ffval.Node); ;
+ break;}
+case 94:
+#line 860 "eval.y"
+{
+ if( ! Test_Dims(ffvsp[-2].Node,ffvsp[0].Node) ) {
+ fferror("Incompatible dimensions in '?:' arguments");
+ FFERROR;
+ }
+ ffval.Node = New_Func( 0, ifthenelse_fct, 3, ffvsp[-2].Node, ffvsp[0].Node, ffvsp[-4].Node,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-2].Node)<SIZE(ffvsp[0].Node) ) Copy_Dims(ffval.Node, ffvsp[0].Node);
+ if( ! Test_Dims(ffvsp[-4].Node,ffval.Node) ) {
+ fferror("Incompatible dimensions in '?:' condition");
+ FFERROR;
+ }
+ if( SIZE(ffval.Node)<SIZE(ffvsp[-4].Node) ) Copy_Dims(ffval.Node, ffvsp[-4].Node);
+ ;
+ break;}
+case 95:
+#line 877 "eval.y"
+{
+ if (FSTRCMP(ffvsp[-2].str,"ISNULL(") == 0) {
+ ffval.Node = New_Func( 0, isnull_fct, 1, ffvsp[-1].Node, 0, 0,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ /* Use expression's size, but return BOOLEAN */
+ TYPE(ffval.Node) = BOOLEAN;
+ } else {
+ fferror("Boolean Function(expr) not supported");
+ FFERROR;
+ }
+ ;
+ break;}
+case 96:
+#line 890 "eval.y"
+{
+ if (FSTRCMP(ffvsp[-2].str,"ISNULL(") == 0) {
+ ffval.Node = New_Func( 0, isnull_fct, 1, ffvsp[-1].Node, 0, 0,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ /* Use expression's size, but return BOOLEAN */
+ TYPE(ffval.Node) = BOOLEAN;
+ } else {
+ fferror("Boolean Function(expr) not supported");
+ FFERROR;
+ }
+ ;
+ break;}
+case 97:
+#line 903 "eval.y"
+{
+ if (FSTRCMP(ffvsp[-2].str,"ISNULL(") == 0) {
+ ffval.Node = New_Func( BOOLEAN, isnull_fct, 1, ffvsp[-1].Node, 0, 0,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ } else {
+ fferror("Boolean Function(expr) not supported");
+ FFERROR;
+ }
+ ;
+ break;}
+case 98:
+#line 914 "eval.y"
+{
+ if (FSTRCMP(ffvsp[-4].str,"DEFNULL(") == 0) {
+ if( SIZE(ffvsp[-3].Node)>=SIZE(ffvsp[-1].Node) && Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) {
+ ffval.Node = New_Func( 0, defnull_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0,
+ 0, 0, 0, 0 );
+ TEST(ffval.Node);
+ } else {
+ fferror("Dimensions of DEFNULL arguments are not compatible");
+ FFERROR;
+ }
+ } else {
+ fferror("Boolean Function(expr,expr) not supported");
+ FFERROR;
+ }
+ ;
+ break;}
+case 99:
+#line 930 "eval.y"
+{
+ if( TYPE(ffvsp[-5].Node) != DOUBLE ) ffvsp[-5].Node = New_Unary( DOUBLE, 0, ffvsp[-5].Node );
+ if( TYPE(ffvsp[-3].Node) != DOUBLE ) ffvsp[-3].Node = New_Unary( DOUBLE, 0, ffvsp[-3].Node );
+ if( TYPE(ffvsp[-1].Node) != DOUBLE ) ffvsp[-1].Node = New_Unary( DOUBLE, 0, ffvsp[-1].Node );
+ if( ! (Test_Dims( ffvsp[-5].Node, ffvsp[-3].Node ) && Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node ) ) ) {
+ fferror("Dimensions of NEAR arguments "
+ "are not compatible");
+ FFERROR;
+ } else {
+ if (FSTRCMP(ffvsp[-6].str,"NEAR(") == 0) {
+ ffval.Node = New_Func( BOOLEAN, near_fct, 3, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node,
+ 0, 0, 0, 0 );
+ } else {
+ fferror("Boolean Function not supported");
+ FFERROR;
+ }
+ TEST(ffval.Node);
+
+ if( SIZE(ffval.Node)<SIZE(ffvsp[-5].Node) ) Copy_Dims(ffval.Node, ffvsp[-5].Node);
+ if( SIZE(ffvsp[-5].Node)<SIZE(ffvsp[-3].Node) ) Copy_Dims(ffval.Node, ffvsp[-3].Node);
+ if( SIZE(ffvsp[-3].Node)<SIZE(ffvsp[-1].Node) ) Copy_Dims(ffval.Node, ffvsp[-1].Node);
+ }
+ ;
+ break;}
+case 100:
+#line 954 "eval.y"
+{
+ if( TYPE(ffvsp[-9].Node) != DOUBLE ) ffvsp[-9].Node = New_Unary( DOUBLE, 0, ffvsp[-9].Node );
+ if( TYPE(ffvsp[-7].Node) != DOUBLE ) ffvsp[-7].Node = New_Unary( DOUBLE, 0, ffvsp[-7].Node );
+ if( TYPE(ffvsp[-5].Node) != DOUBLE ) ffvsp[-5].Node = New_Unary( DOUBLE, 0, ffvsp[-5].Node );
+ if( TYPE(ffvsp[-3].Node) != DOUBLE ) ffvsp[-3].Node = New_Unary( DOUBLE, 0, ffvsp[-3].Node );
+ if( TYPE(ffvsp[-1].Node)!= DOUBLE ) ffvsp[-1].Node= New_Unary( DOUBLE, 0, ffvsp[-1].Node);
+ if( ! (Test_Dims( ffvsp[-9].Node, ffvsp[-7].Node ) && Test_Dims( ffvsp[-7].Node, ffvsp[-5].Node ) &&
+ Test_Dims( ffvsp[-5].Node, ffvsp[-3].Node ) && Test_Dims( ffvsp[-3].Node, ffvsp[-1].Node )) ) {
+ fferror("Dimensions of CIRCLE arguments "
+ "are not compatible");
+ FFERROR;
+ } else {
+ if (FSTRCMP(ffvsp[-10].str,"CIRCLE(") == 0) {
+ ffval.Node = New_Func( BOOLEAN, circle_fct, 5, ffvsp[-9].Node, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node,
+ ffvsp[-1].Node, 0, 0 );
+ } else {
+ fferror("Boolean Function not supported");
+ FFERROR;
+ }
+ TEST(ffval.Node);
+ if( SIZE(ffval.Node)<SIZE(ffvsp[-9].Node) ) Copy_Dims(ffval.Node, ffvsp[-9].Node);
+ if( SIZE(ffvsp[-9].Node)<SIZE(ffvsp[-7].Node) ) Copy_Dims(ffval.Node, ffvsp[-7].Node);
+ if( SIZE(ffvsp[-7].Node)<SIZE(ffvsp[-5].Node) ) Copy_Dims(ffval.Node, ffvsp[-5].Node);
+ if( SIZE(ffvsp[-5].Node)<SIZE(ffvsp[-3].Node) ) Copy_Dims(ffval.Node, ffvsp[-3].Node);
+ if( SIZE(ffvsp[-3].Node)<SIZE(ffvsp[-1].Node) ) Copy_Dims(ffval.Node, ffvsp[-1].Node);
+ }
+ ;
+ break;}
+case 101:
+#line 982 "eval.y"
+{
+ if( TYPE(ffvsp[-13].Node) != DOUBLE ) ffvsp[-13].Node = New_Unary( DOUBLE, 0, ffvsp[-13].Node );
+ if( TYPE(ffvsp[-11].Node) != DOUBLE ) ffvsp[-11].Node = New_Unary( DOUBLE, 0, ffvsp[-11].Node );
+ if( TYPE(ffvsp[-9].Node) != DOUBLE ) ffvsp[-9].Node = New_Unary( DOUBLE, 0, ffvsp[-9].Node );
+ if( TYPE(ffvsp[-7].Node) != DOUBLE ) ffvsp[-7].Node = New_Unary( DOUBLE, 0, ffvsp[-7].Node );
+ if( TYPE(ffvsp[-5].Node)!= DOUBLE ) ffvsp[-5].Node= New_Unary( DOUBLE, 0, ffvsp[-5].Node);
+ if( TYPE(ffvsp[-3].Node)!= DOUBLE ) ffvsp[-3].Node= New_Unary( DOUBLE, 0, ffvsp[-3].Node);
+ if( TYPE(ffvsp[-1].Node)!= DOUBLE ) ffvsp[-1].Node= New_Unary( DOUBLE, 0, ffvsp[-1].Node);
+ if( ! (Test_Dims( ffvsp[-13].Node, ffvsp[-11].Node ) && Test_Dims( ffvsp[-11].Node, ffvsp[-9].Node ) &&
+ Test_Dims( ffvsp[-9].Node, ffvsp[-7].Node ) && Test_Dims( ffvsp[-7].Node, ffvsp[-5].Node ) &&
+ Test_Dims(ffvsp[-5].Node,ffvsp[-3].Node ) && Test_Dims(ffvsp[-3].Node, ffvsp[-1].Node ) ) ) {
+ fferror("Dimensions of BOX or ELLIPSE arguments "
+ "are not compatible");
+ FFERROR;
+ } else {
+ if (FSTRCMP(ffvsp[-14].str,"BOX(") == 0) {
+ ffval.Node = New_Func( BOOLEAN, box_fct, 7, ffvsp[-13].Node, ffvsp[-11].Node, ffvsp[-9].Node, ffvsp[-7].Node,
+ ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node );
+ } else if (FSTRCMP(ffvsp[-14].str,"ELLIPSE(") == 0) {
+ ffval.Node = New_Func( BOOLEAN, elps_fct, 7, ffvsp[-13].Node, ffvsp[-11].Node, ffvsp[-9].Node, ffvsp[-7].Node,
+ ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node );
+ } else {
+ fferror("SAO Image Function not supported");
+ FFERROR;
+ }
+ TEST(ffval.Node);
+ if( SIZE(ffval.Node)<SIZE(ffvsp[-13].Node) ) Copy_Dims(ffval.Node, ffvsp[-13].Node);
+ if( SIZE(ffvsp[-13].Node)<SIZE(ffvsp[-11].Node) ) Copy_Dims(ffval.Node, ffvsp[-11].Node);
+ if( SIZE(ffvsp[-11].Node)<SIZE(ffvsp[-9].Node) ) Copy_Dims(ffval.Node, ffvsp[-9].Node);
+ if( SIZE(ffvsp[-9].Node)<SIZE(ffvsp[-7].Node) ) Copy_Dims(ffval.Node, ffvsp[-7].Node);
+ if( SIZE(ffvsp[-7].Node)<SIZE(ffvsp[-5].Node) ) Copy_Dims(ffval.Node, ffvsp[-5].Node);
+ if( SIZE(ffvsp[-5].Node)<SIZE(ffvsp[-3].Node) ) Copy_Dims(ffval.Node, ffvsp[-3].Node);
+ if( SIZE(ffvsp[-3].Node)<SIZE(ffvsp[-1].Node) ) Copy_Dims(ffval.Node, ffvsp[-1].Node);
+ }
+ ;
+ break;}
+case 102:
+#line 1019 "eval.y"
+{ /* Use defaults for all elements */
+ ffval.Node = New_GTI( "", -99, "*START*", "*STOP*" );
+ TEST(ffval.Node); ;
+ break;}
+case 103:
+#line 1023 "eval.y"
+{ /* Use defaults for all except filename */
+ ffval.Node = New_GTI( ffvsp[-1].str, -99, "*START*", "*STOP*" );
+ TEST(ffval.Node); ;
+ break;}
+case 104:
+#line 1027 "eval.y"
+{ ffval.Node = New_GTI( ffvsp[-3].str, ffvsp[-1].Node, "*START*", "*STOP*" );
+ TEST(ffval.Node); ;
+ break;}
+case 105:
+#line 1030 "eval.y"
+{ ffval.Node = New_GTI( ffvsp[-7].str, ffvsp[-5].Node, ffvsp[-3].str, ffvsp[-1].str );
+ TEST(ffval.Node); ;
+ break;}
+case 106:
+#line 1034 "eval.y"
+{ /* Use defaults for all except filename */
+ ffval.Node = New_REG( ffvsp[-1].str, -99, -99, "" );
+ TEST(ffval.Node); ;
+ break;}
+case 107:
+#line 1038 "eval.y"
+{ ffval.Node = New_REG( ffvsp[-5].str, ffvsp[-3].Node, ffvsp[-1].Node, "" );
+ TEST(ffval.Node); ;
+ break;}
+case 108:
+#line 1041 "eval.y"
+{ ffval.Node = New_REG( ffvsp[-7].str, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].str );
+ TEST(ffval.Node); ;
+ break;}
+case 109:
+#line 1045 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-3].Node, 1, ffvsp[-1].Node, 0, 0, 0, 0 ); TEST(ffval.Node); ;
+ break;}
+case 110:
+#line 1047 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-5].Node, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0, 0 ); TEST(ffval.Node); ;
+ break;}
+case 111:
+#line 1049 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-7].Node, 3, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0, 0 ); TEST(ffval.Node); ;
+ break;}
+case 112:
+#line 1051 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-9].Node, 4, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node, 0 ); TEST(ffval.Node); ;
+ break;}
+case 113:
+#line 1053 "eval.y"
+{ ffval.Node = New_Deref( ffvsp[-11].Node, 5, ffvsp[-9].Node, ffvsp[-7].Node, ffvsp[-5].Node, ffvsp[-3].Node, ffvsp[-1].Node ); TEST(ffval.Node); ;
+ break;}
+case 114:
+#line 1055 "eval.y"
+{ ffval.Node = New_Unary( BOOLEAN, NOT, ffvsp[0].Node ); TEST(ffval.Node); ;
+ break;}
+case 115:
+#line 1057 "eval.y"
+{ ffval.Node = ffvsp[-1].Node; ;
+ break;}
+case 116:
+#line 1061 "eval.y"
+{ ffval.Node = New_Const( STRING, ffvsp[0].str, strlen(ffvsp[0].str)+1 ); TEST(ffval.Node);
+ SIZE(ffval.Node) = strlen(ffvsp[0].str); ;
+ break;}
+case 117:
+#line 1064 "eval.y"
+{ ffval.Node = New_Column( ffvsp[0].lng ); TEST(ffval.Node); ;
+ break;}
+case 118:
+#line 1066 "eval.y"
+{
+ if( TYPE(ffvsp[-1].Node) != LONG
+ || OPER(ffvsp[-1].Node) != CONST_OP ) {
+ fferror("Offset argument must be a constant integer");
+ FFERROR;
+ }
+ ffval.Node = New_Offset( ffvsp[-3].lng, ffvsp[-1].Node ); TEST(ffval.Node);
+ ;
+ break;}
+case 119:
+#line 1075 "eval.y"
+{ ffval.Node = New_Func( STRING, null_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); ;
+ break;}
+case 120:
+#line 1077 "eval.y"
+{ ffval.Node = ffvsp[-1].Node; ;
+ break;}
+case 121:
+#line 1079 "eval.y"
+{
+ if (SIZE(ffvsp[-2].Node)+SIZE(ffvsp[0].Node) >= MAX_STRLEN) {
+ fferror("Combined string size exceeds " MAX_STRLEN_S " characters");
+ FFERROR;
+ }
+ ffval.Node = New_BinOp( STRING, ffvsp[-2].Node, '+', ffvsp[0].Node ); TEST(ffval.Node);
+ SIZE(ffval.Node) = SIZE(ffvsp[-2].Node) + SIZE(ffvsp[0].Node);
+ ;
+ break;}
+case 122:
+#line 1088 "eval.y"
+{
+ int outSize;
+ if( SIZE(ffvsp[-4].Node)!=1 ) {
+ fferror("Cannot have a vector string column");
+ FFERROR;
+ }
+ /* Since the output can be calculated now, as a constant
+ scalar, we must precalculate the output size, in
+ order to avoid an overflow. */
+ outSize = SIZE(ffvsp[-2].Node);
+ if (SIZE(ffvsp[0].Node) > outSize) outSize = SIZE(ffvsp[0].Node);
+ ffval.Node = New_FuncSize( 0, ifthenelse_fct, 3, ffvsp[-2].Node, ffvsp[0].Node, ffvsp[-4].Node,
+ 0, 0, 0, 0, outSize);
+
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-2].Node)<SIZE(ffvsp[0].Node) ) Copy_Dims(ffval.Node, ffvsp[0].Node);
+ ;
+ break;}
+case 123:
+#line 1107 "eval.y"
+{
+ if (FSTRCMP(ffvsp[-4].str,"DEFNULL(") == 0) {
+ int outSize;
+ /* Since the output can be calculated now, as a constant
+ scalar, we must precalculate the output size, in
+ order to avoid an overflow. */
+ outSize = SIZE(ffvsp[-3].Node);
+ if (SIZE(ffvsp[-1].Node) > outSize) outSize = SIZE(ffvsp[-1].Node);
+
+ ffval.Node = New_FuncSize( 0, defnull_fct, 2, ffvsp[-3].Node, ffvsp[-1].Node, 0,
+ 0, 0, 0, 0, outSize );
+ TEST(ffval.Node);
+ if( SIZE(ffvsp[-1].Node)>SIZE(ffvsp[-3].Node) ) SIZE(ffval.Node) = SIZE(ffvsp[-1].Node);
+ } else {
+ fferror("Function(string,string) not supported");
+ FFERROR;
+ }
+ ;
+ break;}
+case 124:
+#line 1126 "eval.y"
+{
+ if (FSTRCMP(ffvsp[-6].str,"STRMID(") == 0) {
+ int len;
+ if( TYPE(ffvsp[-3].Node) != LONG || SIZE(ffvsp[-3].Node) != 1 ||
+ TYPE(ffvsp[-1].Node) != LONG || SIZE(ffvsp[-1].Node) != 1) {
+ fferror("When using STRMID(S,P,N), P and N must be integers (and not vector columns)");
+ FFERROR;
+ }
+ if (OPER(ffvsp[-1].Node) == CONST_OP) {
+ /* Constant value: use that directly */
+ len = (gParse.Nodes[ffvsp[-1].Node].value.data.lng);
+ } else {
+ /* Variable value: use the maximum possible (from $2) */
+ len = SIZE(ffvsp[-5].Node);
+ }
+ if (len <= 0 || len >= MAX_STRLEN) {
+ fferror("STRMID(S,P,N), N must be 1-" MAX_STRLEN_S);
+ FFERROR;
+ }
+ ffval.Node = New_FuncSize( 0, strmid_fct, 3, ffvsp[-5].Node, ffvsp[-3].Node,ffvsp[-1].Node,0,0,0,0,len);
+ TEST(ffval.Node);
+ } else {
+ fferror("Function(string,expr,expr) not supported");
+ FFERROR;
+ }
+ ;
+ break;}
+}
+ /* the action file gets copied in in place of this dollarsign */
+#line 498 "/usr1/local/share/bison.simple"
+
+ ffvsp -= fflen;
+ ffssp -= fflen;
+#ifdef FFLSP_NEEDED
+ fflsp -= fflen;
+#endif
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ {
+ short *ssp1 = ffss - 1;
+ fprintf (stderr, "state stack now");
+ while (ssp1 != ffssp)
+ fprintf (stderr, " %d", *++ssp1);
+ fprintf (stderr, "\n");
+ }
+#endif
+
+ *++ffvsp = ffval;
+
+#ifdef FFLSP_NEEDED
+ fflsp++;
+ if (fflen == 0)
+ {
+ fflsp->first_line = fflloc.first_line;
+ fflsp->first_column = fflloc.first_column;
+ fflsp->last_line = (fflsp-1)->last_line;
+ fflsp->last_column = (fflsp-1)->last_column;
+ fflsp->text = 0;
+ }
+ else
+ {
+ fflsp->last_line = (fflsp+fflen-1)->last_line;
+ fflsp->last_column = (fflsp+fflen-1)->last_column;
+ }
+#endif
+
+ /* Now "shift" the result of the reduction.
+ Determine what state that goes to,
+ based on the state we popped back to
+ and the rule number reduced by. */
+
+ ffn = ffr1[ffn];
+
+ ffstate = ffpgoto[ffn - FFNTBASE] + *ffssp;
+ if (ffstate >= 0 && ffstate <= FFLAST && ffcheck[ffstate] == *ffssp)
+ ffstate = fftable[ffstate];
+ else
+ ffstate = ffdefgoto[ffn - FFNTBASE];
+
+ goto ffnewstate;
+
+fferrlab: /* here on detecting error */
+
+ if (! fferrstatus)
+ /* If not already recovering from an error, report this error. */
+ {
+ ++ffnerrs;
+
+#ifdef FFERROR_VERBOSE
+ ffn = ffpact[ffstate];
+
+ if (ffn > FFFLAG && ffn < FFLAST)
+ {
+ int size = 0;
+ char *msg;
+ int x, count;
+
+ count = 0;
+ /* Start X at -ffn if nec to avoid negative indexes in ffcheck. */
+ for (x = (ffn < 0 ? -ffn : 0);
+ x < (sizeof(fftname) / sizeof(char *)); x++)
+ if (ffcheck[x + ffn] == x)
+ size += strlen(fftname[x]) + 15, count++;
+ msg = (char *) malloc(size + 15);
+ if (msg != 0)
+ {
+ strcpy(msg, "parse error");
+
+ if (count < 5)
+ {
+ count = 0;
+ for (x = (ffn < 0 ? -ffn : 0);
+ x < (sizeof(fftname) / sizeof(char *)); x++)
+ if (ffcheck[x + ffn] == x)
+ {
+ strcat(msg, count == 0 ? ", expecting `" : " or `");
+ strcat(msg, fftname[x]);
+ strcat(msg, "'");
+ count++;
+ }
+ }
+ fferror(msg);
+ free(msg);
+ }
+ else
+ fferror ("parse error; also virtual memory exceeded");
+ }
+ else
+#endif /* FFERROR_VERBOSE */
+ fferror("parse error");
+ }
+
+ goto fferrlab1;
+fferrlab1: /* here on error raised explicitly by an action */
+
+ if (fferrstatus == 3)
+ {
+ /* if just tried and failed to reuse lookahead token after an error, discard it. */
+
+ /* return failure if at end of input */
+ if (ffchar == FFEOF)
+ FFABORT;
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ fprintf(stderr, "Discarding token %d (%s).\n", ffchar, fftname[ffchar1]);
+#endif
+
+ ffchar = FFEMPTY;
+ }
+
+ /* Else will try to reuse lookahead token
+ after shifting the error token. */
+
+ fferrstatus = 3; /* Each real token shifted decrements this */
+
+ goto fferrhandle;
+
+fferrdefault: /* current state does not do anything special for the error token. */
+
+#if 0
+ /* This is wrong; only states that explicitly want error tokens
+ should shift them. */
+ ffn = ffdefact[ffstate]; /* If its default is to accept any token, ok. Otherwise pop it.*/
+ if (ffn) goto ffdefault;
+#endif
+
+fferrpop: /* pop the current state because it cannot handle the error token */
+
+ if (ffssp == ffss) FFABORT;
+ ffvsp--;
+ ffstate = *--ffssp;
+#ifdef FFLSP_NEEDED
+ fflsp--;
+#endif
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ {
+ short *ssp1 = ffss - 1;
+ fprintf (stderr, "Error: state stack now");
+ while (ssp1 != ffssp)
+ fprintf (stderr, " %d", *++ssp1);
+ fprintf (stderr, "\n");
+ }
+#endif
+
+fferrhandle:
+
+ ffn = ffpact[ffstate];
+ if (ffn == FFFLAG)
+ goto fferrdefault;
+
+ ffn += FFTERROR;
+ if (ffn < 0 || ffn > FFLAST || ffcheck[ffn] != FFTERROR)
+ goto fferrdefault;
+
+ ffn = fftable[ffn];
+ if (ffn < 0)
+ {
+ if (ffn == FFFLAG)
+ goto fferrpop;
+ ffn = -ffn;
+ goto ffreduce;
+ }
+ else if (ffn == 0)
+ goto fferrpop;
+
+ if (ffn == FFFINAL)
+ FFACCEPT;
+
+#if FFDEBUG != 0
+ if (ffdebug)
+ fprintf(stderr, "Shifting error token, ");
+#endif
+
+ *++ffvsp = fflval;
+#ifdef FFLSP_NEEDED
+ *++fflsp = fflloc;
+#endif
+
+ ffstate = ffn;
+ goto ffnewstate;
+}
+#line 1155 "eval.y"
+
+
+/*************************************************************************/
+/* Start of "New" routines which build the expression Nodal structure */
+/*************************************************************************/
+
+static int Alloc_Node( void )
+{
+ /* Use this for allocation to guarantee *Nodes */
+ Node *newNodePtr; /* survives on failure, making it still valid */
+ /* while working our way out of this error */
+
+ if( gParse.nNodes == gParse.nNodesAlloc ) {
+ if( gParse.Nodes ) {
+ gParse.nNodesAlloc += gParse.nNodesAlloc;
+ newNodePtr = (Node *)realloc( gParse.Nodes,
+ sizeof(Node)*gParse.nNodesAlloc );
+ } else {
+ gParse.nNodesAlloc = 100;
+ newNodePtr = (Node *)malloc ( sizeof(Node)*gParse.nNodesAlloc );
+ }
+
+ if( newNodePtr ) {
+ gParse.Nodes = newNodePtr;
+ } else {
+ gParse.status = MEMORY_ALLOCATION;
+ return( -1 );
+ }
+ }
+
+ return ( gParse.nNodes++ );
+}
+
+static void Free_Last_Node( void )
+{
+ if( gParse.nNodes ) gParse.nNodes--;
+}
+
+static int New_Const( int returnType, void *value, long len )
+{
+ Node *this;
+ int n;
+
+ n = Alloc_Node();
+ if( n>=0 ) {
+ this = gParse.Nodes + n;
+ this->operation = CONST_OP; /* Flag a constant */
+ this->DoOp = NULL;
+ this->nSubNodes = 0;
+ this->type = returnType;
+ memcpy( &(this->value.data), value, len );
+ this->value.undef = NULL;
+ this->value.nelem = 1;
+ this->value.naxis = 1;
+ this->value.naxes[0] = 1;
+ }
+ return(n);
+}
+
+static int New_Column( int ColNum )
+{
+ Node *this;
+ int n, i;
+
+ n = Alloc_Node();
+ if( n>=0 ) {
+ this = gParse.Nodes + n;
+ this->operation = -ColNum;
+ this->DoOp = NULL;
+ this->nSubNodes = 0;
+ this->type = gParse.varData[ColNum].type;
+ this->value.nelem = gParse.varData[ColNum].nelem;
+ this->value.naxis = gParse.varData[ColNum].naxis;
+ for( i=0; i<gParse.varData[ColNum].naxis; i++ )
+ this->value.naxes[i] = gParse.varData[ColNum].naxes[i];
+ }
+ return(n);
+}
+
+static int New_Offset( int ColNum, int offsetNode )
+{
+ Node *this;
+ int n, i, colNode;
+
+ colNode = New_Column( ColNum );
+ if( colNode<0 ) return(-1);
+
+ n = Alloc_Node();
+ if( n>=0 ) {
+ this = gParse.Nodes + n;
+ this->operation = '{';
+ this->DoOp = Do_Offset;
+ this->nSubNodes = 2;
+ this->SubNodes[0] = colNode;
+ this->SubNodes[1] = offsetNode;
+ this->type = gParse.varData[ColNum].type;
+ this->value.nelem = gParse.varData[ColNum].nelem;
+ this->value.naxis = gParse.varData[ColNum].naxis;
+ for( i=0; i<gParse.varData[ColNum].naxis; i++ )
+ this->value.naxes[i] = gParse.varData[ColNum].naxes[i];
+ }
+ return(n);
+}
+
+static int New_Unary( int returnType, int Op, int Node1 )
+{
+ Node *this, *that;
+ int i,n;
+
+ if( Node1<0 ) return(-1);
+ that = gParse.Nodes + Node1;
+
+ if( !Op ) Op = returnType;
+
+ if( (Op==DOUBLE || Op==FLTCAST) && that->type==DOUBLE ) return( Node1 );
+ if( (Op==LONG || Op==INTCAST) && that->type==LONG ) return( Node1 );
+ if( (Op==BOOLEAN ) && that->type==BOOLEAN ) return( Node1 );
+
+ n = Alloc_Node();
+ if( n>=0 ) {
+ this = gParse.Nodes + n;
+ this->operation = Op;
+ this->DoOp = Do_Unary;
+ this->nSubNodes = 1;
+ this->SubNodes[0] = Node1;
+ this->type = returnType;
+
+ that = gParse.Nodes + Node1; /* Reset in case .Nodes mv'd */
+ this->value.nelem = that->value.nelem;
+ this->value.naxis = that->value.naxis;
+ for( i=0; i<that->value.naxis; i++ )
+ this->value.naxes[i] = that->value.naxes[i];
+
+ if( that->operation==CONST_OP ) this->DoOp( this );
+ }
+ return( n );
+}
+
+static int New_BinOp( int returnType, int Node1, int Op, int Node2 )
+{
+ Node *this,*that1,*that2;
+ int n,i,constant;
+
+ if( Node1<0 || Node2<0 ) return(-1);
+
+ n = Alloc_Node();
+ if( n>=0 ) {
+ this = gParse.Nodes + n;
+ this->operation = Op;
+ this->nSubNodes = 2;
+ this->SubNodes[0]= Node1;
+ this->SubNodes[1]= Node2;
+ this->type = returnType;
+
+ that1 = gParse.Nodes + Node1;
+ that2 = gParse.Nodes + Node2;
+ constant = (that1->operation==CONST_OP
+ && that2->operation==CONST_OP);
+ if( that1->type!=STRING && that1->type!=BITSTR )
+ if( !Test_Dims( Node1, Node2 ) ) {
+ Free_Last_Node();
+ fferror("Array sizes/dims do not match for binary operator");
+ return(-1);
+ }
+ if( that1->value.nelem == 1 ) that1 = that2;
+
+ this->value.nelem = that1->value.nelem;
+ this->value.naxis = that1->value.naxis;
+ for( i=0; i<that1->value.naxis; i++ )
+ this->value.naxes[i] = that1->value.naxes[i];
+
+ if ( Op == ACCUM && that1->type == BITSTR ) {
+ /* ACCUM is rank-reducing on bit strings */
+ this->value.nelem = 1;
+ this->value.naxis = 1;
+ this->value.naxes[0] = 1;
+ }
+
+ /* Both subnodes should be of same time */
+ switch( that1->type ) {
+ case BITSTR: this->DoOp = Do_BinOp_bit; break;
+ case STRING: this->DoOp = Do_BinOp_str; break;
+ case BOOLEAN: this->DoOp = Do_BinOp_log; break;
+ case LONG: this->DoOp = Do_BinOp_lng; break;
+ case DOUBLE: this->DoOp = Do_BinOp_dbl; break;
+ }
+ if( constant ) this->DoOp( this );
+ }
+ return( n );
+}
+
+static int New_Func( int returnType, funcOp Op, int nNodes,
+ int Node1, int Node2, int Node3, int Node4,
+ int Node5, int Node6, int Node7 )
+{
+ return New_FuncSize(returnType, Op, nNodes,
+ Node1, Node2, Node3, Node4,
+ Node5, Node6, Node7, 0);
+}
+
+static int New_FuncSize( int returnType, funcOp Op, int nNodes,
+ int Node1, int Node2, int Node3, int Node4,
+ int Node5, int Node6, int Node7, int Size )
+/* If returnType==0 , use Node1's type and vector sizes as returnType, */
+/* else return a single value of type returnType */
+{
+ Node *this, *that;
+ int i,n,constant;
+
+ if( Node1<0 || Node2<0 || Node3<0 || Node4<0 ||
+ Node5<0 || Node6<0 || Node7<0 ) return(-1);
+
+ n = Alloc_Node();
+ if( n>=0 ) {
+ this = gParse.Nodes + n;
+ this->operation = (int)Op;
+ this->DoOp = Do_Func;
+ this->nSubNodes = nNodes;
+ this->SubNodes[0] = Node1;
+ this->SubNodes[1] = Node2;
+ this->SubNodes[2] = Node3;
+ this->SubNodes[3] = Node4;
+ this->SubNodes[4] = Node5;
+ this->SubNodes[5] = Node6;
+ this->SubNodes[6] = Node7;
+ i = constant = nNodes; /* Functions with zero params are not const */
+ if (Op == poirnd_fct) constant = 0; /* Nor is Poisson deviate */
+
+ while( i-- )
+ constant = ( constant && OPER(this->SubNodes[i]) == CONST_OP );
+
+ if( returnType ) {
+ this->type = returnType;
+ this->value.nelem = 1;
+ this->value.naxis = 1;
+ this->value.naxes[0] = 1;
+ } else {
+ that = gParse.Nodes + Node1;
+ this->type = that->type;
+ this->value.nelem = that->value.nelem;
+ this->value.naxis = that->value.naxis;
+ for( i=0; i<that->value.naxis; i++ )
+ this->value.naxes[i] = that->value.naxes[i];
+ }
+ /* Force explicit size before evaluating */
+ if (Size > 0) this->value.nelem = Size;
+
+ if( constant ) this->DoOp( this );
+ }
+ return( n );
+}
+
+static int New_Deref( int Var, int nDim,
+ int Dim1, int Dim2, int Dim3, int Dim4, int Dim5 )
+{
+ int n, idx, constant;
+ long elem=0;
+ Node *this, *theVar, *theDim[MAXDIMS];
+
+ if( Var<0 || Dim1<0 || Dim2<0 || Dim3<0 || Dim4<0 || Dim5<0 ) return(-1);
+
+ theVar = gParse.Nodes + Var;
+ if( theVar->operation==CONST_OP || theVar->value.nelem==1 ) {
+ fferror("Cannot index a scalar value");
+ return(-1);
+ }
+
+ n = Alloc_Node();
+ if( n>=0 ) {
+ this = gParse.Nodes + n;
+ this->nSubNodes = nDim+1;
+ theVar = gParse.Nodes + (this->SubNodes[0]=Var);
+ theDim[0] = gParse.Nodes + (this->SubNodes[1]=Dim1);
+ theDim[1] = gParse.Nodes + (this->SubNodes[2]=Dim2);
+ theDim[2] = gParse.Nodes + (this->SubNodes[3]=Dim3);
+ theDim[3] = gParse.Nodes + (this->SubNodes[4]=Dim4);
+ theDim[4] = gParse.Nodes + (this->SubNodes[5]=Dim5);
+ constant = theVar->operation==CONST_OP;
+ for( idx=0; idx<nDim; idx++ )
+ constant = (constant && theDim[idx]->operation==CONST_OP);
+
+ for( idx=0; idx<nDim; idx++ )
+ if( theDim[idx]->value.nelem>1 ) {
+ Free_Last_Node();
+ fferror("Cannot use an array as an index value");
+ return(-1);
+ } else if( theDim[idx]->type!=LONG ) {
+ Free_Last_Node();
+ fferror("Index value must be an integer type");
+ return(-1);
+ }
+
+ this->operation = '[';
+ this->DoOp = Do_Deref;
+ this->type = theVar->type;
+
+ if( theVar->value.naxis == nDim ) { /* All dimensions specified */
+ this->value.nelem = 1;
+ this->value.naxis = 1;
+ this->value.naxes[0] = 1;
+ } else if( nDim==1 ) { /* Dereference only one dimension */
+ elem=1;
+ this->value.naxis = theVar->value.naxis-1;
+ for( idx=0; idx<this->value.naxis; idx++ ) {
+ elem *= ( this->value.naxes[idx] = theVar->value.naxes[idx] );
+ }
+ this->value.nelem = elem;
+ } else {
+ Free_Last_Node();
+ fferror("Must specify just one or all indices for vector");
+ return(-1);
+ }
+ if( constant ) this->DoOp( this );
+ }
+ return(n);
+}
+
+extern int ffGetVariable( char *varName, FFSTYPE *varVal );
+
+static int New_GTI( char *fname, int Node1, char *start, char *stop )
+{
+ fitsfile *fptr;
+ Node *this, *that0, *that1;
+ int type,i,n, startCol, stopCol, Node0;
+ int hdutype, hdunum, evthdu, samefile, extvers, movetotype, tstat;
+ char extname[100];
+ long nrows;
+ double timeZeroI[2], timeZeroF[2], dt, timeSpan;
+ char xcol[20], xexpr[20];
+ FFSTYPE colVal;
+
+ if( Node1==-99 ) {
+ type = ffGetVariable( "TIME", &colVal );
+ if( type==COLUMN ) {
+ Node1 = New_Column( (int)colVal.lng );
+ } else {
+ fferror("Could not build TIME column for GTIFILTER");
+ return(-1);
+ }
+ }
+ Node1 = New_Unary( DOUBLE, 0, Node1 );
+ Node0 = Alloc_Node(); /* This will hold the START/STOP times */
+ if( Node1<0 || Node0<0 ) return(-1);
+
+ /* Record current HDU number in case we need to move within this file */
+
+ fptr = gParse.def_fptr;
+ ffghdn( fptr, &evthdu );
+
+ /* Look for TIMEZERO keywords in current extension */
+
+ tstat = 0;
+ if( ffgkyd( fptr, "TIMEZERO", timeZeroI, NULL, &tstat ) ) {
+ tstat = 0;
+ if( ffgkyd( fptr, "TIMEZERI", timeZeroI, NULL, &tstat ) ) {
+ timeZeroI[0] = timeZeroF[0] = 0.0;
+ } else if( ffgkyd( fptr, "TIMEZERF", timeZeroF, NULL, &tstat ) ) {
+ timeZeroF[0] = 0.0;
+ }
+ } else {
+ timeZeroF[0] = 0.0;
+ }
+
+ /* Resolve filename parameter */
+
+ switch( fname[0] ) {
+ case '\0':
+ samefile = 1;
+ hdunum = 1;
+ break;
+ case '[':
+ samefile = 1;
+ i = 1;
+ while( fname[i] != '\0' && fname[i] != ']' ) i++;
+ if( fname[i] ) {
+ fname[i] = '\0';
+ fname++;
+ ffexts( fname, &hdunum, extname, &extvers, &movetotype,
+ xcol, xexpr, &gParse.status );
+ if( *extname ) {
+ ffmnhd( fptr, movetotype, extname, extvers, &gParse.status );
+ ffghdn( fptr, &hdunum );
+ } else if( hdunum ) {
+ ffmahd( fptr, ++hdunum, &hdutype, &gParse.status );
+ } else if( !gParse.status ) {
+ fferror("Cannot use primary array for GTI filter");
+ return( -1 );
+ }
+ } else {
+ fferror("File extension specifier lacks closing ']'");
+ return( -1 );
+ }
+ break;
+ case '+':
+ samefile = 1;
+ hdunum = atoi( fname ) + 1;
+ if( hdunum>1 )
+ ffmahd( fptr, hdunum, &hdutype, &gParse.status );
+ else {
+ fferror("Cannot use primary array for GTI filter");
+ return( -1 );
+ }
+ break;
+ default:
+ samefile = 0;
+ if( ! ffopen( &fptr, fname, READONLY, &gParse.status ) )
+ ffghdn( fptr, &hdunum );
+ break;
+ }
+ if( gParse.status ) return(-1);
+
+ /* If at primary, search for GTI extension */
+
+ if( hdunum==1 ) {
+ while( 1 ) {
+ hdunum++;
+ if( ffmahd( fptr, hdunum, &hdutype, &gParse.status ) ) break;
+ if( hdutype==IMAGE_HDU ) continue;
+ tstat = 0;
+ if( ffgkys( fptr, "EXTNAME", extname, NULL, &tstat ) ) continue;
+ ffupch( extname );
+ if( strstr( extname, "GTI" ) ) break;
+ }
+ if( gParse.status ) {
+ if( gParse.status==END_OF_FILE )
+ fferror("GTI extension not found in this file");
+ return(-1);
+ }
+ }
+
+ /* Locate START/STOP Columns */
+
+ ffgcno( fptr, CASEINSEN, start, &startCol, &gParse.status );
+ ffgcno( fptr, CASEINSEN, stop, &stopCol, &gParse.status );
+ if( gParse.status ) return(-1);
+
+ /* Look for TIMEZERO keywords in GTI extension */
+
+ tstat = 0;
+ if( ffgkyd( fptr, "TIMEZERO", timeZeroI+1, NULL, &tstat ) ) {
+ tstat = 0;
+ if( ffgkyd( fptr, "TIMEZERI", timeZeroI+1, NULL, &tstat ) ) {
+ timeZeroI[1] = timeZeroF[1] = 0.0;
+ } else if( ffgkyd( fptr, "TIMEZERF", timeZeroF+1, NULL, &tstat ) ) {
+ timeZeroF[1] = 0.0;
+ }
+ } else {
+ timeZeroF[1] = 0.0;
+ }
+
+ n = Alloc_Node();
+ if( n >= 0 ) {
+ this = gParse.Nodes + n;
+ this->nSubNodes = 2;
+ this->SubNodes[1] = Node1;
+ this->operation = (int)gtifilt_fct;
+ this->DoOp = Do_GTI;
+ this->type = BOOLEAN;
+ that1 = gParse.Nodes + Node1;
+ this->value.nelem = that1->value.nelem;
+ this->value.naxis = that1->value.naxis;
+ for( i=0; i < that1->value.naxis; i++ )
+ this->value.naxes[i] = that1->value.naxes[i];
+
+ /* Init START/STOP node to be treated as a "constant" */
+
+ this->SubNodes[0] = Node0;
+ that0 = gParse.Nodes + Node0;
+ that0->operation = CONST_OP;
+ that0->DoOp = NULL;
+ that0->value.data.ptr= NULL;
+
+ /* Read in START/STOP times */
+
+ if( ffgkyj( fptr, "NAXIS2", &nrows, NULL, &gParse.status ) )
+ return(-1);
+ that0->value.nelem = nrows;
+ if( nrows ) {
+
+ that0->value.data.dblptr = (double*)malloc( 2*nrows*sizeof(double) );
+ if( !that0->value.data.dblptr ) {
+ gParse.status = MEMORY_ALLOCATION;
+ return(-1);
+ }
+
+ ffgcvd( fptr, startCol, 1L, 1L, nrows, 0.0,
+ that0->value.data.dblptr, &i, &gParse.status );
+ ffgcvd( fptr, stopCol, 1L, 1L, nrows, 0.0,
+ that0->value.data.dblptr+nrows, &i, &gParse.status );
+ if( gParse.status ) {
+ free( that0->value.data.dblptr );
+ return(-1);
+ }
+
+ /* Test for fully time-ordered GTI... both START && STOP */
+
+ that0->type = 1; /* Assume yes */
+ i = nrows;
+ while( --i )
+ if( that0->value.data.dblptr[i-1]
+ >= that0->value.data.dblptr[i]
+ || that0->value.data.dblptr[i-1+nrows]
+ >= that0->value.data.dblptr[i+nrows] ) {
+ that0->type = 0;
+ break;
+ }
+
+ /* Handle TIMEZERO offset, if any */
+
+ dt = (timeZeroI[1] - timeZeroI[0]) + (timeZeroF[1] - timeZeroF[0]);
+ timeSpan = that0->value.data.dblptr[nrows+nrows-1]
+ - that0->value.data.dblptr[0];
+
+ if( fabs( dt / timeSpan ) > 1e-12 ) {
+ for( i=0; i<(nrows+nrows); i++ )
+ that0->value.data.dblptr[i] += dt;
+ }
+ }
+ if( OPER(Node1)==CONST_OP )
+ this->DoOp( this );
+ }
+
+ if( samefile )
+ ffmahd( fptr, evthdu, &hdutype, &gParse.status );
+ else
+ ffclos( fptr, &gParse.status );
+
+ return( n );
+}
+
+static int New_REG( char *fname, int NodeX, int NodeY, char *colNames )
+{
+ Node *this, *that0;
+ int type, n, Node0;
+ int Xcol, Ycol, tstat;
+ WCSdata wcs;
+ SAORegion *Rgn;
+ char *cX, *cY;
+ FFSTYPE colVal;
+
+ if( NodeX==-99 ) {
+ type = ffGetVariable( "X", &colVal );
+ if( type==COLUMN ) {
+ NodeX = New_Column( (int)colVal.lng );
+ } else {
+ fferror("Could not build X column for REGFILTER");
+ return(-1);
+ }
+ }
+ if( NodeY==-99 ) {
+ type = ffGetVariable( "Y", &colVal );
+ if( type==COLUMN ) {
+ NodeY = New_Column( (int)colVal.lng );
+ } else {
+ fferror("Could not build Y column for REGFILTER");
+ return(-1);
+ }
+ }
+ NodeX = New_Unary( DOUBLE, 0, NodeX );
+ NodeY = New_Unary( DOUBLE, 0, NodeY );
+ Node0 = Alloc_Node(); /* This will hold the Region Data */
+ if( NodeX<0 || NodeY<0 || Node0<0 ) return(-1);
+
+ if( ! (Test_Dims( NodeX, NodeY ) ) ) {
+ fferror("Dimensions of REGFILTER arguments are not compatible");
+ return (-1);
+ }
+
+ n = Alloc_Node();
+ if( n >= 0 ) {
+ this = gParse.Nodes + n;
+ this->nSubNodes = 3;
+ this->SubNodes[0] = Node0;
+ this->SubNodes[1] = NodeX;
+ this->SubNodes[2] = NodeY;
+ this->operation = (int)regfilt_fct;
+ this->DoOp = Do_REG;
+ this->type = BOOLEAN;
+ this->value.nelem = 1;
+ this->value.naxis = 1;
+ this->value.naxes[0] = 1;
+
+ Copy_Dims(n, NodeX);
+ if( SIZE(NodeX)<SIZE(NodeY) ) Copy_Dims(n, NodeY);
+
+ /* Init Region node to be treated as a "constant" */
+
+ that0 = gParse.Nodes + Node0;
+ that0->operation = CONST_OP;
+ that0->DoOp = NULL;
+
+ /* Identify what columns to use for WCS information */
+
+ Xcol = Ycol = 0;
+ if( *colNames ) {
+ /* Use the column names in this string for WCS info */
+ while( *colNames==' ' ) colNames++;
+ cX = cY = colNames;
+ while( *cY && *cY!=' ' && *cY!=',' ) cY++;
+ if( *cY )
+ *(cY++) = '\0';
+ while( *cY==' ' ) cY++;
+ if( !*cY ) {
+ fferror("Could not extract valid pair of column names from REGFILTER");
+ Free_Last_Node();
+ return( -1 );
+ }
+ fits_get_colnum( gParse.def_fptr, CASEINSEN, cX, &Xcol,
+ &gParse.status );
+ fits_get_colnum( gParse.def_fptr, CASEINSEN, cY, &Ycol,
+ &gParse.status );
+ if( gParse.status ) {
+ fferror("Could not locate columns indicated for WCS info");
+ Free_Last_Node();
+ return( -1 );
+ }
+
+ } else {
+ /* Try to find columns used in X/Y expressions */
+ Xcol = Locate_Col( gParse.Nodes + NodeX );
+ Ycol = Locate_Col( gParse.Nodes + NodeY );
+ if( Xcol<0 || Ycol<0 ) {
+ fferror("Found multiple X/Y column references in REGFILTER");
+ Free_Last_Node();
+ return( -1 );
+ }
+ }
+
+ /* Now, get the WCS info, if it exists, from the indicated columns */
+ wcs.exists = 0;
+ if( Xcol>0 && Ycol>0 ) {
+ tstat = 0;
+ ffgtcs( gParse.def_fptr, Xcol, Ycol,
+ &wcs.xrefval, &wcs.yrefval,
+ &wcs.xrefpix, &wcs.yrefpix,
+ &wcs.xinc, &wcs.yinc,
+ &wcs.rot, wcs.type,
+ &tstat );
+ if( tstat==NO_WCS_KEY ) {
+ wcs.exists = 0;
+ } else if( tstat ) {
+ gParse.status = tstat;
+ Free_Last_Node();
+ return( -1 );
+ } else {
+ wcs.exists = 1;
+ }
+ }
+
+ /* Read in Region file */
+
+ fits_read_rgnfile( fname, &wcs, &Rgn, &gParse.status );
+ if( gParse.status ) {
+ Free_Last_Node();
+ return( -1 );
+ }
+
+ that0->value.data.ptr = Rgn;
+
+ if( OPER(NodeX)==CONST_OP && OPER(NodeY)==CONST_OP )
+ this->DoOp( this );
+ }
+
+ return( n );
+}
+
+static int New_Vector( int subNode )
+{
+ Node *this, *that;
+ int n;
+
+ n = Alloc_Node();
+ if( n >= 0 ) {
+ this = gParse.Nodes + n;
+ that = gParse.Nodes + subNode;
+ this->type = that->type;
+ this->nSubNodes = 1;
+ this->SubNodes[0] = subNode;
+ this->operation = '{';
+ this->DoOp = Do_Vector;
+ }
+
+ return( n );
+}
+
+static int Close_Vec( int vecNode )
+{
+ Node *this;
+ int n, nelem=0;
+
+ this = gParse.Nodes + vecNode;
+ for( n=0; n < this->nSubNodes; n++ ) {
+ if( TYPE( this->SubNodes[n] ) != this->type ) {
+ this->SubNodes[n] = New_Unary( this->type, 0, this->SubNodes[n] );
+ if( this->SubNodes[n]<0 ) return(-1);
+ }
+ nelem += SIZE(this->SubNodes[n]);
+ }
+ this->value.naxis = 1;
+ this->value.nelem = nelem;
+ this->value.naxes[0] = nelem;
+
+ return( vecNode );
+}
+
+static int Locate_Col( Node *this )
+/* Locate the TABLE column number of any columns in "this" calculation. */
+/* Return ZERO if none found, or negative if more than 1 found. */
+{
+ Node *that;
+ int i, col=0, newCol, nfound=0;
+
+ if( this->nSubNodes==0
+ && this->operation<=0 && this->operation!=CONST_OP )
+ return gParse.colData[ - this->operation].colnum;
+
+ for( i=0; i<this->nSubNodes; i++ ) {
+ that = gParse.Nodes + this->SubNodes[i];
+ if( that->operation>0 ) {
+ newCol = Locate_Col( that );
+ if( newCol<=0 ) {
+ nfound += -newCol;
+ } else {
+ if( !nfound ) {
+ col = newCol;
+ nfound++;
+ } else if( col != newCol ) {
+ nfound++;
+ }
+ }
+ } else if( that->operation!=CONST_OP ) {
+ /* Found a Column */
+ newCol = gParse.colData[- that->operation].colnum;
+ if( !nfound ) {
+ col = newCol;
+ nfound++;
+ } else if( col != newCol ) {
+ nfound++;
+ }
+ }
+ }
+ if( nfound!=1 )
+ return( - nfound );
+ else
+ return( col );
+}
+
+static int Test_Dims( int Node1, int Node2 )
+{
+ Node *that1, *that2;
+ int valid, i;
+
+ if( Node1<0 || Node2<0 ) return(0);
+
+ that1 = gParse.Nodes + Node1;
+ that2 = gParse.Nodes + Node2;
+
+ if( that1->value.nelem==1 || that2->value.nelem==1 )
+ valid = 1;
+ else if( that1->type==that2->type
+ && that1->value.nelem==that2->value.nelem
+ && that1->value.naxis==that2->value.naxis ) {
+ valid = 1;
+ for( i=0; i<that1->value.naxis; i++ ) {
+ if( that1->value.naxes[i]!=that2->value.naxes[i] )
+ valid = 0;
+ }
+ } else
+ valid = 0;
+ return( valid );
+}
+
+static void Copy_Dims( int Node1, int Node2 )
+{
+ Node *that1, *that2;
+ int i;
+
+ if( Node1<0 || Node2<0 ) return;
+
+ that1 = gParse.Nodes + Node1;
+ that2 = gParse.Nodes + Node2;
+
+ that1->value.nelem = that2->value.nelem;
+ that1->value.naxis = that2->value.naxis;
+ for( i=0; i<that2->value.naxis; i++ )
+ that1->value.naxes[i] = that2->value.naxes[i];
+}
+
+/********************************************************************/
+/* Routines for actually evaluating the expression start here */
+/********************************************************************/
+
+void Evaluate_Parser( long firstRow, long nRows )
+ /***********************************************************************/
+ /* Reset the parser for processing another batch of data... */
+ /* firstRow: Row number of the first element to evaluate */
+ /* nRows: Number of rows to be processed */
+ /* Initialize each COLUMN node so that its UNDEF and DATA pointers */
+ /* point to the appropriate column arrays. */
+ /* Finally, call Evaluate_Node for final node. */
+ /***********************************************************************/
+{
+ int i, column;
+ long offset, rowOffset;
+
+ gParse.firstRow = firstRow;
+ gParse.nRows = nRows;
+
+ /* Reset Column Nodes' pointers to point to right data and UNDEF arrays */
+
+ rowOffset = firstRow - gParse.firstDataRow;
+ for( i=0; i<gParse.nNodes; i++ ) {
+ if( OPER(i) > 0 || OPER(i) == CONST_OP ) continue;
+
+ column = -OPER(i);
+ offset = gParse.varData[column].nelem * rowOffset;
+
+ gParse.Nodes[i].value.undef = gParse.varData[column].undef + offset;
+
+ switch( gParse.Nodes[i].type ) {
+ case BITSTR:
+ gParse.Nodes[i].value.data.strptr =
+ (char**)gParse.varData[column].data + rowOffset;
+ gParse.Nodes[i].value.undef = NULL;
+ break;
+ case STRING:
+ gParse.Nodes[i].value.data.strptr =
+ (char**)gParse.varData[column].data + rowOffset;
+ gParse.Nodes[i].value.undef = gParse.varData[column].undef + rowOffset;
+ break;
+ case BOOLEAN:
+ gParse.Nodes[i].value.data.logptr =
+ (char*)gParse.varData[column].data + offset;
+ break;
+ case LONG:
+ gParse.Nodes[i].value.data.lngptr =
+ (long*)gParse.varData[column].data + offset;
+ break;
+ case DOUBLE:
+ gParse.Nodes[i].value.data.dblptr =
+ (double*)gParse.varData[column].data + offset;
+ break;
+ }
+ }
+
+ Evaluate_Node( gParse.resultNode );
+}
+
+static void Evaluate_Node( int thisNode )
+ /**********************************************************************/
+ /* Recursively evaluate thisNode's subNodes, then call one of the */
+ /* Do_<Action> functions pointed to by thisNode's DoOp element. */
+ /**********************************************************************/
+{
+ Node *this;
+ int i;
+
+ if( gParse.status ) return;
+
+ this = gParse.Nodes + thisNode;
+ if( this->operation>0 ) { /* <=0 indicate constants and columns */
+ i = this->nSubNodes;
+ while( i-- ) {
+ Evaluate_Node( this->SubNodes[i] );
+ if( gParse.status ) return;
+ }
+ this->DoOp( this );
+ }
+}
+
+static void Allocate_Ptrs( Node *this )
+{
+ long elem, row, size;
+
+ if( this->type==BITSTR || this->type==STRING ) {
+
+ this->value.data.strptr = (char**)malloc( gParse.nRows
+ * sizeof(char*) );
+ if( this->value.data.strptr ) {
+ this->value.data.strptr[0] = (char*)malloc( gParse.nRows
+ * (this->value.nelem+2)
+ * sizeof(char) );
+ if( this->value.data.strptr[0] ) {
+ row = 0;
+ while( (++row)<gParse.nRows ) {
+ this->value.data.strptr[row] =
+ this->value.data.strptr[row-1] + this->value.nelem+1;
+ }
+ if( this->type==STRING ) {
+ this->value.undef = this->value.data.strptr[row-1]
+ + this->value.nelem+1;
+ } else {
+ this->value.undef = NULL; /* BITSTRs don't use undef array */
+ }
+ } else {
+ gParse.status = MEMORY_ALLOCATION;
+ free( this->value.data.strptr );
+ }
+ } else {
+ gParse.status = MEMORY_ALLOCATION;
+ }
+
+ } else {
+
+ elem = this->value.nelem * gParse.nRows;
+ switch( this->type ) {
+ case DOUBLE: size = sizeof( double ); break;
+ case LONG: size = sizeof( long ); break;
+ case BOOLEAN: size = sizeof( char ); break;
+ default: size = 1; break;
+ }
+
+ this->value.data.ptr = calloc(size+1, elem);
+
+ if( this->value.data.ptr==NULL ) {
+ gParse.status = MEMORY_ALLOCATION;
+ } else {
+ this->value.undef = (char *)this->value.data.ptr + elem*size;
+ }
+ }
+}
+
+static void Do_Unary( Node *this )
+{
+ Node *that;
+ long elem;
+
+ that = gParse.Nodes + this->SubNodes[0];
+
+ if( that->operation==CONST_OP ) { /* Operating on a constant! */
+ switch( this->operation ) {
+ case DOUBLE:
+ case FLTCAST:
+ if( that->type==LONG )
+ this->value.data.dbl = (double)that->value.data.lng;
+ else if( that->type==BOOLEAN )
+ this->value.data.dbl = ( that->value.data.log ? 1.0 : 0.0 );
+ break;
+ case LONG:
+ case INTCAST:
+ if( that->type==DOUBLE )
+ this->value.data.lng = (long)that->value.data.dbl;
+ else if( that->type==BOOLEAN )
+ this->value.data.lng = ( that->value.data.log ? 1L : 0L );
+ break;
+ case BOOLEAN:
+ if( that->type==DOUBLE )
+ this->value.data.log = ( that->value.data.dbl != 0.0 );
+ else if( that->type==LONG )
+ this->value.data.log = ( that->value.data.lng != 0L );
+ break;
+ case UMINUS:
+ if( that->type==DOUBLE )
+ this->value.data.dbl = - that->value.data.dbl;
+ else if( that->type==LONG )
+ this->value.data.lng = - that->value.data.lng;
+ break;
+ case NOT:
+ if( that->type==BOOLEAN )
+ this->value.data.log = ( ! that->value.data.log );
+ else if( that->type==BITSTR )
+ bitnot( this->value.data.str, that->value.data.str );
+ break;
+ }
+ this->operation = CONST_OP;
+
+ } else {
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+
+ if( this->type!=BITSTR ) {
+ elem = gParse.nRows;
+ if( this->type!=STRING )
+ elem *= this->value.nelem;
+ while( elem-- )
+ this->value.undef[elem] = that->value.undef[elem];
+ }
+
+ elem = gParse.nRows * this->value.nelem;
+
+ switch( this->operation ) {
+
+ case BOOLEAN:
+ if( that->type==DOUBLE )
+ while( elem-- )
+ this->value.data.logptr[elem] =
+ ( that->value.data.dblptr[elem] != 0.0 );
+ else if( that->type==LONG )
+ while( elem-- )
+ this->value.data.logptr[elem] =
+ ( that->value.data.lngptr[elem] != 0L );
+ break;
+
+ case DOUBLE:
+ case FLTCAST:
+ if( that->type==LONG )
+ while( elem-- )
+ this->value.data.dblptr[elem] =
+ (double)that->value.data.lngptr[elem];
+ else if( that->type==BOOLEAN )
+ while( elem-- )
+ this->value.data.dblptr[elem] =
+ ( that->value.data.logptr[elem] ? 1.0 : 0.0 );
+ break;
+
+ case LONG:
+ case INTCAST:
+ if( that->type==DOUBLE )
+ while( elem-- )
+ this->value.data.lngptr[elem] =
+ (long)that->value.data.dblptr[elem];
+ else if( that->type==BOOLEAN )
+ while( elem-- )
+ this->value.data.lngptr[elem] =
+ ( that->value.data.logptr[elem] ? 1L : 0L );
+ break;
+
+ case UMINUS:
+ if( that->type==DOUBLE ) {
+ while( elem-- )
+ this->value.data.dblptr[elem] =
+ - that->value.data.dblptr[elem];
+ } else if( that->type==LONG ) {
+ while( elem-- )
+ this->value.data.lngptr[elem] =
+ - that->value.data.lngptr[elem];
+ }
+ break;
+
+ case NOT:
+ if( that->type==BOOLEAN ) {
+ while( elem-- )
+ this->value.data.logptr[elem] =
+ ( ! that->value.data.logptr[elem] );
+ } else if( that->type==BITSTR ) {
+ elem = gParse.nRows;
+ while( elem-- )
+ bitnot( this->value.data.strptr[elem],
+ that->value.data.strptr[elem] );
+ }
+ break;
+ }
+ }
+ }
+
+ if( that->operation>0 ) {
+ free( that->value.data.ptr );
+ }
+}
+
+static void Do_Offset( Node *this )
+{
+ Node *col;
+ long fRow, nRowOverlap, nRowReload, rowOffset;
+ long nelem, elem, offset, nRealElem;
+ int status;
+
+ col = gParse.Nodes + this->SubNodes[0];
+ rowOffset = gParse.Nodes[ this->SubNodes[1] ].value.data.lng;
+
+ Allocate_Ptrs( this );
+
+ fRow = gParse.firstRow + rowOffset;
+ if( this->type==STRING || this->type==BITSTR )
+ nRealElem = 1;
+ else
+ nRealElem = this->value.nelem;
+
+ nelem = nRealElem;
+
+ if( fRow < gParse.firstDataRow ) {
+
+ /* Must fill in data at start of array */
+
+ nRowReload = gParse.firstDataRow - fRow;
+ if( nRowReload > gParse.nRows ) nRowReload = gParse.nRows;
+ nRowOverlap = gParse.nRows - nRowReload;
+
+ offset = 0;
+
+ /* NULLify any values falling out of bounds */
+
+ while( fRow<1 && nRowReload>0 ) {
+ if( this->type == BITSTR ) {
+ nelem = this->value.nelem;
+ this->value.data.strptr[offset][ nelem ] = '\0';
+ while( nelem-- ) this->value.data.strptr[offset][nelem] = '0';
+ offset++;
+ } else {
+ while( nelem-- )
+ this->value.undef[offset++] = 1;
+ }
+ nelem = nRealElem;
+ fRow++;
+ nRowReload--;
+ }
+
+ } else if( fRow + gParse.nRows > gParse.firstDataRow + gParse.nDataRows ) {
+
+ /* Must fill in data at end of array */
+
+ nRowReload = (fRow+gParse.nRows) - (gParse.firstDataRow+gParse.nDataRows);
+ if( nRowReload>gParse.nRows ) {
+ nRowReload = gParse.nRows;
+ } else {
+ fRow = gParse.firstDataRow + gParse.nDataRows;
+ }
+ nRowOverlap = gParse.nRows - nRowReload;
+
+ offset = nRowOverlap * nelem;
+
+ /* NULLify any values falling out of bounds */
+
+ elem = gParse.nRows * nelem;
+ while( fRow+nRowReload>gParse.totalRows && nRowReload>0 ) {
+ if( this->type == BITSTR ) {
+ nelem = this->value.nelem;
+ elem--;
+ this->value.data.strptr[elem][ nelem ] = '\0';
+ while( nelem-- ) this->value.data.strptr[elem][nelem] = '0';
+ } else {
+ while( nelem-- )
+ this->value.undef[--elem] = 1;
+ }
+ nelem = nRealElem;
+ nRowReload--;
+ }
+
+ } else {
+
+ nRowReload = 0;
+ nRowOverlap = gParse.nRows;
+ offset = 0;
+
+ }
+
+ if( nRowReload>0 ) {
+ switch( this->type ) {
+ case BITSTR:
+ case STRING:
+ status = (*gParse.loadData)( -col->operation, fRow, nRowReload,
+ this->value.data.strptr+offset,
+ this->value.undef+offset );
+ break;
+ case BOOLEAN:
+ status = (*gParse.loadData)( -col->operation, fRow, nRowReload,
+ this->value.data.logptr+offset,
+ this->value.undef+offset );
+ break;
+ case LONG:
+ status = (*gParse.loadData)( -col->operation, fRow, nRowReload,
+ this->value.data.lngptr+offset,
+ this->value.undef+offset );
+ break;
+ case DOUBLE:
+ status = (*gParse.loadData)( -col->operation, fRow, nRowReload,
+ this->value.data.dblptr+offset,
+ this->value.undef+offset );
+ break;
+ }
+ }
+
+ /* Now copy over the overlapping region, if any */
+
+ if( nRowOverlap <= 0 ) return;
+
+ if( rowOffset>0 )
+ elem = nRowOverlap * nelem;
+ else
+ elem = gParse.nRows * nelem;
+
+ offset = nelem * rowOffset;
+ while( nRowOverlap-- && !gParse.status ) {
+ while( nelem-- && !gParse.status ) {
+ elem--;
+ if( this->type != BITSTR )
+ this->value.undef[elem] = col->value.undef[elem+offset];
+ switch( this->type ) {
+ case BITSTR:
+ strcpy( this->value.data.strptr[elem ],
+ col->value.data.strptr[elem+offset] );
+ break;
+ case STRING:
+ strcpy( this->value.data.strptr[elem ],
+ col->value.data.strptr[elem+offset] );
+ break;
+ case BOOLEAN:
+ this->value.data.logptr[elem] = col->value.data.logptr[elem+offset];
+ break;
+ case LONG:
+ this->value.data.lngptr[elem] = col->value.data.lngptr[elem+offset];
+ break;
+ case DOUBLE:
+ this->value.data.dblptr[elem] = col->value.data.dblptr[elem+offset];
+ break;
+ }
+ }
+ nelem = nRealElem;
+ }
+}
+
+static void Do_BinOp_bit( Node *this )
+{
+ Node *that1, *that2;
+ char *sptr1=NULL, *sptr2=NULL;
+ int const1, const2;
+ long rows;
+
+ that1 = gParse.Nodes + this->SubNodes[0];
+ that2 = gParse.Nodes + this->SubNodes[1];
+
+ const1 = ( that1->operation==CONST_OP );
+ const2 = ( that2->operation==CONST_OP );
+ sptr1 = ( const1 ? that1->value.data.str : NULL );
+ sptr2 = ( const2 ? that2->value.data.str : NULL );
+
+ if( const1 && const2 ) {
+ switch( this->operation ) {
+ case NE:
+ this->value.data.log = !bitcmp( sptr1, sptr2 );
+ break;
+ case EQ:
+ this->value.data.log = bitcmp( sptr1, sptr2 );
+ break;
+ case GT:
+ case LT:
+ case LTE:
+ case GTE:
+ this->value.data.log = bitlgte( sptr1, this->operation, sptr2 );
+ break;
+ case '|':
+ bitor( this->value.data.str, sptr1, sptr2 );
+ break;
+ case '&':
+ bitand( this->value.data.str, sptr1, sptr2 );
+ break;
+ case '+':
+ strcpy( this->value.data.str, sptr1 );
+ strcat( this->value.data.str, sptr2 );
+ break;
+ case ACCUM:
+ this->value.data.lng = 0;
+ while( *sptr1 ) {
+ if ( *sptr1 == '1' ) this->value.data.lng ++;
+ sptr1 ++;
+ }
+ break;
+
+ }
+ this->operation = CONST_OP;
+
+ } else {
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+ rows = gParse.nRows;
+ switch( this->operation ) {
+
+ /* BITSTR comparisons */
+
+ case NE:
+ case EQ:
+ case GT:
+ case LT:
+ case LTE:
+ case GTE:
+ while( rows-- ) {
+ if( !const1 )
+ sptr1 = that1->value.data.strptr[rows];
+ if( !const2 )
+ sptr2 = that2->value.data.strptr[rows];
+ switch( this->operation ) {
+ case NE: this->value.data.logptr[rows] =
+ !bitcmp( sptr1, sptr2 );
+ break;
+ case EQ: this->value.data.logptr[rows] =
+ bitcmp( sptr1, sptr2 );
+ break;
+ case GT:
+ case LT:
+ case LTE:
+ case GTE: this->value.data.logptr[rows] =
+ bitlgte( sptr1, this->operation, sptr2 );
+ break;
+ }
+ this->value.undef[rows] = 0;
+ }
+ break;
+
+ /* BITSTR AND/ORs ... no UNDEFS in or out */
+
+ case '|':
+ case '&':
+ case '+':
+ while( rows-- ) {
+ if( !const1 )
+ sptr1 = that1->value.data.strptr[rows];
+ if( !const2 )
+ sptr2 = that2->value.data.strptr[rows];
+ if( this->operation=='|' )
+ bitor( this->value.data.strptr[rows], sptr1, sptr2 );
+ else if( this->operation=='&' )
+ bitand( this->value.data.strptr[rows], sptr1, sptr2 );
+ else {
+ strcpy( this->value.data.strptr[rows], sptr1 );
+ strcat( this->value.data.strptr[rows], sptr2 );
+ }
+ }
+ break;
+
+ /* Accumulate 1 bits */
+ case ACCUM:
+ {
+ long i, previous, curr;
+
+ previous = that2->value.data.lng;
+
+ /* Cumulative sum of this chunk */
+ for (i=0; i<rows; i++) {
+ sptr1 = that1->value.data.strptr[i];
+ for (curr = 0; *sptr1; sptr1 ++) {
+ if ( *sptr1 == '1' ) curr ++;
+ }
+ previous += curr;
+ this->value.data.lngptr[i] = previous;
+ this->value.undef[i] = 0;
+ }
+
+ /* Store final cumulant for next pass */
+ that2->value.data.lng = previous;
+ }
+ }
+ }
+ }
+
+ if( that1->operation>0 ) {
+ free( that1->value.data.strptr[0] );
+ free( that1->value.data.strptr );
+ }
+ if( that2->operation>0 ) {
+ free( that2->value.data.strptr[0] );
+ free( that2->value.data.strptr );
+ }
+}
+
+static void Do_BinOp_str( Node *this )
+{
+ Node *that1, *that2;
+ char *sptr1, *sptr2, null1=0, null2=0;
+ int const1, const2, val;
+ long rows;
+
+ that1 = gParse.Nodes + this->SubNodes[0];
+ that2 = gParse.Nodes + this->SubNodes[1];
+
+ const1 = ( that1->operation==CONST_OP );
+ const2 = ( that2->operation==CONST_OP );
+ sptr1 = ( const1 ? that1->value.data.str : NULL );
+ sptr2 = ( const2 ? that2->value.data.str : NULL );
+
+ if( const1 && const2 ) { /* Result is a constant */
+ switch( this->operation ) {
+
+ /* Compare Strings */
+
+ case NE:
+ case EQ:
+ val = ( FSTRCMP( sptr1, sptr2 ) == 0 );
+ this->value.data.log = ( this->operation==EQ ? val : !val );
+ break;
+ case GT:
+ this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) > 0 );
+ break;
+ case LT:
+ this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) < 0 );
+ break;
+ case GTE:
+ this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) >= 0 );
+ break;
+ case LTE:
+ this->value.data.log = ( FSTRCMP( sptr1, sptr2 ) <= 0 );
+ break;
+
+ /* Concat Strings */
+
+ case '+':
+ strcpy( this->value.data.str, sptr1 );
+ strcat( this->value.data.str, sptr2 );
+ break;
+ }
+ this->operation = CONST_OP;
+
+ } else { /* Not a constant */
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+
+ rows = gParse.nRows;
+ switch( this->operation ) {
+
+ /* Compare Strings */
+
+ case NE:
+ case EQ:
+ while( rows-- ) {
+ if( !const1 ) null1 = that1->value.undef[rows];
+ if( !const2 ) null2 = that2->value.undef[rows];
+ this->value.undef[rows] = (null1 || null2);
+ if( ! this->value.undef[rows] ) {
+ if( !const1 ) sptr1 = that1->value.data.strptr[rows];
+ if( !const2 ) sptr2 = that2->value.data.strptr[rows];
+ val = ( FSTRCMP( sptr1, sptr2 ) == 0 );
+ this->value.data.logptr[rows] =
+ ( this->operation==EQ ? val : !val );
+ }
+ }
+ break;
+
+ case GT:
+ case LT:
+ while( rows-- ) {
+ if( !const1 ) null1 = that1->value.undef[rows];
+ if( !const2 ) null2 = that2->value.undef[rows];
+ this->value.undef[rows] = (null1 || null2);
+ if( ! this->value.undef[rows] ) {
+ if( !const1 ) sptr1 = that1->value.data.strptr[rows];
+ if( !const2 ) sptr2 = that2->value.data.strptr[rows];
+ val = ( FSTRCMP( sptr1, sptr2 ) );
+ this->value.data.logptr[rows] =
+ ( this->operation==GT ? val>0 : val<0 );
+ }
+ }
+ break;
+
+ case GTE:
+ case LTE:
+ while( rows-- ) {
+ if( !const1 ) null1 = that1->value.undef[rows];
+ if( !const2 ) null2 = that2->value.undef[rows];
+ this->value.undef[rows] = (null1 || null2);
+ if( ! this->value.undef[rows] ) {
+ if( !const1 ) sptr1 = that1->value.data.strptr[rows];
+ if( !const2 ) sptr2 = that2->value.data.strptr[rows];
+ val = ( FSTRCMP( sptr1, sptr2 ) );
+ this->value.data.logptr[rows] =
+ ( this->operation==GTE ? val>=0 : val<=0 );
+ }
+ }
+ break;
+
+ /* Concat Strings */
+
+ case '+':
+ while( rows-- ) {
+ if( !const1 ) null1 = that1->value.undef[rows];
+ if( !const2 ) null2 = that2->value.undef[rows];
+ this->value.undef[rows] = (null1 || null2);
+ if( ! this->value.undef[rows] ) {
+ if( !const1 ) sptr1 = that1->value.data.strptr[rows];
+ if( !const2 ) sptr2 = that2->value.data.strptr[rows];
+ strcpy( this->value.data.strptr[rows], sptr1 );
+ strcat( this->value.data.strptr[rows], sptr2 );
+ }
+ }
+ break;
+ }
+ }
+ }
+
+ if( that1->operation>0 ) {
+ free( that1->value.data.strptr[0] );
+ free( that1->value.data.strptr );
+ }
+ if( that2->operation>0 ) {
+ free( that2->value.data.strptr[0] );
+ free( that2->value.data.strptr );
+ }
+}
+
+static void Do_BinOp_log( Node *this )
+{
+ Node *that1, *that2;
+ int vector1, vector2;
+ char val1=0, val2=0, null1=0, null2=0;
+ long rows, nelem, elem;
+
+ that1 = gParse.Nodes + this->SubNodes[0];
+ that2 = gParse.Nodes + this->SubNodes[1];
+
+ vector1 = ( that1->operation!=CONST_OP );
+ if( vector1 )
+ vector1 = that1->value.nelem;
+ else {
+ val1 = that1->value.data.log;
+ }
+
+ vector2 = ( that2->operation!=CONST_OP );
+ if( vector2 )
+ vector2 = that2->value.nelem;
+ else {
+ val2 = that2->value.data.log;
+ }
+
+ if( !vector1 && !vector2 ) { /* Result is a constant */
+ switch( this->operation ) {
+ case OR:
+ this->value.data.log = (val1 || val2);
+ break;
+ case AND:
+ this->value.data.log = (val1 && val2);
+ break;
+ case EQ:
+ this->value.data.log = ( (val1 && val2) || (!val1 && !val2) );
+ break;
+ case NE:
+ this->value.data.log = ( (val1 && !val2) || (!val1 && val2) );
+ break;
+ case ACCUM:
+ this->value.data.lng = val1;
+ break;
+ }
+ this->operation=CONST_OP;
+ } else if (this->operation == ACCUM) {
+ long i, previous, curr;
+ rows = gParse.nRows;
+ nelem = this->value.nelem;
+ elem = this->value.nelem * rows;
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+ previous = that2->value.data.lng;
+
+ /* Cumulative sum of this chunk */
+ for (i=0; i<elem; i++) {
+ if (!that1->value.undef[i]) {
+ curr = that1->value.data.logptr[i];
+ previous += curr;
+ }
+ this->value.data.lngptr[i] = previous;
+ this->value.undef[i] = 0;
+ }
+
+ /* Store final cumulant for next pass */
+ that2->value.data.lng = previous;
+ }
+
+ } else {
+ rows = gParse.nRows;
+ nelem = this->value.nelem;
+ elem = this->value.nelem * rows;
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+
+ if (this->operation == ACCUM) {
+ long i, previous, curr;
+
+ previous = that2->value.data.lng;
+
+ /* Cumulative sum of this chunk */
+ for (i=0; i<elem; i++) {
+ if (!that1->value.undef[i]) {
+ curr = that1->value.data.logptr[i];
+ previous += curr;
+ }
+ this->value.data.lngptr[i] = previous;
+ this->value.undef[i] = 0;
+ }
+
+ /* Store final cumulant for next pass */
+ that2->value.data.lng = previous;
+ }
+
+ while( rows-- ) {
+ while( nelem-- ) {
+ elem--;
+
+ if( vector1>1 ) {
+ val1 = that1->value.data.logptr[elem];
+ null1 = that1->value.undef[elem];
+ } else if( vector1 ) {
+ val1 = that1->value.data.logptr[rows];
+ null1 = that1->value.undef[rows];
+ }
+
+ if( vector2>1 ) {
+ val2 = that2->value.data.logptr[elem];
+ null2 = that2->value.undef[elem];
+ } else if( vector2 ) {
+ val2 = that2->value.data.logptr[rows];
+ null2 = that2->value.undef[rows];
+ }
+
+ this->value.undef[elem] = (null1 || null2);
+ switch( this->operation ) {
+
+ case OR:
+ /* This is more complicated than others to suppress UNDEFs */
+ /* in those cases where the other argument is DEF && TRUE */
+
+ if( !null1 && !null2 ) {
+ this->value.data.logptr[elem] = (val1 || val2);
+ } else if( (null1 && !null2 && val2)
+ || ( !null1 && null2 && val1 ) ) {
+ this->value.data.logptr[elem] = 1;
+ this->value.undef[elem] = 0;
+ }
+ break;
+
+ case AND:
+ /* This is more complicated than others to suppress UNDEFs */
+ /* in those cases where the other argument is DEF && FALSE */
+
+ if( !null1 && !null2 ) {
+ this->value.data.logptr[elem] = (val1 && val2);
+ } else if( (null1 && !null2 && !val2)
+ || ( !null1 && null2 && !val1 ) ) {
+ this->value.data.logptr[elem] = 0;
+ this->value.undef[elem] = 0;
+ }
+ break;
+
+ case EQ:
+ this->value.data.logptr[elem] =
+ ( (val1 && val2) || (!val1 && !val2) );
+ break;
+
+ case NE:
+ this->value.data.logptr[elem] =
+ ( (val1 && !val2) || (!val1 && val2) );
+ break;
+ }
+ }
+ nelem = this->value.nelem;
+ }
+ }
+ }
+
+ if( that1->operation>0 ) {
+ free( that1->value.data.ptr );
+ }
+ if( that2->operation>0 ) {
+ free( that2->value.data.ptr );
+ }
+}
+
+static void Do_BinOp_lng( Node *this )
+{
+ Node *that1, *that2;
+ int vector1, vector2;
+ long val1=0, val2=0;
+ char null1=0, null2=0;
+ long rows, nelem, elem;
+
+ that1 = gParse.Nodes + this->SubNodes[0];
+ that2 = gParse.Nodes + this->SubNodes[1];
+
+ vector1 = ( that1->operation!=CONST_OP );
+ if( vector1 )
+ vector1 = that1->value.nelem;
+ else {
+ val1 = that1->value.data.lng;
+ }
+
+ vector2 = ( that2->operation!=CONST_OP );
+ if( vector2 )
+ vector2 = that2->value.nelem;
+ else {
+ val2 = that2->value.data.lng;
+ }
+
+ if( !vector1 && !vector2 ) { /* Result is a constant */
+
+ switch( this->operation ) {
+ case '~': /* Treat as == for LONGS */
+ case EQ: this->value.data.log = (val1 == val2); break;
+ case NE: this->value.data.log = (val1 != val2); break;
+ case GT: this->value.data.log = (val1 > val2); break;
+ case LT: this->value.data.log = (val1 < val2); break;
+ case LTE: this->value.data.log = (val1 <= val2); break;
+ case GTE: this->value.data.log = (val1 >= val2); break;
+
+ case '+': this->value.data.lng = (val1 + val2); break;
+ case '-': this->value.data.lng = (val1 - val2); break;
+ case '*': this->value.data.lng = (val1 * val2); break;
+
+ case '%':
+ if( val2 ) this->value.data.lng = (val1 % val2);
+ else fferror("Divide by Zero");
+ break;
+ case '/':
+ if( val2 ) this->value.data.lng = (val1 / val2);
+ else fferror("Divide by Zero");
+ break;
+ case POWER:
+ this->value.data.lng = (long)pow((double)val1,(double)val2);
+ break;
+ case ACCUM:
+ this->value.data.lng = val1;
+ break;
+ case DIFF:
+ this->value.data.lng = 0;
+ break;
+ }
+ this->operation=CONST_OP;
+
+ } else if ((this->operation == ACCUM) || (this->operation == DIFF)) {
+ long i, previous, curr;
+ long undef;
+ rows = gParse.nRows;
+ nelem = this->value.nelem;
+ elem = this->value.nelem * rows;
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+ previous = that2->value.data.lng;
+ undef = (long) that2->value.undef;
+
+ if (this->operation == ACCUM) {
+ /* Cumulative sum of this chunk */
+ for (i=0; i<elem; i++) {
+ if (!that1->value.undef[i]) {
+ curr = that1->value.data.lngptr[i];
+ previous += curr;
+ }
+ this->value.data.lngptr[i] = previous;
+ this->value.undef[i] = 0;
+ }
+ } else {
+ /* Sequential difference for this chunk */
+ for (i=0; i<elem; i++) {
+ curr = that1->value.data.lngptr[i];
+ if (that1->value.undef[i] || undef) {
+ /* Either this, or previous, value was undefined */
+ this->value.data.lngptr[i] = 0;
+ this->value.undef[i] = 1;
+ } else {
+ /* Both defined, we are okay! */
+ this->value.data.lngptr[i] = curr - previous;
+ this->value.undef[i] = 0;
+ }
+
+ previous = curr;
+ undef = that1->value.undef[i];
+ }
+ }
+
+ /* Store final cumulant for next pass */
+ that2->value.data.lng = previous;
+ that2->value.undef = (char *) undef; /* XXX evil, but no harm here */
+ }
+
+ } else {
+
+ rows = gParse.nRows;
+ nelem = this->value.nelem;
+ elem = this->value.nelem * rows;
+
+ Allocate_Ptrs( this );
+
+ while( rows-- && !gParse.status ) {
+ while( nelem-- && !gParse.status ) {
+ elem--;
+
+ if( vector1>1 ) {
+ val1 = that1->value.data.lngptr[elem];
+ null1 = that1->value.undef[elem];
+ } else if( vector1 ) {
+ val1 = that1->value.data.lngptr[rows];
+ null1 = that1->value.undef[rows];
+ }
+
+ if( vector2>1 ) {
+ val2 = that2->value.data.lngptr[elem];
+ null2 = that2->value.undef[elem];
+ } else if( vector2 ) {
+ val2 = that2->value.data.lngptr[rows];
+ null2 = that2->value.undef[rows];
+ }
+
+ this->value.undef[elem] = (null1 || null2);
+ switch( this->operation ) {
+ case '~': /* Treat as == for LONGS */
+ case EQ: this->value.data.logptr[elem] = (val1 == val2); break;
+ case NE: this->value.data.logptr[elem] = (val1 != val2); break;
+ case GT: this->value.data.logptr[elem] = (val1 > val2); break;
+ case LT: this->value.data.logptr[elem] = (val1 < val2); break;
+ case LTE: this->value.data.logptr[elem] = (val1 <= val2); break;
+ case GTE: this->value.data.logptr[elem] = (val1 >= val2); break;
+
+ case '+': this->value.data.lngptr[elem] = (val1 + val2); break;
+ case '-': this->value.data.lngptr[elem] = (val1 - val2); break;
+ case '*': this->value.data.lngptr[elem] = (val1 * val2); break;
+
+ case '%':
+ if( val2 ) this->value.data.lngptr[elem] = (val1 % val2);
+ else {
+ this->value.data.lngptr[elem] = 0;
+ this->value.undef[elem] = 1;
+ }
+ break;
+ case '/':
+ if( val2 ) this->value.data.lngptr[elem] = (val1 / val2);
+ else {
+ this->value.data.lngptr[elem] = 0;
+ this->value.undef[elem] = 1;
+ }
+ break;
+ case POWER:
+ this->value.data.lngptr[elem] = (long)pow((double)val1,(double)val2);
+ break;
+ }
+ }
+ nelem = this->value.nelem;
+ }
+ }
+
+ if( that1->operation>0 ) {
+ free( that1->value.data.ptr );
+ }
+ if( that2->operation>0 ) {
+ free( that2->value.data.ptr );
+ }
+}
+
+static void Do_BinOp_dbl( Node *this )
+{
+ Node *that1, *that2;
+ int vector1, vector2;
+ double val1=0.0, val2=0.0;
+ char null1=0, null2=0;
+ long rows, nelem, elem;
+
+ that1 = gParse.Nodes + this->SubNodes[0];
+ that2 = gParse.Nodes + this->SubNodes[1];
+
+ vector1 = ( that1->operation!=CONST_OP );
+ if( vector1 )
+ vector1 = that1->value.nelem;
+ else {
+ val1 = that1->value.data.dbl;
+ }
+
+ vector2 = ( that2->operation!=CONST_OP );
+ if( vector2 )
+ vector2 = that2->value.nelem;
+ else {
+ val2 = that2->value.data.dbl;
+ }
+
+ if( !vector1 && !vector2 ) { /* Result is a constant */
+
+ switch( this->operation ) {
+ case '~': this->value.data.log = ( fabs(val1-val2) < APPROX ); break;
+ case EQ: this->value.data.log = (val1 == val2); break;
+ case NE: this->value.data.log = (val1 != val2); break;
+ case GT: this->value.data.log = (val1 > val2); break;
+ case LT: this->value.data.log = (val1 < val2); break;
+ case LTE: this->value.data.log = (val1 <= val2); break;
+ case GTE: this->value.data.log = (val1 >= val2); break;
+
+ case '+': this->value.data.dbl = (val1 + val2); break;
+ case '-': this->value.data.dbl = (val1 - val2); break;
+ case '*': this->value.data.dbl = (val1 * val2); break;
+
+ case '%':
+ if( val2 ) this->value.data.dbl = val1 - val2*((int)(val1/val2));
+ else fferror("Divide by Zero");
+ break;
+ case '/':
+ if( val2 ) this->value.data.dbl = (val1 / val2);
+ else fferror("Divide by Zero");
+ break;
+ case POWER:
+ this->value.data.dbl = (double)pow(val1,val2);
+ break;
+ case ACCUM:
+ this->value.data.dbl = val1;
+ break;
+ case DIFF:
+ this->value.data.dbl = 0;
+ break;
+ }
+ this->operation=CONST_OP;
+
+ } else if ((this->operation == ACCUM) || (this->operation == DIFF)) {
+ long i;
+ long undef;
+ double previous, curr;
+ rows = gParse.nRows;
+ nelem = this->value.nelem;
+ elem = this->value.nelem * rows;
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+ previous = that2->value.data.dbl;
+ undef = (long) that2->value.undef;
+
+ if (this->operation == ACCUM) {
+ /* Cumulative sum of this chunk */
+ for (i=0; i<elem; i++) {
+ if (!that1->value.undef[i]) {
+ curr = that1->value.data.dblptr[i];
+ previous += curr;
+ }
+ this->value.data.dblptr[i] = previous;
+ this->value.undef[i] = 0;
+ }
+ } else {
+ /* Sequential difference for this chunk */
+ for (i=0; i<elem; i++) {
+ curr = that1->value.data.dblptr[i];
+ if (that1->value.undef[i] || undef) {
+ /* Either this, or previous, value was undefined */
+ this->value.data.dblptr[i] = 0;
+ this->value.undef[i] = 1;
+ } else {
+ /* Both defined, we are okay! */
+ this->value.data.dblptr[i] = curr - previous;
+ this->value.undef[i] = 0;
+ }
+
+ previous = curr;
+ undef = that1->value.undef[i];
+ }
+ }
+
+ /* Store final cumulant for next pass */
+ that2->value.data.dbl = previous;
+ that2->value.undef = (char *) undef; /* XXX evil, but no harm here */
+ }
+
+ } else {
+
+ rows = gParse.nRows;
+ nelem = this->value.nelem;
+ elem = this->value.nelem * rows;
+
+ Allocate_Ptrs( this );
+
+ while( rows-- && !gParse.status ) {
+ while( nelem-- && !gParse.status ) {
+ elem--;
+
+ if( vector1>1 ) {
+ val1 = that1->value.data.dblptr[elem];
+ null1 = that1->value.undef[elem];
+ } else if( vector1 ) {
+ val1 = that1->value.data.dblptr[rows];
+ null1 = that1->value.undef[rows];
+ }
+
+ if( vector2>1 ) {
+ val2 = that2->value.data.dblptr[elem];
+ null2 = that2->value.undef[elem];
+ } else if( vector2 ) {
+ val2 = that2->value.data.dblptr[rows];
+ null2 = that2->value.undef[rows];
+ }
+
+ this->value.undef[elem] = (null1 || null2);
+ switch( this->operation ) {
+ case '~': this->value.data.logptr[elem] =
+ ( fabs(val1-val2) < APPROX ); break;
+ case EQ: this->value.data.logptr[elem] = (val1 == val2); break;
+ case NE: this->value.data.logptr[elem] = (val1 != val2); break;
+ case GT: this->value.data.logptr[elem] = (val1 > val2); break;
+ case LT: this->value.data.logptr[elem] = (val1 < val2); break;
+ case LTE: this->value.data.logptr[elem] = (val1 <= val2); break;
+ case GTE: this->value.data.logptr[elem] = (val1 >= val2); break;
+
+ case '+': this->value.data.dblptr[elem] = (val1 + val2); break;
+ case '-': this->value.data.dblptr[elem] = (val1 - val2); break;
+ case '*': this->value.data.dblptr[elem] = (val1 * val2); break;
+
+ case '%':
+ if( val2 ) this->value.data.dblptr[elem] =
+ val1 - val2*((int)(val1/val2));
+ else {
+ this->value.data.dblptr[elem] = 0.0;
+ this->value.undef[elem] = 1;
+ }
+ break;
+ case '/':
+ if( val2 ) this->value.data.dblptr[elem] = (val1 / val2);
+ else {
+ this->value.data.dblptr[elem] = 0.0;
+ this->value.undef[elem] = 1;
+ }
+ break;
+ case POWER:
+ this->value.data.dblptr[elem] = (double)pow(val1,val2);
+ break;
+ }
+ }
+ nelem = this->value.nelem;
+ }
+ }
+
+ if( that1->operation>0 ) {
+ free( that1->value.data.ptr );
+ }
+ if( that2->operation>0 ) {
+ free( that2->value.data.ptr );
+ }
+}
+
+/*
+ * This Quickselect routine is based on the algorithm described in
+ * "Numerical recipes in C", Second Edition,
+ * Cambridge University Press, 1992, Section 8.5, ISBN 0-521-43108-5
+ * This code by Nicolas Devillard - 1998. Public domain.
+ * http://ndevilla.free.fr/median/median/src/quickselect.c
+ */
+
+#define ELEM_SWAP(a,b) { register long t=(a);(a)=(b);(b)=t; }
+
+/*
+ * qselect_median_lng - select the median value of a long array
+ *
+ * This routine selects the median value of the long integer array
+ * arr[]. If there are an even number of elements, the "lower median"
+ * is selected.
+ *
+ * The array arr[] is scrambled, so users must operate on a scratch
+ * array if they wish the values to be preserved.
+ *
+ * long arr[] - array of values
+ * int n - number of elements in arr
+ *
+ * RETURNS: the lower median value of arr[]
+ *
+ */
+long qselect_median_lng(long arr[], int n)
+{
+ int low, high ;
+ int median;
+ int middle, ll, hh;
+
+ low = 0 ; high = n-1 ; median = (low + high) / 2;
+ for (;;) {
+
+ if (high <= low) { /* One element only */
+ return arr[median];
+ }
+
+ if (high == low + 1) { /* Two elements only */
+ if (arr[low] > arr[high])
+ ELEM_SWAP(arr[low], arr[high]) ;
+ return arr[median];
+ }
+
+ /* Find median of low, middle and high items; swap into position low */
+ middle = (low + high) / 2;
+ if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ;
+ if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ;
+ if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ;
+
+ /* Swap low item (now in position middle) into position (low+1) */
+ ELEM_SWAP(arr[middle], arr[low+1]) ;
+
+ /* Nibble from each end towards middle, swapping items when stuck */
+ ll = low + 1;
+ hh = high;
+ for (;;) {
+ do ll++; while (arr[low] > arr[ll]) ;
+ do hh--; while (arr[hh] > arr[low]) ;
+
+ if (hh < ll)
+ break;
+
+ ELEM_SWAP(arr[ll], arr[hh]) ;
+ }
+
+ /* Swap middle item (in position low) back into correct position */
+ ELEM_SWAP(arr[low], arr[hh]) ;
+
+ /* Re-set active partition */
+ if (hh <= median)
+ low = ll;
+ if (hh >= median)
+ high = hh - 1;
+ }
+}
+
+#undef ELEM_SWAP
+
+#define ELEM_SWAP(a,b) { register double t=(a);(a)=(b);(b)=t; }
+
+/*
+ * qselect_median_dbl - select the median value of a double array
+ *
+ * This routine selects the median value of the double array
+ * arr[]. If there are an even number of elements, the "lower median"
+ * is selected.
+ *
+ * The array arr[] is scrambled, so users must operate on a scratch
+ * array if they wish the values to be preserved.
+ *
+ * double arr[] - array of values
+ * int n - number of elements in arr
+ *
+ * RETURNS: the lower median value of arr[]
+ *
+ */
+double qselect_median_dbl(double arr[], int n)
+{
+ int low, high ;
+ int median;
+ int middle, ll, hh;
+
+ low = 0 ; high = n-1 ; median = (low + high) / 2;
+ for (;;) {
+ if (high <= low) { /* One element only */
+ return arr[median] ;
+ }
+
+ if (high == low + 1) { /* Two elements only */
+ if (arr[low] > arr[high])
+ ELEM_SWAP(arr[low], arr[high]) ;
+ return arr[median] ;
+ }
+
+ /* Find median of low, middle and high items; swap into position low */
+ middle = (low + high) / 2;
+ if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ;
+ if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ;
+ if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ;
+
+ /* Swap low item (now in position middle) into position (low+1) */
+ ELEM_SWAP(arr[middle], arr[low+1]) ;
+
+ /* Nibble from each end towards middle, swapping items when stuck */
+ ll = low + 1;
+ hh = high;
+ for (;;) {
+ do ll++; while (arr[low] > arr[ll]) ;
+ do hh--; while (arr[hh] > arr[low]) ;
+
+ if (hh < ll)
+ break;
+
+ ELEM_SWAP(arr[ll], arr[hh]) ;
+ }
+
+ /* Swap middle item (in position low) back into correct position */
+ ELEM_SWAP(arr[low], arr[hh]) ;
+
+ /* Re-set active partition */
+ if (hh <= median)
+ low = ll;
+ if (hh >= median)
+ high = hh - 1;
+ }
+}
+
+#undef ELEM_SWAP
+
+/*
+ * angsep_calc - compute angular separation between celestial coordinates
+ *
+ * This routine computes the angular separation between to coordinates
+ * on the celestial sphere (i.e. RA and Dec). Note that all units are
+ * in DEGREES, unlike the other trig functions in the calculator.
+ *
+ * double ra1, dec1 - RA and Dec of the first position in degrees
+ * double ra2, dec2 - RA and Dec of the second position in degrees
+ *
+ * RETURNS: (double) angular separation in degrees
+ *
+ */
+double angsep_calc(double ra1, double dec1, double ra2, double dec2)
+{
+ double cd;
+ static double deg = 0;
+ double a, sdec, sra;
+
+ if (deg == 0) deg = ((double)4)*atan((double)1)/((double)180);
+ /* deg = 1.0; **** UNCOMMENT IF YOU WANT RADIANS */
+
+
+
+/*
+This (commented out) algorithm uses the Low of Cosines, which becomes
+ unstable for angles less than 0.1 arcsec.
+
+ cd = sin(dec1*deg)*sin(dec2*deg)
+ + cos(dec1*deg)*cos(dec2*deg)*cos((ra1-ra2)*deg);
+ if (cd < (-1)) cd = -1;
+ if (cd > (+1)) cd = +1;
+ return acos(cd)/deg;
+*/
+
+ /* The algorithm is the law of Haversines. This algorithm is
+ stable even when the points are close together. The normal
+ Law of Cosines fails for angles around 0.1 arcsec. */
+
+ sra = sin( (ra2 - ra1)*deg / 2 );
+ sdec = sin( (dec2 - dec1)*deg / 2);
+ a = sdec*sdec + cos(dec1*deg)*cos(dec2*deg)*sra*sra;
+
+ /* Sanity checking to avoid a range error in the sqrt()'s below */
+ if (a < 0) { a = 0; }
+ if (a > 1) { a = 1; }
+
+ return 2.0*atan2(sqrt(a), sqrt(1.0 - a)) / deg;
+}
+
+
+
+
+
+
+static double ran1()
+{
+ static double dval = 0.0;
+ double rndVal;
+
+ if (dval == 0.0) {
+ if( rand()<32768 && rand()<32768 )
+ dval = 32768.0;
+ else
+ dval = 2147483648.0;
+ }
+
+ rndVal = (double)rand();
+ while( rndVal > dval ) dval *= 2.0;
+ return rndVal/dval;
+}
+
+/* Gaussian deviate routine from Numerical Recipes */
+static double gasdev()
+{
+ static int iset = 0;
+ static double gset;
+ double fac, rsq, v1, v2;
+
+ if (iset == 0) {
+ do {
+ v1 = 2.0*ran1()-1.0;
+ v2 = 2.0*ran1()-1.0;
+ rsq = v1*v1 + v2*v2;
+ } while (rsq >= 1.0 || rsq == 0.0);
+ fac = sqrt(-2.0*log(rsq)/rsq);
+ gset = v1*fac;
+ iset = 1;
+ return v2*fac;
+ } else {
+ iset = 0;
+ return gset;
+ }
+
+}
+
+/* lgamma function - from Numerical Recipes */
+
+float gammaln(float xx)
+ /* Returns the value ln Gamma[(xx)] for xx > 0. */
+{
+ /*
+ Internal arithmetic will be done in double precision, a nicety
+ that you can omit if five-figure accuracy is good enough. */
+ double x,y,tmp,ser;
+ static double cof[6]={76.18009172947146,-86.50532032941677,
+ 24.01409824083091,-1.231739572450155,
+ 0.1208650973866179e-2,-0.5395239384953e-5};
+ int j;
+ y=x=xx;
+ tmp=x+5.5;
+ tmp -= (x+0.5)*log(tmp);
+ ser=1.000000000190015;
+ for (j=0;j<=5;j++) ser += cof[j]/++y;
+ return (float) -tmp+log(2.5066282746310005*ser/x);
+}
+
+/* Poisson deviate - derived from Numerical Recipes */
+static long poidev(double xm)
+{
+ static double sq, alxm, g, oldm = -1.0;
+ static double pi = 0;
+ double em, t, y;
+
+ if (pi == 0) pi = ((double)4)*atan((double)1);
+
+ if (xm < 20.0) {
+ if (xm != oldm) {
+ oldm = xm;
+ g = exp(-xm);
+ }
+ em = -1;
+ t = 1.0;
+ do {
+ em += 1;
+ t *= ran1();
+ } while (t > g);
+ } else {
+ if (xm != oldm) {
+ oldm = xm;
+ sq = sqrt(2.0*xm);
+ alxm = log(xm);
+ g = xm*alxm-gammaln( (float) (xm+1.0));
+ }
+ do {
+ do {
+ y = tan(pi*ran1());
+ em = sq*y+xm;
+ } while (em < 0.0);
+ em = floor(em);
+ t = 0.9*(1.0+y*y)*exp(em*alxm-gammaln( (float) (em+1.0) )-g);
+ } while (ran1() > t);
+ }
+
+ /* Return integer version */
+ return (long int) floor(em+0.5);
+}
+
+static void Do_Func( Node *this )
+{
+ Node *theParams[MAXSUBS];
+ int vector[MAXSUBS], allConst;
+ lval pVals[MAXSUBS];
+ char pNull[MAXSUBS];
+ long ival;
+ double dval;
+ int i, valInit;
+ long row, elem, nelem;
+
+ i = this->nSubNodes;
+ allConst = 1;
+ while( i-- ) {
+ theParams[i] = gParse.Nodes + this->SubNodes[i];
+ vector[i] = ( theParams[i]->operation!=CONST_OP );
+ if( vector[i] ) {
+ allConst = 0;
+ vector[i] = theParams[i]->value.nelem;
+ } else {
+ if( theParams[i]->type==DOUBLE ) {
+ pVals[i].data.dbl = theParams[i]->value.data.dbl;
+ } else if( theParams[i]->type==LONG ) {
+ pVals[i].data.lng = theParams[i]->value.data.lng;
+ } else if( theParams[i]->type==BOOLEAN ) {
+ pVals[i].data.log = theParams[i]->value.data.log;
+ } else
+ strcpy(pVals[i].data.str, theParams[i]->value.data.str);
+ pNull[i] = 0;
+ }
+ }
+
+ if( this->nSubNodes==0 ) allConst = 0; /* These do produce scalars */
+ /* Random numbers are *never* constant !! */
+ if( this->operation == poirnd_fct ) allConst = 0;
+ if( this->operation == gasrnd_fct ) allConst = 0;
+ if( this->operation == rnd_fct ) allConst = 0;
+
+ if( allConst ) {
+
+ switch( this->operation ) {
+
+ /* Non-Trig single-argument functions */
+
+ case sum_fct:
+ if( theParams[0]->type==BOOLEAN )
+ this->value.data.lng = ( pVals[0].data.log ? 1 : 0 );
+ else if( theParams[0]->type==LONG )
+ this->value.data.lng = pVals[0].data.lng;
+ else if( theParams[0]->type==DOUBLE )
+ this->value.data.dbl = pVals[0].data.dbl;
+ else if( theParams[0]->type==BITSTR )
+ strcpy(this->value.data.str, pVals[0].data.str);
+ break;
+ case average_fct:
+ if( theParams[0]->type==LONG )
+ this->value.data.dbl = pVals[0].data.lng;
+ else if( theParams[0]->type==DOUBLE )
+ this->value.data.dbl = pVals[0].data.dbl;
+ break;
+ case stddev_fct:
+ this->value.data.dbl = 0; /* Standard deviation of a constant = 0 */
+ break;
+ case median_fct:
+ if( theParams[0]->type==BOOLEAN )
+ this->value.data.lng = ( pVals[0].data.log ? 1 : 0 );
+ else if( theParams[0]->type==LONG )
+ this->value.data.lng = pVals[0].data.lng;
+ else
+ this->value.data.dbl = pVals[0].data.dbl;
+ break;
+
+ case poirnd_fct:
+ if( theParams[0]->type==DOUBLE )
+ this->value.data.lng = poidev(pVals[0].data.dbl);
+ else
+ this->value.data.lng = poidev(pVals[0].data.lng);
+ break;
+
+ case abs_fct:
+ if( theParams[0]->type==DOUBLE ) {
+ dval = pVals[0].data.dbl;
+ this->value.data.dbl = (dval>0.0 ? dval : -dval);
+ } else {
+ ival = pVals[0].data.lng;
+ this->value.data.lng = (ival> 0 ? ival : -ival);
+ }
+ break;
+
+ /* Special Null-Handling Functions */
+
+ case nonnull_fct:
+ this->value.data.lng = 1; /* Constants are always 1-element and defined */
+ break;
+ case isnull_fct: /* Constants are always defined */
+ this->value.data.log = 0;
+ break;
+ case defnull_fct:
+ if( this->type==BOOLEAN )
+ this->value.data.log = pVals[0].data.log;
+ else if( this->type==LONG )
+ this->value.data.lng = pVals[0].data.lng;
+ else if( this->type==DOUBLE )
+ this->value.data.dbl = pVals[0].data.dbl;
+ else if( this->type==STRING )
+ strcpy(this->value.data.str,pVals[0].data.str);
+ break;
+
+ /* Math functions with 1 double argument */
+
+ case sin_fct:
+ this->value.data.dbl = sin( pVals[0].data.dbl );
+ break;
+ case cos_fct:
+ this->value.data.dbl = cos( pVals[0].data.dbl );
+ break;
+ case tan_fct:
+ this->value.data.dbl = tan( pVals[0].data.dbl );
+ break;
+ case asin_fct:
+ dval = pVals[0].data.dbl;
+ if( dval<-1.0 || dval>1.0 )
+ fferror("Out of range argument to arcsin");
+ else
+ this->value.data.dbl = asin( dval );
+ break;
+ case acos_fct:
+ dval = pVals[0].data.dbl;
+ if( dval<-1.0 || dval>1.0 )
+ fferror("Out of range argument to arccos");
+ else
+ this->value.data.dbl = acos( dval );
+ break;
+ case atan_fct:
+ this->value.data.dbl = atan( pVals[0].data.dbl );
+ break;
+ case sinh_fct:
+ this->value.data.dbl = sinh( pVals[0].data.dbl );
+ break;
+ case cosh_fct:
+ this->value.data.dbl = cosh( pVals[0].data.dbl );
+ break;
+ case tanh_fct:
+ this->value.data.dbl = tanh( pVals[0].data.dbl );
+ break;
+ case exp_fct:
+ this->value.data.dbl = exp( pVals[0].data.dbl );
+ break;
+ case log_fct:
+ dval = pVals[0].data.dbl;
+ if( dval<=0.0 )
+ fferror("Out of range argument to log");
+ else
+ this->value.data.dbl = log( dval );
+ break;
+ case log10_fct:
+ dval = pVals[0].data.dbl;
+ if( dval<=0.0 )
+ fferror("Out of range argument to log10");
+ else
+ this->value.data.dbl = log10( dval );
+ break;
+ case sqrt_fct:
+ dval = pVals[0].data.dbl;
+ if( dval<0.0 )
+ fferror("Out of range argument to sqrt");
+ else
+ this->value.data.dbl = sqrt( dval );
+ break;
+ case ceil_fct:
+ this->value.data.dbl = ceil( pVals[0].data.dbl );
+ break;
+ case floor_fct:
+ this->value.data.dbl = floor( pVals[0].data.dbl );
+ break;
+ case round_fct:
+ this->value.data.dbl = floor( pVals[0].data.dbl + 0.5 );
+ break;
+
+ /* Two-argument Trig Functions */
+
+ case atan2_fct:
+ this->value.data.dbl =
+ atan2( pVals[0].data.dbl, pVals[1].data.dbl );
+ break;
+
+ /* Four-argument ANGSEP function */
+ case angsep_fct:
+ this->value.data.dbl =
+ angsep_calc(pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl, pVals[3].data.dbl);
+
+ /* Min/Max functions taking 1 or 2 arguments */
+
+ case min1_fct:
+ /* No constant vectors! */
+ if( this->type == DOUBLE )
+ this->value.data.dbl = pVals[0].data.dbl;
+ else if( this->type == LONG )
+ this->value.data.lng = pVals[0].data.lng;
+ else if( this->type == BITSTR )
+ strcpy(this->value.data.str, pVals[0].data.str);
+ break;
+ case min2_fct:
+ if( this->type == DOUBLE )
+ this->value.data.dbl =
+ minvalue( pVals[0].data.dbl, pVals[1].data.dbl );
+ else if( this->type == LONG )
+ this->value.data.lng =
+ minvalue( pVals[0].data.lng, pVals[1].data.lng );
+ break;
+ case max1_fct:
+ /* No constant vectors! */
+ if( this->type == DOUBLE )
+ this->value.data.dbl = pVals[0].data.dbl;
+ else if( this->type == LONG )
+ this->value.data.lng = pVals[0].data.lng;
+ else if( this->type == BITSTR )
+ strcpy(this->value.data.str, pVals[0].data.str);
+ break;
+ case max2_fct:
+ if( this->type == DOUBLE )
+ this->value.data.dbl =
+ maxvalue( pVals[0].data.dbl, pVals[1].data.dbl );
+ else if( this->type == LONG )
+ this->value.data.lng =
+ maxvalue( pVals[0].data.lng, pVals[1].data.lng );
+ break;
+
+ /* Boolean SAO region Functions... scalar or vector dbls */
+
+ case near_fct:
+ this->value.data.log = bnear( pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl );
+ break;
+ case circle_fct:
+ this->value.data.log = circle( pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl, pVals[3].data.dbl,
+ pVals[4].data.dbl );
+ break;
+ case box_fct:
+ this->value.data.log = saobox( pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl, pVals[3].data.dbl,
+ pVals[4].data.dbl, pVals[5].data.dbl,
+ pVals[6].data.dbl );
+ break;
+ case elps_fct:
+ this->value.data.log =
+ ellipse( pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl, pVals[3].data.dbl,
+ pVals[4].data.dbl, pVals[5].data.dbl,
+ pVals[6].data.dbl );
+ break;
+
+ /* C Conditional expression: bool ? expr : expr */
+
+ case ifthenelse_fct:
+ switch( this->type ) {
+ case BOOLEAN:
+ this->value.data.log = ( pVals[2].data.log ?
+ pVals[0].data.log : pVals[1].data.log );
+ break;
+ case LONG:
+ this->value.data.lng = ( pVals[2].data.log ?
+ pVals[0].data.lng : pVals[1].data.lng );
+ break;
+ case DOUBLE:
+ this->value.data.dbl = ( pVals[2].data.log ?
+ pVals[0].data.dbl : pVals[1].data.dbl );
+ break;
+ case STRING:
+ strcpy(this->value.data.str, ( pVals[2].data.log ?
+ pVals[0].data.str :
+ pVals[1].data.str ) );
+ break;
+ }
+ break;
+
+ /* String functions */
+ case strmid_fct:
+ cstrmid(this->value.data.str, this->value.nelem,
+ pVals[0].data.str, pVals[0].nelem,
+ pVals[1].data.lng);
+ break;
+ case strpos_fct:
+ {
+ char *res = strstr(pVals[0].data.str, pVals[1].data.str);
+ if (res == NULL) {
+ this->value.data.lng = 0;
+ } else {
+ this->value.data.lng = (res - pVals[0].data.str) + 1;
+ }
+ break;
+ }
+
+ }
+ this->operation = CONST_OP;
+
+ } else {
+
+ Allocate_Ptrs( this );
+
+ row = gParse.nRows;
+ elem = row * this->value.nelem;
+
+ if( !gParse.status ) {
+ switch( this->operation ) {
+
+ /* Special functions with no arguments */
+
+ case row_fct:
+ while( row-- ) {
+ this->value.data.lngptr[row] = gParse.firstRow + row;
+ this->value.undef[row] = 0;
+ }
+ break;
+ case null_fct:
+ if( this->type==LONG ) {
+ while( row-- ) {
+ this->value.data.lngptr[row] = 0;
+ this->value.undef[row] = 1;
+ }
+ } else if( this->type==STRING ) {
+ while( row-- ) {
+ this->value.data.strptr[row][0] = '\0';
+ this->value.undef[row] = 1;
+ }
+ }
+ break;
+ case rnd_fct:
+ while( elem-- ) {
+ this->value.data.dblptr[elem] = ran1();
+ this->value.undef[elem] = 0;
+ }
+ break;
+
+ case gasrnd_fct:
+ while( elem-- ) {
+ this->value.data.dblptr[elem] = gasdev();
+ this->value.undef[elem] = 0;
+ }
+ break;
+
+ case poirnd_fct:
+ if( theParams[0]->type==DOUBLE ) {
+ if (theParams[0]->operation == CONST_OP) {
+ while( elem-- ) {
+ this->value.undef[elem] = (pVals[0].data.dbl < 0);
+ if (! this->value.undef[elem]) {
+ this->value.data.lngptr[elem] = poidev(pVals[0].data.dbl);
+ }
+ }
+ } else {
+ while( elem-- ) {
+ this->value.undef[elem] = theParams[0]->value.undef[elem];
+ if (theParams[0]->value.data.dblptr[elem] < 0)
+ this->value.undef[elem] = 1;
+ if (! this->value.undef[elem]) {
+ this->value.data.lngptr[elem] =
+ poidev(theParams[0]->value.data.dblptr[elem]);
+ }
+ } /* while */
+ } /* ! CONST_OP */
+ } else {
+ /* LONG */
+ if (theParams[0]->operation == CONST_OP) {
+ while( elem-- ) {
+ this->value.undef[elem] = (pVals[0].data.lng < 0);
+ if (! this->value.undef[elem]) {
+ this->value.data.lngptr[elem] = poidev(pVals[0].data.lng);
+ }
+ }
+ } else {
+ while( elem-- ) {
+ this->value.undef[elem] = theParams[0]->value.undef[elem];
+ if (theParams[0]->value.data.lngptr[elem] < 0)
+ this->value.undef[elem] = 1;
+ if (! this->value.undef[elem]) {
+ this->value.data.lngptr[elem] =
+ poidev(theParams[0]->value.data.lngptr[elem]);
+ }
+ } /* while */
+ } /* ! CONST_OP */
+ } /* END LONG */
+ break;
+
+
+ /* Non-Trig single-argument functions */
+
+ case sum_fct:
+ elem = row * theParams[0]->value.nelem;
+ if( theParams[0]->type==BOOLEAN ) {
+ while( row-- ) {
+ this->value.data.lngptr[row] = 0;
+ /* Default is UNDEF until a defined value is found */
+ this->value.undef[row] = 1;
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if ( ! theParams[0]->value.undef[elem] ) {
+ this->value.data.lngptr[row] +=
+ ( theParams[0]->value.data.logptr[elem] ? 1 : 0 );
+ this->value.undef[row] = 0;
+ }
+ }
+ }
+ } else if( theParams[0]->type==LONG ) {
+ while( row-- ) {
+ this->value.data.lngptr[row] = 0;
+ /* Default is UNDEF until a defined value is found */
+ this->value.undef[row] = 1;
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if ( ! theParams[0]->value.undef[elem] ) {
+ this->value.data.lngptr[row] +=
+ theParams[0]->value.data.lngptr[elem];
+ this->value.undef[row] = 0;
+ }
+ }
+ }
+ } else if( theParams[0]->type==DOUBLE ){
+ while( row-- ) {
+ this->value.data.dblptr[row] = 0.0;
+ /* Default is UNDEF until a defined value is found */
+ this->value.undef[row] = 1;
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if ( ! theParams[0]->value.undef[elem] ) {
+ this->value.data.dblptr[row] +=
+ theParams[0]->value.data.dblptr[elem];
+ this->value.undef[row] = 0;
+ }
+ }
+ }
+ } else { /* BITSTR */
+ nelem = theParams[0]->value.nelem;
+ while( row-- ) {
+ char *sptr1 = theParams[0]->value.data.strptr[row];
+ this->value.data.lngptr[row] = 0;
+ this->value.undef[row] = 0;
+ while (*sptr1) {
+ if (*sptr1 == '1') this->value.data.lngptr[row] ++;
+ sptr1++;
+ }
+ }
+ }
+ break;
+
+ case average_fct:
+ elem = row * theParams[0]->value.nelem;
+ if( theParams[0]->type==LONG ) {
+ while( row-- ) {
+ int count = 0;
+ this->value.data.dblptr[row] = 0;
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if (theParams[0]->value.undef[elem] == 0) {
+ this->value.data.dblptr[row] +=
+ theParams[0]->value.data.lngptr[elem];
+ count ++;
+ }
+ }
+ if (count == 0) {
+ this->value.undef[row] = 1;
+ } else {
+ this->value.undef[row] = 0;
+ this->value.data.dblptr[row] /= count;
+ }
+ }
+ } else if( theParams[0]->type==DOUBLE ){
+ while( row-- ) {
+ int count = 0;
+ this->value.data.dblptr[row] = 0;
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if (theParams[0]->value.undef[elem] == 0) {
+ this->value.data.dblptr[row] +=
+ theParams[0]->value.data.dblptr[elem];
+ count ++;
+ }
+ }
+ if (count == 0) {
+ this->value.undef[row] = 1;
+ } else {
+ this->value.undef[row] = 0;
+ this->value.data.dblptr[row] /= count;
+ }
+ }
+ }
+ break;
+ case stddev_fct:
+ elem = row * theParams[0]->value.nelem;
+ if( theParams[0]->type==LONG ) {
+
+ /* Compute the mean value */
+ while( row-- ) {
+ int count = 0;
+ double sum = 0, sum2 = 0;
+
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if (theParams[0]->value.undef[elem] == 0) {
+ sum += theParams[0]->value.data.lngptr[elem];
+ count ++;
+ }
+ }
+ if (count > 1) {
+ sum /= count;
+
+ /* Compute the sum of squared deviations */
+ nelem = theParams[0]->value.nelem;
+ elem += nelem; /* Reset elem for second pass */
+ while( nelem-- ) {
+ elem--;
+ if (theParams[0]->value.undef[elem] == 0) {
+ double dx = (theParams[0]->value.data.lngptr[elem] - sum);
+ sum2 += (dx*dx);
+ }
+ }
+
+ sum2 /= (double)count-1;
+
+ this->value.undef[row] = 0;
+ this->value.data.dblptr[row] = sqrt(sum2);
+ } else {
+ this->value.undef[row] = 0; /* STDDEV => 0 */
+ this->value.data.dblptr[row] = 0;
+ }
+ }
+ } else if( theParams[0]->type==DOUBLE ){
+
+ /* Compute the mean value */
+ while( row-- ) {
+ int count = 0;
+ double sum = 0, sum2 = 0;
+
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if (theParams[0]->value.undef[elem] == 0) {
+ sum += theParams[0]->value.data.dblptr[elem];
+ count ++;
+ }
+ }
+ if (count > 1) {
+ sum /= count;
+
+ /* Compute the sum of squared deviations */
+ nelem = theParams[0]->value.nelem;
+ elem += nelem; /* Reset elem for second pass */
+ while( nelem-- ) {
+ elem--;
+ if (theParams[0]->value.undef[elem] == 0) {
+ double dx = (theParams[0]->value.data.dblptr[elem] - sum);
+ sum2 += (dx*dx);
+ }
+ }
+
+ sum2 /= (double)count-1;
+
+ this->value.undef[row] = 0;
+ this->value.data.dblptr[row] = sqrt(sum2);
+ } else {
+ this->value.undef[row] = 0; /* STDDEV => 0 */
+ this->value.data.dblptr[row] = 0;
+ }
+ }
+ }
+ break;
+
+ case median_fct:
+ elem = row * theParams[0]->value.nelem;
+ nelem = theParams[0]->value.nelem;
+ if( theParams[0]->type==LONG ) {
+ long *dptr = theParams[0]->value.data.lngptr;
+ char *uptr = theParams[0]->value.undef;
+ long *mptr = (long *) malloc(sizeof(long)*nelem);
+ int irow;
+
+ /* Allocate temporary storage for this row, since the
+ quickselect function will scramble the contents */
+ if (mptr == 0) {
+ fferror("Could not allocate temporary memory in median function");
+ free( this->value.data.ptr );
+ break;
+ }
+
+ for (irow=0; irow<row; irow++) {
+ long *p = mptr;
+ int nelem1 = nelem;
+ int count = 0;
+
+ while ( nelem1-- ) {
+ if (*uptr == 0) {
+ *p++ = *dptr; /* Only advance the dest pointer if we copied */
+ }
+ dptr ++; /* Advance the source pointer ... */
+ uptr ++; /* ... and source "undef" pointer */
+ }
+
+ nelem1 = (p - mptr); /* Number of accepted data points */
+ if (nelem1 > 0) {
+ this->value.undef[irow] = 0;
+ this->value.data.lngptr[irow] = qselect_median_lng(mptr, nelem1);
+ } else {
+ this->value.undef[irow] = 1;
+ this->value.data.lngptr[irow] = 0;
+ }
+
+ }
+
+ free(mptr);
+ } else {
+ double *dptr = theParams[0]->value.data.dblptr;
+ char *uptr = theParams[0]->value.undef;
+ double *mptr = (double *) malloc(sizeof(double)*nelem);
+ int irow;
+
+ /* Allocate temporary storage for this row, since the
+ quickselect function will scramble the contents */
+ if (mptr == 0) {
+ fferror("Could not allocate temporary memory in median function");
+ free( this->value.data.ptr );
+ break;
+ }
+
+ for (irow=0; irow<row; irow++) {
+ double *p = mptr;
+ int nelem1 = nelem;
+
+ while ( nelem1-- ) {
+ if (*uptr == 0) {
+ *p++ = *dptr; /* Only advance the dest pointer if we copied */
+ }
+ dptr ++; /* Advance the source pointer ... */
+ uptr ++; /* ... and source "undef" pointer */
+ }
+
+ nelem1 = (p - mptr); /* Number of accepted data points */
+ if (nelem1 > 0) {
+ this->value.undef[irow] = 0;
+ this->value.data.dblptr[irow] = qselect_median_dbl(mptr, nelem1);
+ } else {
+ this->value.undef[irow] = 1;
+ this->value.data.dblptr[irow] = 0;
+ }
+
+ }
+ free(mptr);
+ }
+ break;
+ case abs_fct:
+ if( theParams[0]->type==DOUBLE )
+ while( elem-- ) {
+ dval = theParams[0]->value.data.dblptr[elem];
+ this->value.data.dblptr[elem] = (dval>0.0 ? dval : -dval);
+ this->value.undef[elem] = theParams[0]->value.undef[elem];
+ }
+ else
+ while( elem-- ) {
+ ival = theParams[0]->value.data.lngptr[elem];
+ this->value.data.lngptr[elem] = (ival> 0 ? ival : -ival);
+ this->value.undef[elem] = theParams[0]->value.undef[elem];
+ }
+ break;
+
+ /* Special Null-Handling Functions */
+
+ case nonnull_fct:
+ nelem = theParams[0]->value.nelem;
+ if ( theParams[0]->type==STRING ) nelem = 1;
+ elem = row * nelem;
+ while( row-- ) {
+ int nelem1 = nelem;
+
+ this->value.undef[row] = 0; /* Initialize to 0 (defined) */
+ this->value.data.lngptr[row] = 0;
+ while( nelem1-- ) {
+ elem --;
+ if ( theParams[0]->value.undef[elem] == 0 ) this->value.data.lngptr[row] ++;
+ }
+ }
+ break;
+ case isnull_fct:
+ if( theParams[0]->type==STRING ) elem = row;
+ while( elem-- ) {
+ this->value.data.logptr[elem] = theParams[0]->value.undef[elem];
+ this->value.undef[elem] = 0;
+ }
+ break;
+ case defnull_fct:
+ switch( this->type ) {
+ case BOOLEAN:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pNull[i] = theParams[i]->value.undef[elem];
+ pVals[i].data.log =
+ theParams[i]->value.data.logptr[elem];
+ } else if( vector[i] ) {
+ pNull[i] = theParams[i]->value.undef[row];
+ pVals[i].data.log =
+ theParams[i]->value.data.logptr[row];
+ }
+ if( pNull[0] ) {
+ this->value.undef[elem] = pNull[1];
+ this->value.data.logptr[elem] = pVals[1].data.log;
+ } else {
+ this->value.undef[elem] = 0;
+ this->value.data.logptr[elem] = pVals[0].data.log;
+ }
+ }
+ }
+ break;
+ case LONG:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pNull[i] = theParams[i]->value.undef[elem];
+ pVals[i].data.lng =
+ theParams[i]->value.data.lngptr[elem];
+ } else if( vector[i] ) {
+ pNull[i] = theParams[i]->value.undef[row];
+ pVals[i].data.lng =
+ theParams[i]->value.data.lngptr[row];
+ }
+ if( pNull[0] ) {
+ this->value.undef[elem] = pNull[1];
+ this->value.data.lngptr[elem] = pVals[1].data.lng;
+ } else {
+ this->value.undef[elem] = 0;
+ this->value.data.lngptr[elem] = pVals[0].data.lng;
+ }
+ }
+ }
+ break;
+ case DOUBLE:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pNull[i] = theParams[i]->value.undef[elem];
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ } else if( vector[i] ) {
+ pNull[i] = theParams[i]->value.undef[row];
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ }
+ if( pNull[0] ) {
+ this->value.undef[elem] = pNull[1];
+ this->value.data.dblptr[elem] = pVals[1].data.dbl;
+ } else {
+ this->value.undef[elem] = 0;
+ this->value.data.dblptr[elem] = pVals[0].data.dbl;
+ }
+ }
+ }
+ break;
+ case STRING:
+ while( row-- ) {
+ i=2; while( i-- )
+ if( vector[i] ) {
+ pNull[i] = theParams[i]->value.undef[row];
+ strcpy(pVals[i].data.str,
+ theParams[i]->value.data.strptr[row]);
+ }
+ if( pNull[0] ) {
+ this->value.undef[row] = pNull[1];
+ strcpy(this->value.data.strptr[row],pVals[1].data.str);
+ } else {
+ this->value.undef[elem] = 0;
+ strcpy(this->value.data.strptr[row],pVals[0].data.str);
+ }
+ }
+ }
+ break;
+
+ /* Math functions with 1 double argument */
+
+ case sin_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ this->value.data.dblptr[elem] =
+ sin( theParams[0]->value.data.dblptr[elem] );
+ }
+ break;
+ case cos_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ this->value.data.dblptr[elem] =
+ cos( theParams[0]->value.data.dblptr[elem] );
+ }
+ break;
+ case tan_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ this->value.data.dblptr[elem] =
+ tan( theParams[0]->value.data.dblptr[elem] );
+ }
+ break;
+ case asin_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ dval = theParams[0]->value.data.dblptr[elem];
+ if( dval<-1.0 || dval>1.0 ) {
+ this->value.data.dblptr[elem] = 0.0;
+ this->value.undef[elem] = 1;
+ } else
+ this->value.data.dblptr[elem] = asin( dval );
+ }
+ break;
+ case acos_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ dval = theParams[0]->value.data.dblptr[elem];
+ if( dval<-1.0 || dval>1.0 ) {
+ this->value.data.dblptr[elem] = 0.0;
+ this->value.undef[elem] = 1;
+ } else
+ this->value.data.dblptr[elem] = acos( dval );
+ }
+ break;
+ case atan_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ dval = theParams[0]->value.data.dblptr[elem];
+ this->value.data.dblptr[elem] = atan( dval );
+ }
+ break;
+ case sinh_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ this->value.data.dblptr[elem] =
+ sinh( theParams[0]->value.data.dblptr[elem] );
+ }
+ break;
+ case cosh_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ this->value.data.dblptr[elem] =
+ cosh( theParams[0]->value.data.dblptr[elem] );
+ }
+ break;
+ case tanh_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ this->value.data.dblptr[elem] =
+ tanh( theParams[0]->value.data.dblptr[elem] );
+ }
+ break;
+ case exp_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ dval = theParams[0]->value.data.dblptr[elem];
+ this->value.data.dblptr[elem] = exp( dval );
+ }
+ break;
+ case log_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ dval = theParams[0]->value.data.dblptr[elem];
+ if( dval<=0.0 ) {
+ this->value.data.dblptr[elem] = 0.0;
+ this->value.undef[elem] = 1;
+ } else
+ this->value.data.dblptr[elem] = log( dval );
+ }
+ break;
+ case log10_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ dval = theParams[0]->value.data.dblptr[elem];
+ if( dval<=0.0 ) {
+ this->value.data.dblptr[elem] = 0.0;
+ this->value.undef[elem] = 1;
+ } else
+ this->value.data.dblptr[elem] = log10( dval );
+ }
+ break;
+ case sqrt_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ dval = theParams[0]->value.data.dblptr[elem];
+ if( dval<0.0 ) {
+ this->value.data.dblptr[elem] = 0.0;
+ this->value.undef[elem] = 1;
+ } else
+ this->value.data.dblptr[elem] = sqrt( dval );
+ }
+ break;
+ case ceil_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ this->value.data.dblptr[elem] =
+ ceil( theParams[0]->value.data.dblptr[elem] );
+ }
+ break;
+ case floor_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ this->value.data.dblptr[elem] =
+ floor( theParams[0]->value.data.dblptr[elem] );
+ }
+ break;
+ case round_fct:
+ while( elem-- )
+ if( !(this->value.undef[elem] = theParams[0]->value.undef[elem]) ) {
+ this->value.data.dblptr[elem] =
+ floor( theParams[0]->value.data.dblptr[elem] + 0.5);
+ }
+ break;
+
+ /* Two-argument Trig Functions */
+
+ case atan2_fct:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[elem] = (pNull[0] || pNull[1]) ) )
+ this->value.data.dblptr[elem] =
+ atan2( pVals[0].data.dbl, pVals[1].data.dbl );
+ }
+ }
+ break;
+
+ /* Four-argument ANGSEP Function */
+
+ case angsep_fct:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=4; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[elem] = (pNull[0] || pNull[1] ||
+ pNull[2] || pNull[3]) ) )
+ this->value.data.dblptr[elem] =
+ angsep_calc(pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl, pVals[3].data.dbl);
+ }
+ }
+ break;
+
+
+
+ /* Min/Max functions taking 1 or 2 arguments */
+
+ case min1_fct:
+ elem = row * theParams[0]->value.nelem;
+ if( this->type==LONG ) {
+ long minVal=0;
+ while( row-- ) {
+ valInit = 1;
+ this->value.undef[row] = 1;
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if ( !theParams[0]->value.undef[elem] ) {
+ if ( valInit ) {
+ valInit = 0;
+ minVal = theParams[0]->value.data.lngptr[elem];
+ } else {
+ minVal = minvalue( minVal,
+ theParams[0]->value.data.lngptr[elem] );
+ }
+ this->value.undef[row] = 0;
+ }
+ }
+ this->value.data.lngptr[row] = minVal;
+ }
+ } else if( this->type==DOUBLE ) {
+ double minVal=0.0;
+ while( row-- ) {
+ valInit = 1;
+ this->value.undef[row] = 1;
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if ( !theParams[0]->value.undef[elem] ) {
+ if ( valInit ) {
+ valInit = 0;
+ minVal = theParams[0]->value.data.dblptr[elem];
+ } else {
+ minVal = minvalue( minVal,
+ theParams[0]->value.data.dblptr[elem] );
+ }
+ this->value.undef[row] = 0;
+ }
+ }
+ this->value.data.dblptr[row] = minVal;
+ }
+ } else if( this->type==BITSTR ) {
+ char minVal;
+ while( row-- ) {
+ char *sptr1 = theParams[0]->value.data.strptr[row];
+ minVal = '1';
+ while (*sptr1) {
+ if (*sptr1 == '0') minVal = '0';
+ sptr1++;
+ }
+ this->value.data.strptr[row][0] = minVal;
+ this->value.data.strptr[row][1] = 0; /* Null terminate */
+ }
+ }
+ break;
+ case min2_fct:
+ if( this->type==LONG ) {
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.lng =
+ theParams[i]->value.data.lngptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.lng =
+ theParams[i]->value.data.lngptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( pNull[0] && pNull[1] ) {
+ this->value.undef[elem] = 1;
+ this->value.data.lngptr[elem] = 0;
+ } else if (pNull[0]) {
+ this->value.undef[elem] = 0;
+ this->value.data.lngptr[elem] = pVals[1].data.lng;
+ } else if (pNull[1]) {
+ this->value.undef[elem] = 0;
+ this->value.data.lngptr[elem] = pVals[0].data.lng;
+ } else {
+ this->value.undef[elem] = 0;
+ this->value.data.lngptr[elem] =
+ minvalue( pVals[0].data.lng, pVals[1].data.lng );
+ }
+ }
+ }
+ } else if( this->type==DOUBLE ) {
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( pNull[0] && pNull[1] ) {
+ this->value.undef[elem] = 1;
+ this->value.data.dblptr[elem] = 0;
+ } else if (pNull[0]) {
+ this->value.undef[elem] = 0;
+ this->value.data.dblptr[elem] = pVals[1].data.dbl;
+ } else if (pNull[1]) {
+ this->value.undef[elem] = 0;
+ this->value.data.dblptr[elem] = pVals[0].data.dbl;
+ } else {
+ this->value.undef[elem] = 0;
+ this->value.data.dblptr[elem] =
+ minvalue( pVals[0].data.dbl, pVals[1].data.dbl );
+ }
+ }
+ }
+ }
+ break;
+
+ case max1_fct:
+ elem = row * theParams[0]->value.nelem;
+ if( this->type==LONG ) {
+ long maxVal=0;
+ while( row-- ) {
+ valInit = 1;
+ this->value.undef[row] = 1;
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if ( !theParams[0]->value.undef[elem] ) {
+ if ( valInit ) {
+ valInit = 0;
+ maxVal = theParams[0]->value.data.lngptr[elem];
+ } else {
+ maxVal = maxvalue( maxVal,
+ theParams[0]->value.data.lngptr[elem] );
+ }
+ this->value.undef[row] = 0;
+ }
+ }
+ this->value.data.lngptr[row] = maxVal;
+ }
+ } else if( this->type==DOUBLE ) {
+ double maxVal=0.0;
+ while( row-- ) {
+ valInit = 1;
+ this->value.undef[row] = 1;
+ nelem = theParams[0]->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if ( !theParams[0]->value.undef[elem] ) {
+ if ( valInit ) {
+ valInit = 0;
+ maxVal = theParams[0]->value.data.dblptr[elem];
+ } else {
+ maxVal = maxvalue( maxVal,
+ theParams[0]->value.data.dblptr[elem] );
+ }
+ this->value.undef[row] = 0;
+ }
+ }
+ this->value.data.dblptr[row] = maxVal;
+ }
+ } else if( this->type==BITSTR ) {
+ char maxVal;
+ while( row-- ) {
+ char *sptr1 = theParams[0]->value.data.strptr[row];
+ maxVal = '0';
+ while (*sptr1) {
+ if (*sptr1 == '1') maxVal = '1';
+ sptr1++;
+ }
+ this->value.data.strptr[row][0] = maxVal;
+ this->value.data.strptr[row][1] = 0; /* Null terminate */
+ }
+ }
+ break;
+ case max2_fct:
+ if( this->type==LONG ) {
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.lng =
+ theParams[i]->value.data.lngptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.lng =
+ theParams[i]->value.data.lngptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( pNull[0] && pNull[1] ) {
+ this->value.undef[elem] = 1;
+ this->value.data.lngptr[elem] = 0;
+ } else if (pNull[0]) {
+ this->value.undef[elem] = 0;
+ this->value.data.lngptr[elem] = pVals[1].data.lng;
+ } else if (pNull[1]) {
+ this->value.undef[elem] = 0;
+ this->value.data.lngptr[elem] = pVals[0].data.lng;
+ } else {
+ this->value.undef[elem] = 0;
+ this->value.data.lngptr[elem] =
+ maxvalue( pVals[0].data.lng, pVals[1].data.lng );
+ }
+ }
+ }
+ } else if( this->type==DOUBLE ) {
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( pNull[0] && pNull[1] ) {
+ this->value.undef[elem] = 1;
+ this->value.data.dblptr[elem] = 0;
+ } else if (pNull[0]) {
+ this->value.undef[elem] = 0;
+ this->value.data.dblptr[elem] = pVals[1].data.dbl;
+ } else if (pNull[1]) {
+ this->value.undef[elem] = 0;
+ this->value.data.dblptr[elem] = pVals[0].data.dbl;
+ } else {
+ this->value.undef[elem] = 0;
+ this->value.data.dblptr[elem] =
+ maxvalue( pVals[0].data.dbl, pVals[1].data.dbl );
+ }
+ }
+ }
+ }
+ break;
+
+ /* Boolean SAO region Functions... scalar or vector dbls */
+
+ case near_fct:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=3; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[elem] = (pNull[0] || pNull[1] ||
+ pNull[2]) ) )
+ this->value.data.logptr[elem] =
+ bnear( pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl );
+ }
+ }
+ break;
+
+ case circle_fct:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=5; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[elem] = (pNull[0] || pNull[1] ||
+ pNull[2] || pNull[3] ||
+ pNull[4]) ) )
+ this->value.data.logptr[elem] =
+ circle( pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl, pVals[3].data.dbl,
+ pVals[4].data.dbl );
+ }
+ }
+ break;
+
+ case box_fct:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=7; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[elem] = (pNull[0] || pNull[1] ||
+ pNull[2] || pNull[3] ||
+ pNull[4] || pNull[5] ||
+ pNull[6] ) ) )
+ this->value.data.logptr[elem] =
+ saobox( pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl, pVals[3].data.dbl,
+ pVals[4].data.dbl, pVals[5].data.dbl,
+ pVals[6].data.dbl );
+ }
+ }
+ break;
+
+ case elps_fct:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ i=7; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[elem] = (pNull[0] || pNull[1] ||
+ pNull[2] || pNull[3] ||
+ pNull[4] || pNull[5] ||
+ pNull[6] ) ) )
+ this->value.data.logptr[elem] =
+ ellipse( pVals[0].data.dbl, pVals[1].data.dbl,
+ pVals[2].data.dbl, pVals[3].data.dbl,
+ pVals[4].data.dbl, pVals[5].data.dbl,
+ pVals[6].data.dbl );
+ }
+ }
+ break;
+
+ /* C Conditional expression: bool ? expr : expr */
+
+ case ifthenelse_fct:
+ switch( this->type ) {
+ case BOOLEAN:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if( vector[2]>1 ) {
+ pVals[2].data.log =
+ theParams[2]->value.data.logptr[elem];
+ pNull[2] = theParams[2]->value.undef[elem];
+ } else if( vector[2] ) {
+ pVals[2].data.log =
+ theParams[2]->value.data.logptr[row];
+ pNull[2] = theParams[2]->value.undef[row];
+ }
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.log =
+ theParams[i]->value.data.logptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.log =
+ theParams[i]->value.data.logptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[elem] = pNull[2]) ) {
+ if( pVals[2].data.log ) {
+ this->value.data.logptr[elem] = pVals[0].data.log;
+ this->value.undef[elem] = pNull[0];
+ } else {
+ this->value.data.logptr[elem] = pVals[1].data.log;
+ this->value.undef[elem] = pNull[1];
+ }
+ }
+ }
+ }
+ break;
+ case LONG:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if( vector[2]>1 ) {
+ pVals[2].data.log =
+ theParams[2]->value.data.logptr[elem];
+ pNull[2] = theParams[2]->value.undef[elem];
+ } else if( vector[2] ) {
+ pVals[2].data.log =
+ theParams[2]->value.data.logptr[row];
+ pNull[2] = theParams[2]->value.undef[row];
+ }
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.lng =
+ theParams[i]->value.data.lngptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.lng =
+ theParams[i]->value.data.lngptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[elem] = pNull[2]) ) {
+ if( pVals[2].data.log ) {
+ this->value.data.lngptr[elem] = pVals[0].data.lng;
+ this->value.undef[elem] = pNull[0];
+ } else {
+ this->value.data.lngptr[elem] = pVals[1].data.lng;
+ this->value.undef[elem] = pNull[1];
+ }
+ }
+ }
+ }
+ break;
+ case DOUBLE:
+ while( row-- ) {
+ nelem = this->value.nelem;
+ while( nelem-- ) {
+ elem--;
+ if( vector[2]>1 ) {
+ pVals[2].data.log =
+ theParams[2]->value.data.logptr[elem];
+ pNull[2] = theParams[2]->value.undef[elem];
+ } else if( vector[2] ) {
+ pVals[2].data.log =
+ theParams[2]->value.data.logptr[row];
+ pNull[2] = theParams[2]->value.undef[row];
+ }
+ i=2; while( i-- )
+ if( vector[i]>1 ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[elem];
+ pNull[i] = theParams[i]->value.undef[elem];
+ } else if( vector[i] ) {
+ pVals[i].data.dbl =
+ theParams[i]->value.data.dblptr[row];
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[elem] = pNull[2]) ) {
+ if( pVals[2].data.log ) {
+ this->value.data.dblptr[elem] = pVals[0].data.dbl;
+ this->value.undef[elem] = pNull[0];
+ } else {
+ this->value.data.dblptr[elem] = pVals[1].data.dbl;
+ this->value.undef[elem] = pNull[1];
+ }
+ }
+ }
+ }
+ break;
+ case STRING:
+ while( row-- ) {
+ if( vector[2] ) {
+ pVals[2].data.log = theParams[2]->value.data.logptr[row];
+ pNull[2] = theParams[2]->value.undef[row];
+ }
+ i=2; while( i-- )
+ if( vector[i] ) {
+ strcpy( pVals[i].data.str,
+ theParams[i]->value.data.strptr[row] );
+ pNull[i] = theParams[i]->value.undef[row];
+ }
+ if( !(this->value.undef[row] = pNull[2]) ) {
+ if( pVals[2].data.log ) {
+ strcpy( this->value.data.strptr[row],
+ pVals[0].data.str );
+ this->value.undef[row] = pNull[0];
+ } else {
+ strcpy( this->value.data.strptr[row],
+ pVals[1].data.str );
+ this->value.undef[row] = pNull[1];
+ }
+ } else {
+ this->value.data.strptr[row][0] = '\0';
+ }
+ }
+ break;
+
+ }
+ break;
+
+ /* String functions */
+ case strmid_fct:
+ {
+ int strconst = theParams[0]->operation == CONST_OP;
+ int posconst = theParams[1]->operation == CONST_OP;
+ int lenconst = theParams[2]->operation == CONST_OP;
+ int dest_len = this->value.nelem;
+ int src_len = theParams[0]->value.nelem;
+
+ while (row--) {
+ int pos;
+ int len;
+ char *str;
+ int undef = 0;
+
+ if (posconst) {
+ pos = theParams[1]->value.data.lng;
+ } else {
+ pos = theParams[1]->value.data.lngptr[row];
+ if (theParams[1]->value.undef[row]) undef = 1;
+ }
+ if (strconst) {
+ str = theParams[0]->value.data.str;
+ if (src_len == 0) src_len = strlen(str);
+ } else {
+ str = theParams[0]->value.data.strptr[row];
+ if (theParams[0]->value.undef[row]) undef = 1;
+ }
+ if (lenconst) {
+ len = dest_len;
+ } else {
+ len = theParams[2]->value.data.lngptr[row];
+ if (theParams[2]->value.undef[row]) undef = 1;
+ }
+ this->value.data.strptr[row][0] = '\0';
+ if (pos == 0) undef = 1;
+ if (! undef ) {
+ if (cstrmid(this->value.data.strptr[row], len,
+ str, src_len, pos) < 0) break;
+ }
+ this->value.undef[row] = undef;
+ }
+ }
+ break;
+
+ /* String functions */
+ case strpos_fct:
+ {
+ int const1 = theParams[0]->operation == CONST_OP;
+ int const2 = theParams[1]->operation == CONST_OP;
+
+ while (row--) {
+ char *str1, *str2;
+ int undef = 0;
+
+ if (const1) {
+ str1 = theParams[0]->value.data.str;
+ } else {
+ str1 = theParams[0]->value.data.strptr[row];
+ if (theParams[0]->value.undef[row]) undef = 1;
+ }
+ if (const2) {
+ str2 = theParams[1]->value.data.str;
+ } else {
+ str2 = theParams[1]->value.data.strptr[row];
+ if (theParams[1]->value.undef[row]) undef = 1;
+ }
+ this->value.data.lngptr[row] = 0;
+ if (! undef ) {
+ char *res = strstr(str1, str2);
+ if (res == NULL) {
+ undef = 1;
+ this->value.data.lngptr[row] = 0;
+ } else {
+ this->value.data.lngptr[row] = (res - str1) + 1;
+ }
+ }
+ this->value.undef[row] = undef;
+ }
+ }
+ break;
+
+
+ } /* End switch(this->operation) */
+ } /* End if (!gParse.status) */
+ } /* End non-constant operations */
+
+ i = this->nSubNodes;
+ while( i-- ) {
+ if( theParams[i]->operation>0 ) {
+ /* Currently only numeric params allowed */
+ free( theParams[i]->value.data.ptr );
+ }
+ }
+}
+
+static void Do_Deref( Node *this )
+{
+ Node *theVar, *theDims[MAXDIMS];
+ int isConst[MAXDIMS], allConst;
+ long dimVals[MAXDIMS];
+ int i, nDims;
+ long row, elem, dsize;
+
+ theVar = gParse.Nodes + this->SubNodes[0];
+
+ i = nDims = this->nSubNodes-1;
+ allConst = 1;
+ while( i-- ) {
+ theDims[i] = gParse.Nodes + this->SubNodes[i+1];
+ isConst[i] = ( theDims[i]->operation==CONST_OP );
+ if( isConst[i] )
+ dimVals[i] = theDims[i]->value.data.lng;
+ else
+ allConst = 0;
+ }
+
+ if( this->type==DOUBLE ) {
+ dsize = sizeof( double );
+ } else if( this->type==LONG ) {
+ dsize = sizeof( long );
+ } else if( this->type==BOOLEAN ) {
+ dsize = sizeof( char );
+ } else
+ dsize = 0;
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+
+ if( allConst && theVar->value.naxis==nDims ) {
+
+ /* Dereference completely using constant indices */
+
+ elem = 0;
+ i = nDims;
+ while( i-- ) {
+ if( dimVals[i]<1 || dimVals[i]>theVar->value.naxes[i] ) break;
+ elem = theVar->value.naxes[i]*elem + dimVals[i]-1;
+ }
+ if( i<0 ) {
+ for( row=0; row<gParse.nRows; row++ ) {
+ if( this->type==STRING )
+ this->value.undef[row] = theVar->value.undef[row];
+ else if( this->type==BITSTR )
+ this->value.undef; /* Dummy - BITSTRs do not have undefs */
+ else
+ this->value.undef[row] = theVar->value.undef[elem];
+
+ if( this->type==DOUBLE )
+ this->value.data.dblptr[row] =
+ theVar->value.data.dblptr[elem];
+ else if( this->type==LONG )
+ this->value.data.lngptr[row] =
+ theVar->value.data.lngptr[elem];
+ else if( this->type==BOOLEAN )
+ this->value.data.logptr[row] =
+ theVar->value.data.logptr[elem];
+ else {
+ /* XXX Note, the below expression uses knowledge of
+ the layout of the string format, namely (nelem+1)
+ characters per string, followed by (nelem+1)
+ "undef" values. */
+ this->value.data.strptr[row][0] =
+ theVar->value.data.strptr[0][elem+row];
+ this->value.data.strptr[row][1] = 0; /* Null terminate */
+ }
+ elem += theVar->value.nelem;
+ }
+ } else {
+ fferror("Index out of range");
+ free( this->value.data.ptr );
+ }
+
+ } else if( allConst && nDims==1 ) {
+
+ /* Reduce dimensions by 1, using a constant index */
+
+ if( dimVals[0] < 1 ||
+ dimVals[0] > theVar->value.naxes[ theVar->value.naxis-1 ] ) {
+ fferror("Index out of range");
+ free( this->value.data.ptr );
+ } else if ( this->type == BITSTR || this->type == STRING ) {
+ elem = this->value.nelem * (dimVals[0]-1);
+ for( row=0; row<gParse.nRows; row++ ) {
+ if (this->value.undef)
+ this->value.undef[row] = theVar->value.undef[row];
+ memcpy( (char*)this->value.data.strptr[0]
+ + row*sizeof(char)*(this->value.nelem+1),
+ (char*)theVar->value.data.strptr[0] + elem*sizeof(char),
+ this->value.nelem * sizeof(char) );
+ /* Null terminate */
+ this->value.data.strptr[row][this->value.nelem] = 0;
+ elem += theVar->value.nelem+1;
+ }
+ } else {
+ elem = this->value.nelem * (dimVals[0]-1);
+ for( row=0; row<gParse.nRows; row++ ) {
+ memcpy( this->value.undef + row*this->value.nelem,
+ theVar->value.undef + elem,
+ this->value.nelem * sizeof(char) );
+ memcpy( (char*)this->value.data.ptr
+ + row*dsize*this->value.nelem,
+ (char*)theVar->value.data.ptr + elem*dsize,
+ this->value.nelem * dsize );
+ elem += theVar->value.nelem;
+ }
+ }
+
+ } else if( theVar->value.naxis==nDims ) {
+
+ /* Dereference completely using an expression for the indices */
+
+ for( row=0; row<gParse.nRows; row++ ) {
+
+ for( i=0; i<nDims; i++ ) {
+ if( !isConst[i] ) {
+ if( theDims[i]->value.undef[row] ) {
+ fferror("Null encountered as vector index");
+ free( this->value.data.ptr );
+ break;
+ } else
+ dimVals[i] = theDims[i]->value.data.lngptr[row];
+ }
+ }
+ if( gParse.status ) break;
+
+ elem = 0;
+ i = nDims;
+ while( i-- ) {
+ if( dimVals[i]<1 || dimVals[i]>theVar->value.naxes[i] ) break;
+ elem = theVar->value.naxes[i]*elem + dimVals[i]-1;
+ }
+ if( i<0 ) {
+ elem += row*theVar->value.nelem;
+
+ if( this->type==STRING )
+ this->value.undef[row] = theVar->value.undef[row];
+ else if( this->type==BITSTR )
+ this->value.undef; /* Dummy - BITSTRs do not have undefs */
+ else
+ this->value.undef[row] = theVar->value.undef[elem];
+
+ if( this->type==DOUBLE )
+ this->value.data.dblptr[row] =
+ theVar->value.data.dblptr[elem];
+ else if( this->type==LONG )
+ this->value.data.lngptr[row] =
+ theVar->value.data.lngptr[elem];
+ else if( this->type==BOOLEAN )
+ this->value.data.logptr[row] =
+ theVar->value.data.logptr[elem];
+ else {
+ /* XXX Note, the below expression uses knowledge of
+ the layout of the string format, namely (nelem+1)
+ characters per string, followed by (nelem+1)
+ "undef" values. */
+ this->value.data.strptr[row][0] =
+ theVar->value.data.strptr[0][elem+row];
+ this->value.data.strptr[row][1] = 0; /* Null terminate */
+ }
+ } else {
+ fferror("Index out of range");
+ free( this->value.data.ptr );
+ }
+ }
+
+ } else {
+
+ /* Reduce dimensions by 1, using a nonconstant expression */
+
+ for( row=0; row<gParse.nRows; row++ ) {
+
+ /* Index cannot be a constant */
+
+ if( theDims[0]->value.undef[row] ) {
+ fferror("Null encountered as vector index");
+ free( this->value.data.ptr );
+ break;
+ } else
+ dimVals[0] = theDims[0]->value.data.lngptr[row];
+
+ if( dimVals[0] < 1 ||
+ dimVals[0] > theVar->value.naxes[ theVar->value.naxis-1 ] ) {
+ fferror("Index out of range");
+ free( this->value.data.ptr );
+ } else if ( this->type == BITSTR || this->type == STRING ) {
+ elem = this->value.nelem * (dimVals[0]-1);
+ elem += row*(theVar->value.nelem+1);
+ if (this->value.undef)
+ this->value.undef[row] = theVar->value.undef[row];
+ memcpy( (char*)this->value.data.strptr[0]
+ + row*sizeof(char)*(this->value.nelem+1),
+ (char*)theVar->value.data.strptr[0] + elem*sizeof(char),
+ this->value.nelem * sizeof(char) );
+ /* Null terminate */
+ this->value.data.strptr[row][this->value.nelem] = 0;
+ } else {
+ elem = this->value.nelem * (dimVals[0]-1);
+ elem += row*theVar->value.nelem;
+ memcpy( this->value.undef + row*this->value.nelem,
+ theVar->value.undef + elem,
+ this->value.nelem * sizeof(char) );
+ memcpy( (char*)this->value.data.ptr
+ + row*dsize*this->value.nelem,
+ (char*)theVar->value.data.ptr + elem*dsize,
+ this->value.nelem * dsize );
+ }
+ }
+ }
+ }
+
+ if( theVar->operation>0 ) {
+ if (theVar->type == STRING || theVar->type == BITSTR)
+ free(theVar->value.data.strptr[0] );
+ else
+ free( theVar->value.data.ptr );
+ }
+ for( i=0; i<nDims; i++ )
+ if( theDims[i]->operation>0 ) {
+ free( theDims[i]->value.data.ptr );
+ }
+}
+
+static void Do_GTI( Node *this )
+{
+ Node *theExpr, *theTimes;
+ double *start, *stop, *times;
+ long elem, nGTI, gti;
+ int ordered;
+
+ theTimes = gParse.Nodes + this->SubNodes[0];
+ theExpr = gParse.Nodes + this->SubNodes[1];
+
+ nGTI = theTimes->value.nelem;
+ start = theTimes->value.data.dblptr;
+ stop = theTimes->value.data.dblptr + nGTI;
+ ordered = theTimes->type;
+
+ if( theExpr->operation==CONST_OP ) {
+
+ this->value.data.log =
+ (Search_GTI( theExpr->value.data.dbl, nGTI, start, stop, ordered )>=0);
+ this->operation = CONST_OP;
+
+ } else {
+
+ Allocate_Ptrs( this );
+
+ times = theExpr->value.data.dblptr;
+ if( !gParse.status ) {
+
+ elem = gParse.nRows * this->value.nelem;
+ if( nGTI ) {
+ gti = -1;
+ while( elem-- ) {
+ if( (this->value.undef[elem] = theExpr->value.undef[elem]) )
+ continue;
+
+ /* Before searching entire GTI, check the GTI found last time */
+ if( gti<0 || times[elem]<start[gti] || times[elem]>stop[gti] ) {
+ gti = Search_GTI( times[elem], nGTI, start, stop, ordered );
+ }
+ this->value.data.logptr[elem] = ( gti>=0 );
+ }
+ } else
+ while( elem-- ) {
+ this->value.data.logptr[elem] = 0;
+ this->value.undef[elem] = 0;
+ }
+ }
+ }
+
+ if( theExpr->operation>0 )
+ free( theExpr->value.data.ptr );
+}
+
+static long Search_GTI( double evtTime, long nGTI, double *start,
+ double *stop, int ordered )
+{
+ long gti, step;
+
+ if( ordered && nGTI>15 ) { /* If time-ordered and lots of GTIs, */
+ /* use "FAST" Binary search algorithm */
+ if( evtTime>=start[0] && evtTime<=stop[nGTI-1] ) {
+ gti = step = (nGTI >> 1);
+ while(1) {
+ if( step>1L ) step >>= 1;
+
+ if( evtTime>stop[gti] ) {
+ if( evtTime>=start[gti+1] )
+ gti += step;
+ else {
+ gti = -1L;
+ break;
+ }
+ } else if( evtTime<start[gti] ) {
+ if( evtTime<=stop[gti-1] )
+ gti -= step;
+ else {
+ gti = -1L;
+ break;
+ }
+ } else {
+ break;
+ }
+ }
+ } else
+ gti = -1L;
+
+ } else { /* Use "SLOW" linear search */
+ gti = nGTI;
+ while( gti-- )
+ if( evtTime>=start[gti] && evtTime<=stop[gti] )
+ break;
+ }
+ return( gti );
+}
+
+static void Do_REG( Node *this )
+{
+ Node *theRegion, *theX, *theY;
+ double Xval=0.0, Yval=0.0;
+ char Xnull=0, Ynull=0;
+ int Xvector, Yvector;
+ long nelem, elem, rows;
+
+ theRegion = gParse.Nodes + this->SubNodes[0];
+ theX = gParse.Nodes + this->SubNodes[1];
+ theY = gParse.Nodes + this->SubNodes[2];
+
+ Xvector = ( theX->operation!=CONST_OP );
+ if( Xvector )
+ Xvector = theX->value.nelem;
+ else {
+ Xval = theX->value.data.dbl;
+ }
+
+ Yvector = ( theY->operation!=CONST_OP );
+ if( Yvector )
+ Yvector = theY->value.nelem;
+ else {
+ Yval = theY->value.data.dbl;
+ }
+
+ if( !Xvector && !Yvector ) {
+
+ this->value.data.log =
+ ( fits_in_region( Xval, Yval, (SAORegion *)theRegion->value.data.ptr )
+ != 0 );
+ this->operation = CONST_OP;
+
+ } else {
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+
+ rows = gParse.nRows;
+ nelem = this->value.nelem;
+ elem = rows*nelem;
+
+ while( rows-- ) {
+ while( nelem-- ) {
+ elem--;
+
+ if( Xvector>1 ) {
+ Xval = theX->value.data.dblptr[elem];
+ Xnull = theX->value.undef[elem];
+ } else if( Xvector ) {
+ Xval = theX->value.data.dblptr[rows];
+ Xnull = theX->value.undef[rows];
+ }
+
+ if( Yvector>1 ) {
+ Yval = theY->value.data.dblptr[elem];
+ Ynull = theY->value.undef[elem];
+ } else if( Yvector ) {
+ Yval = theY->value.data.dblptr[rows];
+ Ynull = theY->value.undef[rows];
+ }
+
+ this->value.undef[elem] = ( Xnull || Ynull );
+ if( this->value.undef[elem] )
+ continue;
+
+ this->value.data.logptr[elem] =
+ ( fits_in_region( Xval, Yval,
+ (SAORegion *)theRegion->value.data.ptr )
+ != 0 );
+ }
+ nelem = this->value.nelem;
+ }
+ }
+ }
+
+ if( theX->operation>0 )
+ free( theX->value.data.ptr );
+ if( theY->operation>0 )
+ free( theY->value.data.ptr );
+}
+
+static void Do_Vector( Node *this )
+{
+ Node *that;
+ long row, elem, idx, jdx, offset=0;
+ int node;
+
+ Allocate_Ptrs( this );
+
+ if( !gParse.status ) {
+
+ for( node=0; node<this->nSubNodes; node++ ) {
+
+ that = gParse.Nodes + this->SubNodes[node];
+
+ if( that->operation == CONST_OP ) {
+
+ idx = gParse.nRows*this->value.nelem + offset;
+ while( (idx-=this->value.nelem)>=0 ) {
+
+ this->value.undef[idx] = 0;
+
+ switch( this->type ) {
+ case BOOLEAN:
+ this->value.data.logptr[idx] = that->value.data.log;
+ break;
+ case LONG:
+ this->value.data.lngptr[idx] = that->value.data.lng;
+ break;
+ case DOUBLE:
+ this->value.data.dblptr[idx] = that->value.data.dbl;
+ break;
+ }
+ }
+
+ } else {
+
+ row = gParse.nRows;
+ idx = row * that->value.nelem;
+ while( row-- ) {
+ elem = that->value.nelem;
+ jdx = row*this->value.nelem + offset;
+ while( elem-- ) {
+ this->value.undef[jdx+elem] =
+ that->value.undef[--idx];
+
+ switch( this->type ) {
+ case BOOLEAN:
+ this->value.data.logptr[jdx+elem] =
+ that->value.data.logptr[idx];
+ break;
+ case LONG:
+ this->value.data.lngptr[jdx+elem] =
+ that->value.data.lngptr[idx];
+ break;
+ case DOUBLE:
+ this->value.data.dblptr[jdx+elem] =
+ that->value.data.dblptr[idx];
+ break;
+ }
+ }
+ }
+ }
+ offset += that->value.nelem;
+ }
+
+ }
+
+ for( node=0; node < this->nSubNodes; node++ )
+ if( OPER(this->SubNodes[node])>0 )
+ free( gParse.Nodes[this->SubNodes[node]].value.data.ptr );
+}
+
+/*****************************************************************************/
+/* Utility routines which perform the calculations on bits and SAO regions */
+/*****************************************************************************/
+
+static char bitlgte(char *bits1, int oper, char *bits2)
+{
+ int val1, val2, nextbit;
+ char result;
+ int i, l1, l2, length, ldiff;
+ char stream[256];
+ char chr1, chr2;
+
+ l1 = strlen(bits1);
+ l2 = strlen(bits2);
+ if (l1 < l2)
+ {
+ length = l2;
+ ldiff = l2 - l1;
+ i=0;
+ while( ldiff-- ) stream[i++] = '0';
+ while( l1-- ) stream[i++] = *(bits1++);
+ stream[i] = '\0';
+ bits1 = stream;
+ }
+ else if (l2 < l1)
+ {
+ length = l1;
+ ldiff = l1 - l2;
+ i=0;
+ while( ldiff-- ) stream[i++] = '0';
+ while( l2-- ) stream[i++] = *(bits2++);
+ stream[i] = '\0';
+ bits2 = stream;
+ }
+ else
+ length = l1;
+
+ val1 = val2 = 0;
+ nextbit = 1;
+
+ while( length-- )
+ {
+ chr1 = bits1[length];
+ chr2 = bits2[length];
+ if ((chr1 != 'x')&&(chr1 != 'X')&&(chr2 != 'x')&&(chr2 != 'X'))
+ {
+ if (chr1 == '1') val1 += nextbit;
+ if (chr2 == '1') val2 += nextbit;
+ nextbit *= 2;
+ }
+ }
+ result = 0;
+ switch (oper)
+ {
+ case LT:
+ if (val1 < val2) result = 1;
+ break;
+ case LTE:
+ if (val1 <= val2) result = 1;
+ break;
+ case GT:
+ if (val1 > val2) result = 1;
+ break;
+ case GTE:
+ if (val1 >= val2) result = 1;
+ break;
+ }
+ return (result);
+}
+
+static void bitand(char *result,char *bitstrm1,char *bitstrm2)
+{
+ int i, l1, l2, ldiff;
+ char stream[256];
+ char chr1, chr2;
+
+ l1 = strlen(bitstrm1);
+ l2 = strlen(bitstrm2);
+ if (l1 < l2)
+ {
+ ldiff = l2 - l1;
+ i=0;
+ while( ldiff-- ) stream[i++] = '0';
+ while( l1-- ) stream[i++] = *(bitstrm1++);
+ stream[i] = '\0';
+ bitstrm1 = stream;
+ }
+ else if (l2 < l1)
+ {
+ ldiff = l1 - l2;
+ i=0;
+ while( ldiff-- ) stream[i++] = '0';
+ while( l2-- ) stream[i++] = *(bitstrm2++);
+ stream[i] = '\0';
+ bitstrm2 = stream;
+ }
+ while ( (chr1 = *(bitstrm1++)) )
+ {
+ chr2 = *(bitstrm2++);
+ if ((chr1 == 'x') || (chr2 == 'x'))
+ *result = 'x';
+ else if ((chr1 == '1') && (chr2 == '1'))
+ *result = '1';
+ else
+ *result = '0';
+ result++;
+ }
+ *result = '\0';
+}
+
+static void bitor(char *result,char *bitstrm1,char *bitstrm2)
+{
+ int i, l1, l2, ldiff;
+ char stream[256];
+ char chr1, chr2;
+
+ l1 = strlen(bitstrm1);
+ l2 = strlen(bitstrm2);
+ if (l1 < l2)
+ {
+ ldiff = l2 - l1;
+ i=0;
+ while( ldiff-- ) stream[i++] = '0';
+ while( l1-- ) stream[i++] = *(bitstrm1++);
+ stream[i] = '\0';
+ bitstrm1 = stream;
+ }
+ else if (l2 < l1)
+ {
+ ldiff = l1 - l2;
+ i=0;
+ while( ldiff-- ) stream[i++] = '0';
+ while( l2-- ) stream[i++] = *(bitstrm2++);
+ stream[i] = '\0';
+ bitstrm2 = stream;
+ }
+ while ( (chr1 = *(bitstrm1++)) )
+ {
+ chr2 = *(bitstrm2++);
+ if ((chr1 == '1') || (chr2 == '1'))
+ *result = '1';
+ else if ((chr1 == '0') || (chr2 == '0'))
+ *result = '0';
+ else
+ *result = 'x';
+ result++;
+ }
+ *result = '\0';
+}
+
+static void bitnot(char *result,char *bits)
+{
+ int length;
+ char chr;
+
+ length = strlen(bits);
+ while( length-- ) {
+ chr = *(bits++);
+ *(result++) = ( chr=='1' ? '0' : ( chr=='0' ? '1' : chr ) );
+ }
+ *result = '\0';
+}
+
+static char bitcmp(char *bitstrm1, char *bitstrm2)
+{
+ int i, l1, l2, ldiff;
+ char stream[256];
+ char chr1, chr2;
+
+ l1 = strlen(bitstrm1);
+ l2 = strlen(bitstrm2);
+ if (l1 < l2)
+ {
+ ldiff = l2 - l1;
+ i=0;
+ while( ldiff-- ) stream[i++] = '0';
+ while( l1-- ) stream[i++] = *(bitstrm1++);
+ stream[i] = '\0';
+ bitstrm1 = stream;
+ }
+ else if (l2 < l1)
+ {
+ ldiff = l1 - l2;
+ i=0;
+ while( ldiff-- ) stream[i++] = '0';
+ while( l2-- ) stream[i++] = *(bitstrm2++);
+ stream[i] = '\0';
+ bitstrm2 = stream;
+ }
+ while( (chr1 = *(bitstrm1++)) )
+ {
+ chr2 = *(bitstrm2++);
+ if ( ((chr1 == '0') && (chr2 == '1'))
+ || ((chr1 == '1') && (chr2 == '0')) )
+ return( 0 );
+ }
+ return( 1 );
+}
+
+static char bnear(double x, double y, double tolerance)
+{
+ if (fabs(x - y) < tolerance)
+ return ( 1 );
+ else
+ return ( 0 );
+}
+
+static char saobox(double xcen, double ycen, double xwid, double ywid,
+ double rot, double xcol, double ycol)
+{
+ double x,y,xprime,yprime,xmin,xmax,ymin,ymax,theta;
+
+ theta = (rot / 180.0) * myPI;
+ xprime = xcol - xcen;
+ yprime = ycol - ycen;
+ x = xprime * cos(theta) + yprime * sin(theta);
+ y = -xprime * sin(theta) + yprime * cos(theta);
+ xmin = - 0.5 * xwid; xmax = 0.5 * xwid;
+ ymin = - 0.5 * ywid; ymax = 0.5 * ywid;
+ if ((x >= xmin) && (x <= xmax) && (y >= ymin) && (y <= ymax))
+ return ( 1 );
+ else
+ return ( 0 );
+}
+
+static char circle(double xcen, double ycen, double rad,
+ double xcol, double ycol)
+{
+ double r2,dx,dy,dlen;
+
+ dx = xcol - xcen;
+ dy = ycol - ycen;
+ dx *= dx; dy *= dy;
+ dlen = dx + dy;
+ r2 = rad * rad;
+ if (dlen <= r2)
+ return ( 1 );
+ else
+ return ( 0 );
+}
+
+static char ellipse(double xcen, double ycen, double xrad, double yrad,
+ double rot, double xcol, double ycol)
+{
+ double x,y,xprime,yprime,dx,dy,dlen,theta;
+
+ theta = (rot / 180.0) * myPI;
+ xprime = xcol - xcen;
+ yprime = ycol - ycen;
+ x = xprime * cos(theta) + yprime * sin(theta);
+ y = -xprime * sin(theta) + yprime * cos(theta);
+ dx = x / xrad; dy = y / yrad;
+ dx *= dx; dy *= dy;
+ dlen = dx + dy;
+ if (dlen <= 1.0)
+ return ( 1 );
+ else
+ return ( 0 );
+}
+
+/*
+ * Extract substring
+ */
+int cstrmid(char *dest_str, int dest_len,
+ char *src_str, int src_len,
+ int pos)
+{
+ /* char fill_char = ' '; */
+ char fill_char = '\0';
+ if (src_len == 0) { src_len = strlen(src_str); } /* .. if constant */
+
+ /* Fill destination with blanks */
+ if (pos < 0) {
+ fferror("STRMID(S,P,N) P must be 0 or greater");
+ return -1;
+ }
+ if (pos > src_len || pos == 0) {
+ /* pos==0: blank string requested */
+ memset(dest_str, fill_char, dest_len);
+ } else if (pos+dest_len > src_len) {
+ /* Copy a subset */
+ int nsub = src_len-pos+1;
+ int npad = dest_len - nsub;
+ memcpy(dest_str, src_str+pos-1, nsub);
+ /* Fill remaining string with blanks */
+ memset(dest_str+nsub, fill_char, npad);
+ } else {
+ /* Full string copy */
+ memcpy(dest_str, src_str+pos-1, dest_len);
+ }
+ dest_str[dest_len] = '\0'; /* Null-terminate */
+
+ return 0;
+}
+
+
+static void fferror(char *s)
+{
+ char msg[80];
+
+ if( !gParse.status ) gParse.status = PARSE_SYNTAX_ERR;
+
+ strncpy(msg, s, 80);
+ msg[79] = '\0';
+ ffpmsg(msg);
+}
diff --git a/src/plugins/cfitsio/f77_wrap.h b/src/plugins/cfitsio/f77_wrap.h
new file mode 100644
index 0000000..d512855
--- /dev/null
+++ b/src/plugins/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) \
+ }
+
diff --git a/src/plugins/cfitsio/f77_wrap1.c b/src/plugins/cfitsio/f77_wrap1.c
new file mode 100644
index 0000000..db7001b
--- /dev/null
+++ b/src/plugins/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)
+
diff --git a/src/plugins/cfitsio/f77_wrap2.c b/src/plugins/cfitsio/f77_wrap2.c
new file mode 100644
index 0000000..8b7de36
--- /dev/null
+++ b/src/plugins/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)
diff --git a/src/plugins/cfitsio/f77_wrap3.c b/src/plugins/cfitsio/f77_wrap3.c
new file mode 100644
index 0000000..e64ef27
--- /dev/null
+++ b/src/plugins/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)
+
+
diff --git a/src/plugins/cfitsio/f77_wrap4.c b/src/plugins/cfitsio/f77_wrap4.c
new file mode 100644
index 0000000..92668c7
--- /dev/null
+++ b/src/plugins/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)
diff --git a/src/plugins/cfitsio/fits_hcompress.c b/src/plugins/cfitsio/fits_hcompress.c
new file mode 100644
index 0000000..96a6b12
--- /dev/null
+++ b/src/plugins/cfitsio/fits_hcompress.c
@@ -0,0 +1,1858 @@
+/* #########################################################################
+These routines to apply the H-compress compression algorithm to a 2-D Fits
+image were written by R. White at the STScI and were obtained from the STScI at
+http://www.stsci.edu/software/hcompress.html
+
+This source file is a concatination of the following sources files in the
+original distribution
+ htrans.c
+ digitize.c
+ encode.c
+ qwrite.c
+ doencode.c
+ bit_output.c
+ qtree_encode.c
+
+The following modifications have been made to the original code:
+
+ - commented out redundant "include" statements
+ - added the noutchar global variable
+ - changed all the 'extern' declarations to 'static', since all the routines are in
+ the same source file
+ - changed the first parameter in encode (and in lower level routines from a file stream
+ to a char array
+ - modifid the encode routine to return the size of the compressed array of bytes
+ - changed calls to printf and perror to call the CFITSIO ffpmsg routine
+ - modified the mywrite routine, and lower level byte writing routines, to copy
+ the output bytes to a char array, instead of writing them to a file stream
+ - replace "exit" statements with "return" statements
+ - changed the function declarations to the more modern ANSI C style
+
+ ############################################################################ */
+
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+static long noutchar;
+static long noutmax;
+
+static int htrans(int a[],int nx,int ny);
+static void digitize(int a[], int nx, int ny, int scale);
+static int encode(char *outfile, long *nlen, int a[], int nx, int ny, int scale);
+static void shuffle(int a[], int n, int n2, int tmp[]);
+
+static int htrans64(LONGLONG a[],int nx,int ny);
+static void digitize64(LONGLONG a[], int nx, int ny, int scale);
+static int encode64(char *outfile, long *nlen, LONGLONG a[], int nx, int ny, int scale);
+static void shuffle64(LONGLONG a[], int n, int n2, LONGLONG tmp[]);
+
+static void writeint(char *outfile, int a);
+static void writelonglong(char *outfile, LONGLONG a);
+static int doencode(char *outfile, int a[], int nx, int ny, unsigned char nbitplanes[3]);
+static int doencode64(char *outfile, LONGLONG a[], int nx, int ny, unsigned char nbitplanes[3]);
+static int qwrite(char *file, char buffer[], int n);
+
+static int qtree_encode(char *outfile, int a[], int n, int nqx, int nqy, int nbitplanes);
+static int qtree_encode64(char *outfile, LONGLONG a[], int n, int nqx, int nqy, int nbitplanes);
+static void start_outputing_bits(void);
+static void done_outputing_bits(char *outfile);
+static void output_nbits(char *outfile, int bits, int n);
+
+static void qtree_onebit(int a[], int n, int nx, int ny, unsigned char b[], int bit);
+static void qtree_onebit64(LONGLONG a[], int n, int nx, int ny, unsigned char b[], int bit);
+static void qtree_reduce(unsigned char a[], int n, int nx, int ny, unsigned char b[]);
+static int bufcopy(unsigned char a[], int n, unsigned char buffer[], int *b, int bmax);
+static void write_bdirect(char *outfile, int a[], int n,int nqx, int nqy, unsigned char scratch[], int bit);
+static void write_bdirect64(char *outfile, LONGLONG a[], int n,int nqx, int nqy, unsigned char scratch[], int bit);
+
+/* #define output_nybble(outfile,c) output_nbits(outfile,c,4) */
+static void output_nybble(char *outfile, int bits);
+static void output_nnybble(char *outfile, int n, unsigned char array[]);
+
+#define output_huffman(outfile,c) output_nbits(outfile,code[c],ncode[c])
+
+/* ---------------------------------------------------------------------- */
+int fits_hcompress(int *a, int ny, int nx, int scale, char *output,
+ long *nbytes, int *status)
+{
+ /*
+ compress the input image using the H-compress algorithm
+
+ a - input image array
+ nx - size of X axis of image
+ ny - size of Y axis of image
+ scale - quantization scale factor. Larger values results in more (lossy) compression
+ scale = 0 does lossless compression
+ output - pre-allocated array to hold the output compressed stream of bytes
+ nbyts - input value = size of the output buffer;
+ returned value = size of the compressed byte stream, in bytes
+
+ NOTE: the nx and ny dimensions as defined within this code are reversed from
+ the usual FITS notation. ny is the fastest varying dimension, which is
+ usually considered the X axis in the FITS image display
+
+ */
+
+ int stat;
+
+ if (*status > 0) return(*status);
+
+ /* H-transform */
+ stat = htrans(a, nx, ny);
+ if (stat) {
+ *status = stat;
+ return(*status);
+ }
+
+ /* digitize */
+ digitize(a, nx, ny, scale);
+
+ /* encode and write to output array */
+
+ FFLOCK;
+ noutmax = *nbytes; /* input value is the allocated size of the array */
+ *nbytes = 0; /* reset */
+
+ stat = encode(output, nbytes, a, nx, ny, scale);
+ FFUNLOCK;
+
+ *status = stat;
+ return(*status);
+}
+/* ---------------------------------------------------------------------- */
+int fits_hcompress64(LONGLONG *a, int ny, int nx, int scale, char *output,
+ long *nbytes, int *status)
+{
+ /*
+ compress the input image using the H-compress algorithm
+
+ a - input image array
+ nx - size of X axis of image
+ ny - size of Y axis of image
+ scale - quantization scale factor. Larger values results in more (lossy) compression
+ scale = 0 does lossless compression
+ output - pre-allocated array to hold the output compressed stream of bytes
+ nbyts - size of the compressed byte stream, in bytes
+
+ NOTE: the nx and ny dimensions as defined within this code are reversed from
+ the usual FITS notation. ny is the fastest varying dimension, which is
+ usually considered the X axis in the FITS image display
+
+ */
+
+ int stat;
+
+ if (*status > 0) return(*status);
+
+ /* H-transform */
+ stat = htrans64(a, nx, ny);
+ if (stat) {
+ *status = stat;
+ return(*status);
+ }
+
+ /* digitize */
+ digitize64(a, nx, ny, scale);
+
+ /* encode and write to output array */
+
+ FFLOCK;
+ noutmax = *nbytes; /* input value is the allocated size of the array */
+ *nbytes = 0; /* reset */
+
+ stat = encode64(output, nbytes, a, nx, ny, scale);
+ FFUNLOCK;
+
+ *status = stat;
+ return(*status);
+}
+
+
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* htrans.c H-transform of NX x NY integer image
+ *
+ * Programmer: R. White Date: 11 May 1992
+ */
+
+/* ######################################################################### */
+static int htrans(int a[],int nx,int ny)
+{
+int nmax, log2n, h0, hx, hy, hc, nxtop, nytop, i, j, k;
+int oddx, oddy;
+int shift, mask, mask2, prnd, prnd2, nrnd2;
+int s10, s00;
+int *tmp;
+
+ /*
+ * log2n is log2 of max(nx,ny) rounded up to next power of 2
+ */
+ nmax = (nx>ny) ? nx : ny;
+ log2n = (int) (log((float) nmax)/log(2.0)+0.5);
+ if ( nmax > (1<<log2n) ) {
+ log2n += 1;
+ }
+ /*
+ * get temporary storage for shuffling elements
+ */
+ tmp = (int *) malloc(((nmax+1)/2)*sizeof(int));
+ if(tmp == (int *) NULL) {
+ ffpmsg("htrans: insufficient memory");
+ return(DATA_COMPRESSION_ERR);
+ }
+ /*
+ * set up rounding and shifting masks
+ */
+ shift = 0;
+ mask = -2;
+ mask2 = mask << 1;
+ prnd = 1;
+ prnd2 = prnd << 1;
+ nrnd2 = prnd2 - 1;
+ /*
+ * do log2n reductions
+ *
+ * We're indexing a as a 2-D array with dimensions (nx,ny).
+ */
+ nxtop = nx;
+ nytop = ny;
+
+ for (k = 0; k<log2n; k++) {
+ oddx = nxtop % 2;
+ oddy = nytop % 2;
+ for (i = 0; i<nxtop-oddx; i += 2) {
+ s00 = i*ny; /* s00 is index of a[i,j] */
+ s10 = s00+ny; /* s10 is index of a[i+1,j] */
+ for (j = 0; j<nytop-oddy; j += 2) {
+ /*
+ * Divide h0,hx,hy,hc by 2 (1 the first time through).
+ */
+ h0 = (a[s10+1] + a[s10] + a[s00+1] + a[s00]) >> shift;
+ hx = (a[s10+1] + a[s10] - a[s00+1] - a[s00]) >> shift;
+ hy = (a[s10+1] - a[s10] + a[s00+1] - a[s00]) >> shift;
+ hc = (a[s10+1] - a[s10] - a[s00+1] + a[s00]) >> shift;
+
+ /*
+ * Throw away the 2 bottom bits of h0, bottom bit of hx,hy.
+ * To get rounding to be same for positive and negative
+ * numbers, nrnd2 = prnd2 - 1.
+ */
+ a[s10+1] = hc;
+ a[s10 ] = ( (hx>=0) ? (hx+prnd) : hx ) & mask ;
+ a[s00+1] = ( (hy>=0) ? (hy+prnd) : hy ) & mask ;
+ a[s00 ] = ( (h0>=0) ? (h0+prnd2) : (h0+nrnd2) ) & mask2;
+ s00 += 2;
+ s10 += 2;
+ }
+ if (oddy) {
+ /*
+ * do last element in row if row length is odd
+ * s00+1, s10+1 are off edge
+ */
+ h0 = (a[s10] + a[s00]) << (1-shift);
+ hx = (a[s10] - a[s00]) << (1-shift);
+ a[s10 ] = ( (hx>=0) ? (hx+prnd) : hx ) & mask ;
+ a[s00 ] = ( (h0>=0) ? (h0+prnd2) : (h0+nrnd2) ) & mask2;
+ s00 += 1;
+ s10 += 1;
+ }
+ }
+ if (oddx) {
+ /*
+ * do last row if column length is odd
+ * s10, s10+1 are off edge
+ */
+ s00 = i*ny;
+ for (j = 0; j<nytop-oddy; j += 2) {
+ h0 = (a[s00+1] + a[s00]) << (1-shift);
+ hy = (a[s00+1] - a[s00]) << (1-shift);
+ a[s00+1] = ( (hy>=0) ? (hy+prnd) : hy ) & mask ;
+ a[s00 ] = ( (h0>=0) ? (h0+prnd2) : (h0+nrnd2) ) & mask2;
+ s00 += 2;
+ }
+ if (oddy) {
+ /*
+ * do corner element if both row and column lengths are odd
+ * s00+1, s10, s10+1 are off edge
+ */
+ h0 = a[s00] << (2-shift);
+ a[s00 ] = ( (h0>=0) ? (h0+prnd2) : (h0+nrnd2) ) & mask2;
+ }
+ }
+ /*
+ * now shuffle in each dimension to group coefficients by order
+ */
+ for (i = 0; i<nxtop; i++) {
+ shuffle(&a[ny*i],nytop,1,tmp);
+ }
+ for (j = 0; j<nytop; j++) {
+ shuffle(&a[j],nxtop,ny,tmp);
+ }
+ /*
+ * image size reduced by 2 (round up if odd)
+ */
+ nxtop = (nxtop+1)>>1;
+ nytop = (nytop+1)>>1;
+ /*
+ * divisor doubles after first reduction
+ */
+ shift = 1;
+ /*
+ * masks, rounding values double after each iteration
+ */
+ mask = mask2;
+ prnd = prnd2;
+ mask2 = mask2 << 1;
+ prnd2 = prnd2 << 1;
+ nrnd2 = prnd2 - 1;
+ }
+ free(tmp);
+ return(0);
+}
+/* ######################################################################### */
+
+static int htrans64(LONGLONG a[],int nx,int ny)
+{
+int nmax, log2n, nxtop, nytop, i, j, k;
+int oddx, oddy;
+int shift;
+int s10, s00;
+LONGLONG h0, hx, hy, hc, prnd, prnd2, nrnd2, mask, mask2;
+LONGLONG *tmp;
+
+ /*
+ * log2n is log2 of max(nx,ny) rounded up to next power of 2
+ */
+ nmax = (nx>ny) ? nx : ny;
+ log2n = (int) (log((float) nmax)/log(2.0)+0.5);
+ if ( nmax > (1<<log2n) ) {
+ log2n += 1;
+ }
+ /*
+ * get temporary storage for shuffling elements
+ */
+ tmp = (LONGLONG *) malloc(((nmax+1)/2)*sizeof(LONGLONG));
+ if(tmp == (LONGLONG *) NULL) {
+ ffpmsg("htrans64: insufficient memory");
+ return(DATA_COMPRESSION_ERR);
+ }
+ /*
+ * set up rounding and shifting masks
+ */
+ shift = 0;
+ mask = (LONGLONG) -2;
+ mask2 = mask << 1;
+ prnd = (LONGLONG) 1;
+ prnd2 = prnd << 1;
+ nrnd2 = prnd2 - 1;
+ /*
+ * do log2n reductions
+ *
+ * We're indexing a as a 2-D array with dimensions (nx,ny).
+ */
+ nxtop = nx;
+ nytop = ny;
+
+ for (k = 0; k<log2n; k++) {
+ oddx = nxtop % 2;
+ oddy = nytop % 2;
+ for (i = 0; i<nxtop-oddx; i += 2) {
+ s00 = i*ny; /* s00 is index of a[i,j] */
+ s10 = s00+ny; /* s10 is index of a[i+1,j] */
+ for (j = 0; j<nytop-oddy; j += 2) {
+ /*
+ * Divide h0,hx,hy,hc by 2 (1 the first time through).
+ */
+ h0 = (a[s10+1] + a[s10] + a[s00+1] + a[s00]) >> shift;
+ hx = (a[s10+1] + a[s10] - a[s00+1] - a[s00]) >> shift;
+ hy = (a[s10+1] - a[s10] + a[s00+1] - a[s00]) >> shift;
+ hc = (a[s10+1] - a[s10] - a[s00+1] + a[s00]) >> shift;
+
+ /*
+ * Throw away the 2 bottom bits of h0, bottom bit of hx,hy.
+ * To get rounding to be same for positive and negative
+ * numbers, nrnd2 = prnd2 - 1.
+ */
+ a[s10+1] = hc;
+ a[s10 ] = ( (hx>=0) ? (hx+prnd) : hx ) & mask ;
+ a[s00+1] = ( (hy>=0) ? (hy+prnd) : hy ) & mask ;
+ a[s00 ] = ( (h0>=0) ? (h0+prnd2) : (h0+nrnd2) ) & mask2;
+ s00 += 2;
+ s10 += 2;
+ }
+ if (oddy) {
+ /*
+ * do last element in row if row length is odd
+ * s00+1, s10+1 are off edge
+ */
+ h0 = (a[s10] + a[s00]) << (1-shift);
+ hx = (a[s10] - a[s00]) << (1-shift);
+ a[s10 ] = ( (hx>=0) ? (hx+prnd) : hx ) & mask ;
+ a[s00 ] = ( (h0>=0) ? (h0+prnd2) : (h0+nrnd2) ) & mask2;
+ s00 += 1;
+ s10 += 1;
+ }
+ }
+ if (oddx) {
+ /*
+ * do last row if column length is odd
+ * s10, s10+1 are off edge
+ */
+ s00 = i*ny;
+ for (j = 0; j<nytop-oddy; j += 2) {
+ h0 = (a[s00+1] + a[s00]) << (1-shift);
+ hy = (a[s00+1] - a[s00]) << (1-shift);
+ a[s00+1] = ( (hy>=0) ? (hy+prnd) : hy ) & mask ;
+ a[s00 ] = ( (h0>=0) ? (h0+prnd2) : (h0+nrnd2) ) & mask2;
+ s00 += 2;
+ }
+ if (oddy) {
+ /*
+ * do corner element if both row and column lengths are odd
+ * s00+1, s10, s10+1 are off edge
+ */
+ h0 = a[s00] << (2-shift);
+ a[s00 ] = ( (h0>=0) ? (h0+prnd2) : (h0+nrnd2) ) & mask2;
+ }
+ }
+ /*
+ * now shuffle in each dimension to group coefficients by order
+ */
+ for (i = 0; i<nxtop; i++) {
+ shuffle64(&a[ny*i],nytop,1,tmp);
+ }
+ for (j = 0; j<nytop; j++) {
+ shuffle64(&a[j],nxtop,ny,tmp);
+ }
+ /*
+ * image size reduced by 2 (round up if odd)
+ */
+ nxtop = (nxtop+1)>>1;
+ nytop = (nytop+1)>>1;
+ /*
+ * divisor doubles after first reduction
+ */
+ shift = 1;
+ /*
+ * masks, rounding values double after each iteration
+ */
+ mask = mask2;
+ prnd = prnd2;
+ mask2 = mask2 << 1;
+ prnd2 = prnd2 << 1;
+ nrnd2 = prnd2 - 1;
+ }
+ free(tmp);
+ return(0);
+}
+
+/* ######################################################################### */
+static void
+shuffle(int a[], int n, int n2, int tmp[])
+{
+
+/*
+int a[]; array to shuffle
+int n; number of elements to shuffle
+int n2; second dimension
+int tmp[]; scratch storage
+*/
+
+int i;
+int *p1, *p2, *pt;
+
+ /*
+ * copy odd elements to tmp
+ */
+ pt = tmp;
+ p1 = &a[n2];
+ for (i=1; i < n; i += 2) {
+ *pt = *p1;
+ pt += 1;
+ p1 += (n2+n2);
+ }
+ /*
+ * compress even elements into first half of A
+ */
+ p1 = &a[n2];
+ p2 = &a[n2+n2];
+ for (i=2; i<n; i += 2) {
+ *p1 = *p2;
+ p1 += n2;
+ p2 += (n2+n2);
+ }
+ /*
+ * put odd elements into 2nd half
+ */
+ pt = tmp;
+ for (i = 1; i<n; i += 2) {
+ *p1 = *pt;
+ p1 += n2;
+ pt += 1;
+ }
+}
+/* ######################################################################### */
+static void
+shuffle64(LONGLONG a[], int n, int n2, LONGLONG tmp[])
+{
+
+/*
+LONGLONG a[]; array to shuffle
+int n; number of elements to shuffle
+int n2; second dimension
+LONGLONG tmp[]; scratch storage
+*/
+
+int i;
+LONGLONG *p1, *p2, *pt;
+
+ /*
+ * copy odd elements to tmp
+ */
+ pt = tmp;
+ p1 = &a[n2];
+ for (i=1; i < n; i += 2) {
+ *pt = *p1;
+ pt += 1;
+ p1 += (n2+n2);
+ }
+ /*
+ * compress even elements into first half of A
+ */
+ p1 = &a[n2];
+ p2 = &a[n2+n2];
+ for (i=2; i<n; i += 2) {
+ *p1 = *p2;
+ p1 += n2;
+ p2 += (n2+n2);
+ }
+ /*
+ * put odd elements into 2nd half
+ */
+ pt = tmp;
+ for (i = 1; i<n; i += 2) {
+ *p1 = *pt;
+ p1 += n2;
+ pt += 1;
+ }
+}
+/* ######################################################################### */
+/* ######################################################################### */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* digitize.c digitize H-transform
+ *
+ * Programmer: R. White Date: 11 March 1991
+ */
+
+/* ######################################################################### */
+static void
+digitize(int a[], int nx, int ny, int scale)
+{
+int d, *p;
+
+ /*
+ * round to multiple of scale
+ */
+ if (scale <= 1) return;
+ d=(scale+1)/2-1;
+ for (p=a; p <= &a[nx*ny-1]; p++) *p = ((*p>0) ? (*p+d) : (*p-d))/scale;
+}
+
+/* ######################################################################### */
+static void
+digitize64(LONGLONG a[], int nx, int ny, int scale)
+{
+LONGLONG d, *p, scale64;
+
+ /*
+ * round to multiple of scale
+ */
+ if (scale <= 1) return;
+ d=(scale+1)/2-1;
+ scale64 = scale; /* use a 64-bit int for efficiency in the big loop */
+
+ for (p=a; p <= &a[nx*ny-1]; p++) *p = ((*p>0) ? (*p+d) : (*p-d))/scale64;
+}
+/* ######################################################################### */
+/* ######################################################################### */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* encode.c encode H-transform and write to outfile
+ *
+ * Programmer: R. White Date: 2 February 1994
+ */
+
+static char code_magic[2] = { (char)0xDD, (char)0x99 };
+
+
+/* ######################################################################### */
+static int encode(char *outfile, long *nlength, int a[], int nx, int ny, int scale)
+{
+
+/* FILE *outfile; - change outfile to a char array */
+/*
+ long * nlength returned length (in bytes) of the encoded array)
+ int a[]; input H-transform array (nx,ny)
+ int nx,ny; size of H-transform array
+ int scale; scale factor for digitization
+*/
+int nel, nx2, ny2, i, j, k, q, vmax[3], nsign, bits_to_go;
+unsigned char nbitplanes[3];
+unsigned char *signbits;
+int stat;
+
+ noutchar = 0; /* initialize the number of compressed bytes that have been written */
+ nel = nx*ny;
+ /*
+ * write magic value
+ */
+ qwrite(outfile, code_magic, sizeof(code_magic));
+ writeint(outfile, nx); /* size of image */
+ writeint(outfile, ny);
+ writeint(outfile, scale); /* scale factor for digitization */
+ /*
+ * write first value of A (sum of all pixels -- the only value
+ * which does not compress well)
+ */
+ writelonglong(outfile, (LONGLONG) a[0]);
+
+ a[0] = 0;
+ /*
+ * allocate array for sign bits and save values, 8 per byte
+ */
+ signbits = (unsigned char *) malloc((nel+7)/8);
+ if (signbits == (unsigned char *) NULL) {
+ ffpmsg("encode: insufficient memory");
+ return(DATA_COMPRESSION_ERR);
+ }
+ nsign = 0;
+ bits_to_go = 8;
+ signbits[0] = 0;
+ for (i=0; i<nel; i++) {
+ if (a[i] > 0) {
+ /*
+ * positive element, put zero at end of buffer
+ */
+ signbits[nsign] <<= 1;
+ bits_to_go -= 1;
+ } else if (a[i] < 0) {
+ /*
+ * negative element, shift in a one
+ */
+ signbits[nsign] <<= 1;
+ signbits[nsign] |= 1;
+ bits_to_go -= 1;
+ /*
+ * replace a by absolute value
+ */
+ a[i] = -a[i];
+ }
+ if (bits_to_go == 0) {
+ /*
+ * filled up this byte, go to the next one
+ */
+ bits_to_go = 8;
+ nsign += 1;
+ signbits[nsign] = 0;
+ }
+ }
+ if (bits_to_go != 8) {
+ /*
+ * some bits in last element
+ * move bits in last byte to bottom and increment nsign
+ */
+ signbits[nsign] <<= bits_to_go;
+ nsign += 1;
+ }
+ /*
+ * calculate number of bit planes for 3 quadrants
+ *
+ * quadrant 0=bottom left, 1=bottom right or top left, 2=top right,
+ */
+ for (q=0; q<3; q++) {
+ vmax[q] = 0;
+ }
+ /*
+ * get maximum absolute value in each quadrant
+ */
+ nx2 = (nx+1)/2;
+ ny2 = (ny+1)/2;
+ j=0; /* column counter */
+ k=0; /* row counter */
+ for (i=0; i<nel; i++) {
+ q = (j>=ny2) + (k>=nx2);
+ if (vmax[q] < a[i]) vmax[q] = a[i];
+ if (++j >= ny) {
+ j = 0;
+ k += 1;
+ }
+ }
+ /*
+ * now calculate number of bits for each quadrant
+ */
+
+ /* this is a more efficient way to do this, */
+
+
+ for (q = 0; q < 3; q++) {
+ for (nbitplanes[q] = 0; vmax[q]>0; vmax[q] = vmax[q]>>1, nbitplanes[q]++) ;
+ }
+
+
+/*
+ for (q = 0; q < 3; q++) {
+ nbitplanes[q] = (int) (log((float) (vmax[q]+1))/log(2.0)+0.5);
+ if ( (vmax[q]+1) > (1<<nbitplanes[q]) ) {
+ nbitplanes[q] += 1;
+ }
+ }
+*/
+
+ /*
+ * write nbitplanes
+ */
+ if (0 == qwrite(outfile, (char *) nbitplanes, sizeof(nbitplanes))) {
+ *nlength = noutchar;
+ ffpmsg("encode: output buffer too small");
+ return(DATA_COMPRESSION_ERR);
+ }
+
+ /*
+ * write coded array
+ */
+ stat = doencode(outfile, a, nx, ny, nbitplanes);
+ /*
+ * write sign bits
+ */
+
+ if (nsign > 0) {
+
+ if ( 0 == qwrite(outfile, (char *) signbits, nsign)) {
+ free(signbits);
+ *nlength = noutchar;
+ ffpmsg("encode: output buffer too small");
+ return(DATA_COMPRESSION_ERR);
+ }
+ }
+
+ free(signbits);
+ *nlength = noutchar;
+
+ if (noutchar >= noutmax) {
+ ffpmsg("encode: output buffer too small");
+ return(DATA_COMPRESSION_ERR);
+ }
+
+ return(stat);
+}
+/* ######################################################################### */
+static int encode64(char *outfile, long *nlength, LONGLONG a[], int nx, int ny, int scale)
+{
+
+/* FILE *outfile; - change outfile to a char array */
+/*
+ long * nlength returned length (in bytes) of the encoded array)
+ LONGLONG a[]; input H-transform array (nx,ny)
+ int nx,ny; size of H-transform array
+ int scale; scale factor for digitization
+*/
+int nel, nx2, ny2, i, j, k, q, nsign, bits_to_go;
+LONGLONG vmax[3];
+unsigned char nbitplanes[3];
+unsigned char *signbits;
+int stat;
+
+ noutchar = 0; /* initialize the number of compressed bytes that have been written */
+ nel = nx*ny;
+ /*
+ * write magic value
+ */
+ qwrite(outfile, code_magic, sizeof(code_magic));
+ writeint(outfile, nx); /* size of image */
+ writeint(outfile, ny);
+ writeint(outfile, scale); /* scale factor for digitization */
+ /*
+ * write first value of A (sum of all pixels -- the only value
+ * which does not compress well)
+ */
+ writelonglong(outfile, a[0]);
+
+ a[0] = 0;
+ /*
+ * allocate array for sign bits and save values, 8 per byte
+ */
+ signbits = (unsigned char *) malloc((nel+7)/8);
+ if (signbits == (unsigned char *) NULL) {
+ ffpmsg("encode64: insufficient memory");
+ return(DATA_COMPRESSION_ERR);
+ }
+ nsign = 0;
+ bits_to_go = 8;
+ signbits[0] = 0;
+ for (i=0; i<nel; i++) {
+ if (a[i] > 0) {
+ /*
+ * positive element, put zero at end of buffer
+ */
+ signbits[nsign] <<= 1;
+ bits_to_go -= 1;
+ } else if (a[i] < 0) {
+ /*
+ * negative element, shift in a one
+ */
+ signbits[nsign] <<= 1;
+ signbits[nsign] |= 1;
+ bits_to_go -= 1;
+ /*
+ * replace a by absolute value
+ */
+ a[i] = -a[i];
+ }
+ if (bits_to_go == 0) {
+ /*
+ * filled up this byte, go to the next one
+ */
+ bits_to_go = 8;
+ nsign += 1;
+ signbits[nsign] = 0;
+ }
+ }
+ if (bits_to_go != 8) {
+ /*
+ * some bits in last element
+ * move bits in last byte to bottom and increment nsign
+ */
+ signbits[nsign] <<= bits_to_go;
+ nsign += 1;
+ }
+ /*
+ * calculate number of bit planes for 3 quadrants
+ *
+ * quadrant 0=bottom left, 1=bottom right or top left, 2=top right,
+ */
+ for (q=0; q<3; q++) {
+ vmax[q] = 0;
+ }
+ /*
+ * get maximum absolute value in each quadrant
+ */
+ nx2 = (nx+1)/2;
+ ny2 = (ny+1)/2;
+ j=0; /* column counter */
+ k=0; /* row counter */
+ for (i=0; i<nel; i++) {
+ q = (j>=ny2) + (k>=nx2);
+ if (vmax[q] < a[i]) vmax[q] = a[i];
+ if (++j >= ny) {
+ j = 0;
+ k += 1;
+ }
+ }
+ /*
+ * now calculate number of bits for each quadrant
+ */
+
+ /* this is a more efficient way to do this, */
+
+
+ for (q = 0; q < 3; q++) {
+ for (nbitplanes[q] = 0; vmax[q]>0; vmax[q] = vmax[q]>>1, nbitplanes[q]++) ;
+ }
+
+
+/*
+ for (q = 0; q < 3; q++) {
+ nbitplanes[q] = log((float) (vmax[q]+1))/log(2.0)+0.5;
+ if ( (vmax[q]+1) > (((LONGLONG) 1)<<nbitplanes[q]) ) {
+ nbitplanes[q] += 1;
+ }
+ }
+*/
+
+ /*
+ * write nbitplanes
+ */
+
+ if (0 == qwrite(outfile, (char *) nbitplanes, sizeof(nbitplanes))) {
+ *nlength = noutchar;
+ ffpmsg("encode: output buffer too small");
+ return(DATA_COMPRESSION_ERR);
+ }
+
+ /*
+ * write coded array
+ */
+ stat = doencode64(outfile, a, nx, ny, nbitplanes);
+ /*
+ * write sign bits
+ */
+
+ if (nsign > 0) {
+
+ if ( 0 == qwrite(outfile, (char *) signbits, nsign)) {
+ free(signbits);
+ *nlength = noutchar;
+ ffpmsg("encode: output buffer too small");
+ return(DATA_COMPRESSION_ERR);
+ }
+ }
+
+ free(signbits);
+ *nlength = noutchar;
+
+ if (noutchar >= noutmax) {
+ ffpmsg("encode64: output buffer too small");
+ return(DATA_COMPRESSION_ERR);
+ }
+
+ return(stat);
+}
+/* ######################################################################### */
+/* ######################################################################### */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* qwrite.c Write binary data
+ *
+ * Programmer: R. White Date: 11 March 1991
+ */
+
+/* ######################################################################### */
+static void
+writeint(char *outfile, int a)
+{
+int i;
+unsigned char b[4];
+
+ /* Write integer A one byte at a time to outfile.
+ *
+ * This is portable from Vax to Sun since it eliminates the
+ * need for byte-swapping.
+ */
+ for (i=3; i>=0; i--) {
+ b[i] = a & 0x000000ff;
+ a >>= 8;
+ }
+ for (i=0; i<4; i++) qwrite(outfile, (char *) &b[i],1);
+}
+
+/* ######################################################################### */
+static void
+writelonglong(char *outfile, LONGLONG a)
+{
+int i;
+unsigned char b[8];
+
+ /* Write integer A one byte at a time to outfile.
+ *
+ * This is portable from Vax to Sun since it eliminates the
+ * need for byte-swapping.
+ */
+ for (i=7; i>=0; i--) {
+ b[i] = (unsigned char) (a & 0x000000ff);
+ a >>= 8;
+ }
+ for (i=0; i<8; i++) qwrite(outfile, (char *) &b[i],1);
+}
+/* ######################################################################### */
+static int
+qwrite(char *file, char buffer[], int n){
+ /*
+ * write n bytes from buffer into file
+ * returns number of bytes read (=n) if successful, <=0 if not
+ */
+
+ if (noutchar + n > noutmax) return(0); /* buffer overflow */
+
+ memcpy(&file[noutchar], buffer, n);
+ noutchar += n;
+
+ return(n);
+}
+/* ######################################################################### */
+/* ######################################################################### */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* doencode.c Encode 2-D array and write stream of characters on outfile
+ *
+ * This version assumes that A is positive.
+ *
+ * Programmer: R. White Date: 7 May 1991
+ */
+
+/* ######################################################################### */
+static int
+doencode(char *outfile, int a[], int nx, int ny, unsigned char nbitplanes[3])
+{
+/* char *outfile; output data stream
+int a[]; Array of values to encode
+int nx,ny; Array dimensions [nx][ny]
+unsigned char nbitplanes[3]; Number of bit planes in quadrants
+*/
+
+int nx2, ny2, stat;
+
+ nx2 = (nx+1)/2;
+ ny2 = (ny+1)/2;
+ /*
+ * Initialize bit output
+ */
+ start_outputing_bits();
+ /*
+ * write out the bit planes for each quadrant
+ */
+ stat = qtree_encode(outfile, &a[0], ny, nx2, ny2, nbitplanes[0]);
+
+ if (!stat)
+ stat = qtree_encode(outfile, &a[ny2], ny, nx2, ny/2, nbitplanes[1]);
+
+ if (!stat)
+ stat = qtree_encode(outfile, &a[ny*nx2], ny, nx/2, ny2, nbitplanes[1]);
+
+ if (!stat)
+ stat = qtree_encode(outfile, &a[ny*nx2+ny2], ny, nx/2, ny/2, nbitplanes[2]);
+ /*
+ * Add zero as an EOF symbol
+ */
+ output_nybble(outfile, 0);
+ done_outputing_bits(outfile);
+
+ return(stat);
+}
+/* ######################################################################### */
+static int
+doencode64(char *outfile, LONGLONG a[], int nx, int ny, unsigned char nbitplanes[3])
+{
+/* char *outfile; output data stream
+LONGLONG a[]; Array of values to encode
+int nx,ny; Array dimensions [nx][ny]
+unsigned char nbitplanes[3]; Number of bit planes in quadrants
+*/
+
+int nx2, ny2, stat;
+
+ nx2 = (nx+1)/2;
+ ny2 = (ny+1)/2;
+ /*
+ * Initialize bit output
+ */
+ start_outputing_bits();
+ /*
+ * write out the bit planes for each quadrant
+ */
+ stat = qtree_encode64(outfile, &a[0], ny, nx2, ny2, nbitplanes[0]);
+
+ if (!stat)
+ stat = qtree_encode64(outfile, &a[ny2], ny, nx2, ny/2, nbitplanes[1]);
+
+ if (!stat)
+ stat = qtree_encode64(outfile, &a[ny*nx2], ny, nx/2, ny2, nbitplanes[1]);
+
+ if (!stat)
+ stat = qtree_encode64(outfile, &a[ny*nx2+ny2], ny, nx/2, ny/2, nbitplanes[2]);
+ /*
+ * Add zero as an EOF symbol
+ */
+ output_nybble(outfile, 0);
+ done_outputing_bits(outfile);
+
+ return(stat);
+}
+/* ######################################################################### */
+/* ######################################################################### */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* BIT OUTPUT ROUTINES */
+
+
+static LONGLONG bitcount;
+
+/* THE BIT BUFFER */
+
+static int buffer2; /* Bits buffered for output */
+static int bits_to_go2; /* Number of bits free in buffer */
+
+
+/* ######################################################################### */
+/* INITIALIZE FOR BIT OUTPUT */
+
+static void
+start_outputing_bits(void)
+{
+ buffer2 = 0; /* Buffer is empty to start */
+ bits_to_go2 = 8; /* with */
+ bitcount = 0;
+}
+
+/* ######################################################################### */
+/* OUTPUT N BITS (N must be <= 8) */
+
+static void
+output_nbits(char *outfile, int bits, int n)
+{
+ /* AND mask for the right-most n bits */
+ static int mask[9] = {0, 1, 3, 7, 15, 31, 63, 127, 255};
+ /*
+ * insert bits at end of buffer
+ */
+ buffer2 <<= n;
+/* buffer2 |= ( bits & ((1<<n)-1) ); */
+ buffer2 |= ( bits & (*(mask+n)) );
+ bits_to_go2 -= n;
+ if (bits_to_go2 <= 0) {
+ /*
+ * buffer2 full, put out top 8 bits
+ */
+
+ outfile[noutchar] = ((buffer2>>(-bits_to_go2)) & 0xff);
+
+ if (noutchar < noutmax) noutchar++;
+
+ bits_to_go2 += 8;
+ }
+ bitcount += n;
+}
+/* ######################################################################### */
+/* OUTPUT a 4 bit nybble */
+static void
+output_nybble(char *outfile, int bits)
+{
+ /*
+ * insert 4 bits at end of buffer
+ */
+ buffer2 = (buffer2<<4) | ( bits & 15 );
+ bits_to_go2 -= 4;
+ if (bits_to_go2 <= 0) {
+ /*
+ * buffer2 full, put out top 8 bits
+ */
+
+ outfile[noutchar] = ((buffer2>>(-bits_to_go2)) & 0xff);
+
+ if (noutchar < noutmax) noutchar++;
+
+ bits_to_go2 += 8;
+ }
+ bitcount += 4;
+}
+/* ############################################################################ */
+/* OUTPUT array of 4 BITS */
+
+static void output_nnybble(char *outfile, int n, unsigned char array[])
+{
+ /* pack the 4 lower bits in each element of the array into the outfile array */
+
+int ii, jj, kk = 0, shift;
+
+ if (n == 1) {
+ output_nybble(outfile, (int) array[0]);
+ return;
+ }
+/* forcing byte alignment doesn;t help, and even makes it go slightly slower
+if (bits_to_go2 != 8)
+ output_nbits(outfile, kk, bits_to_go2);
+*/
+ if (bits_to_go2 <= 4)
+ {
+ /* just room for 1 nybble; write it out separately */
+ output_nybble(outfile, array[0]);
+ kk++; /* index to next array element */
+
+ if (n == 2) /* only 1 more nybble to write out */
+ {
+ output_nybble(outfile, (int) array[1]);
+ return;
+ }
+ }
+
+
+ /* bits_to_go2 is now in the range 5 - 8 */
+ shift = 8 - bits_to_go2;
+
+ /* now write out pairs of nybbles; this does not affect value of bits_to_go2 */
+ jj = (n - kk) / 2;
+
+ if (bits_to_go2 == 8) {
+ /* special case if nybbles are aligned on byte boundary */
+ /* this actually seems to make very little differnece in speed */
+ buffer2 = 0;
+ for (ii = 0; ii < jj; ii++)
+ {
+ outfile[noutchar] = ((array[kk] & 15)<<4) | (array[kk+1] & 15);
+ kk += 2;
+ noutchar++;
+ }
+ } else {
+ for (ii = 0; ii < jj; ii++)
+ {
+ buffer2 = (buffer2<<8) | ((array[kk] & 15)<<4) | (array[kk+1] & 15);
+ kk += 2;
+
+ /*
+ buffer2 full, put out top 8 bits
+ */
+
+ outfile[noutchar] = ((buffer2>>shift) & 0xff);
+ noutchar++;
+ }
+ }
+
+ bitcount += (8 * (ii - 1));
+
+ /* write out last odd nybble, if present */
+ if (kk != n) output_nybble(outfile, (int) array[n - 1]);
+
+ return;
+}
+
+
+/* ######################################################################### */
+/* FLUSH OUT THE LAST BITS */
+
+static void
+done_outputing_bits(char *outfile)
+{
+ if(bits_to_go2 < 8) {
+/* putc(buffer2<<bits_to_go2,outfile); */
+
+ outfile[noutchar] = (buffer2<<bits_to_go2);
+ if (noutchar < noutmax) noutchar++;
+
+ /* count the garbage bits too */
+ bitcount += bits_to_go2;
+ }
+}
+/* ######################################################################### */
+/* ######################################################################### */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* qtree_encode.c Encode values in quadrant of 2-D array using binary
+ * quadtree coding for each bit plane. Assumes array is
+ * positive.
+ *
+ * Programmer: R. White Date: 15 May 1991
+ */
+
+/*
+ * Huffman code values and number of bits in each code
+ */
+static int code[16] =
+ {
+ 0x3e, 0x00, 0x01, 0x08, 0x02, 0x09, 0x1a, 0x1b,
+ 0x03, 0x1c, 0x0a, 0x1d, 0x0b, 0x1e, 0x3f, 0x0c
+ };
+static int ncode[16] =
+ {
+ 6, 3, 3, 4, 3, 4, 5, 5,
+ 3, 5, 4, 5, 4, 5, 6, 4
+ };
+
+/*
+ * variables for bit output to buffer when Huffman coding
+ */
+static int bitbuffer, bits_to_go3;
+
+/*
+ * macros to write out 4-bit nybble, Huffman code for this value
+ */
+
+
+/* ######################################################################### */
+static int
+qtree_encode(char *outfile, int a[], int n, int nqx, int nqy, int nbitplanes)
+{
+
+/*
+int a[];
+int n; physical dimension of row in a
+int nqx; length of row
+int nqy; length of column (<=n)
+int nbitplanes; number of bit planes to output
+*/
+
+int log2n, i, k, bit, b, bmax, nqmax, nqx2, nqy2, nx, ny;
+unsigned char *scratch, *buffer;
+
+ /*
+ * log2n is log2 of max(nqx,nqy) rounded up to next power of 2
+ */
+ nqmax = (nqx>nqy) ? nqx : nqy;
+ log2n = (int) (log((float) nqmax)/log(2.0)+0.5);
+ if (nqmax > (1<<log2n)) {
+ log2n += 1;
+ }
+ /*
+ * initialize buffer point, max buffer size
+ */
+ nqx2 = (nqx+1)/2;
+ nqy2 = (nqy+1)/2;
+ bmax = (nqx2*nqy2+1)/2;
+ /*
+ * We're indexing A as a 2-D array with dimensions (nqx,nqy).
+ * Scratch is 2-D with dimensions (nqx/2,nqy/2) rounded up.
+ * Buffer is used to store string of codes for output.
+ */
+ scratch = (unsigned char *) malloc(2*bmax);
+ buffer = (unsigned char *) malloc(bmax);
+ if ((scratch == (unsigned char *) NULL) ||
+ (buffer == (unsigned char *) NULL)) {
+ ffpmsg("qtree_encode: insufficient memory");
+ return(DATA_COMPRESSION_ERR);
+ }
+ /*
+ * now encode each bit plane, starting with the top
+ */
+ for (bit=nbitplanes-1; bit >= 0; bit--) {
+ /*
+ * initial bit buffer
+ */
+ b = 0;
+ bitbuffer = 0;
+ bits_to_go3 = 0;
+ /*
+ * on first pass copy A to scratch array
+ */
+ qtree_onebit(a,n,nqx,nqy,scratch,bit);
+ nx = (nqx+1)>>1;
+ ny = (nqy+1)>>1;
+ /*
+ * copy non-zero values to output buffer, which will be written
+ * in reverse order
+ */
+ if (bufcopy(scratch,nx*ny,buffer,&b,bmax)) {
+ /*
+ * quadtree is expanding data,
+ * change warning code and just fill buffer with bit-map
+ */
+ write_bdirect(outfile,a,n,nqx,nqy,scratch,bit);
+ goto bitplane_done;
+ }
+ /*
+ * do log2n reductions
+ */
+ for (k = 1; k<log2n; k++) {
+ qtree_reduce(scratch,ny,nx,ny,scratch);
+ nx = (nx+1)>>1;
+ ny = (ny+1)>>1;
+ if (bufcopy(scratch,nx*ny,buffer,&b,bmax)) {
+ write_bdirect(outfile,a,n,nqx,nqy,scratch,bit);
+ goto bitplane_done;
+ }
+ }
+ /*
+ * OK, we've got the code in buffer
+ * Write quadtree warning code, then write buffer in reverse order
+ */
+ output_nybble(outfile,0xF);
+ if (b==0) {
+ if (bits_to_go3>0) {
+ /*
+ * put out the last few bits
+ */
+ output_nbits(outfile, bitbuffer & ((1<<bits_to_go3)-1),
+ bits_to_go3);
+ } else {
+ /*
+ * have to write a zero nybble if there are no 1's in array
+ */
+ output_huffman(outfile,0);
+ }
+ } else {
+ if (bits_to_go3>0) {
+ /*
+ * put out the last few bits
+ */
+ output_nbits(outfile, bitbuffer & ((1<<bits_to_go3)-1),
+ bits_to_go3);
+ }
+ for (i=b-1; i>=0; i--) {
+ output_nbits(outfile,buffer[i],8);
+ }
+ }
+ bitplane_done: ;
+ }
+ free(buffer);
+ free(scratch);
+ return(0);
+}
+/* ######################################################################### */
+static int
+qtree_encode64(char *outfile, LONGLONG a[], int n, int nqx, int nqy, int nbitplanes)
+{
+
+/*
+LONGLONG a[];
+int n; physical dimension of row in a
+int nqx; length of row
+int nqy; length of column (<=n)
+int nbitplanes; number of bit planes to output
+*/
+
+int log2n, i, k, bit, b, nqmax, nqx2, nqy2, nx, ny;
+int bmax; /* this potentially needs to be made a 64-bit int to support large arrays */
+unsigned char *scratch, *buffer;
+
+ /*
+ * log2n is log2 of max(nqx,nqy) rounded up to next power of 2
+ */
+ nqmax = (nqx>nqy) ? nqx : nqy;
+ log2n = (int) (log((float) nqmax)/log(2.0)+0.5);
+ if (nqmax > (1<<log2n)) {
+ log2n += 1;
+ }
+ /*
+ * initialize buffer point, max buffer size
+ */
+ nqx2 = (nqx+1)/2;
+ nqy2 = (nqy+1)/2;
+ bmax = (( nqx2)* ( nqy2)+1)/2;
+ /*
+ * We're indexing A as a 2-D array with dimensions (nqx,nqy).
+ * Scratch is 2-D with dimensions (nqx/2,nqy/2) rounded up.
+ * Buffer is used to store string of codes for output.
+ */
+ scratch = (unsigned char *) malloc(2*bmax);
+ buffer = (unsigned char *) malloc(bmax);
+ if ((scratch == (unsigned char *) NULL) ||
+ (buffer == (unsigned char *) NULL)) {
+ ffpmsg("qtree_encode64: insufficient memory");
+ return(DATA_COMPRESSION_ERR);
+ }
+ /*
+ * now encode each bit plane, starting with the top
+ */
+ for (bit=nbitplanes-1; bit >= 0; bit--) {
+ /*
+ * initial bit buffer
+ */
+ b = 0;
+ bitbuffer = 0;
+ bits_to_go3 = 0;
+ /*
+ * on first pass copy A to scratch array
+ */
+ qtree_onebit64(a,n,nqx,nqy,scratch,bit);
+ nx = (nqx+1)>>1;
+ ny = (nqy+1)>>1;
+ /*
+ * copy non-zero values to output buffer, which will be written
+ * in reverse order
+ */
+ if (bufcopy(scratch,nx*ny,buffer,&b,bmax)) {
+ /*
+ * quadtree is expanding data,
+ * change warning code and just fill buffer with bit-map
+ */
+ write_bdirect64(outfile,a,n,nqx,nqy,scratch,bit);
+ goto bitplane_done;
+ }
+ /*
+ * do log2n reductions
+ */
+ for (k = 1; k<log2n; k++) {
+ qtree_reduce(scratch,ny,nx,ny,scratch);
+ nx = (nx+1)>>1;
+ ny = (ny+1)>>1;
+ if (bufcopy(scratch,nx*ny,buffer,&b,bmax)) {
+ write_bdirect64(outfile,a,n,nqx,nqy,scratch,bit);
+ goto bitplane_done;
+ }
+ }
+ /*
+ * OK, we've got the code in buffer
+ * Write quadtree warning code, then write buffer in reverse order
+ */
+ output_nybble(outfile,0xF);
+ if (b==0) {
+ if (bits_to_go3>0) {
+ /*
+ * put out the last few bits
+ */
+ output_nbits(outfile, bitbuffer & ((1<<bits_to_go3)-1),
+ bits_to_go3);
+ } else {
+ /*
+ * have to write a zero nybble if there are no 1's in array
+ */
+ output_huffman(outfile,0);
+ }
+ } else {
+ if (bits_to_go3>0) {
+ /*
+ * put out the last few bits
+ */
+ output_nbits(outfile, bitbuffer & ((1<<bits_to_go3)-1),
+ bits_to_go3);
+ }
+ for (i=b-1; i>=0; i--) {
+ output_nbits(outfile,buffer[i],8);
+ }
+ }
+ bitplane_done: ;
+ }
+ free(buffer);
+ free(scratch);
+ return(0);
+}
+
+/* ######################################################################### */
+/*
+ * copy non-zero codes from array to buffer
+ */
+static int
+bufcopy(unsigned char a[], int n, unsigned char buffer[], int *b, int bmax)
+{
+int i;
+
+ for (i = 0; i < n; i++) {
+ if (a[i] != 0) {
+ /*
+ * add Huffman code for a[i] to buffer
+ */
+ bitbuffer |= code[a[i]] << bits_to_go3;
+ bits_to_go3 += ncode[a[i]];
+ if (bits_to_go3 >= 8) {
+ buffer[*b] = bitbuffer & 0xFF;
+ *b += 1;
+ /*
+ * return warning code if we fill buffer
+ */
+ if (*b >= bmax) return(1);
+ bitbuffer >>= 8;
+ bits_to_go3 -= 8;
+ }
+ }
+ }
+ return(0);
+}
+
+/* ######################################################################### */
+/*
+ * Do first quadtree reduction step on bit BIT of array A.
+ * Results put into B.
+ *
+ */
+static void
+qtree_onebit(int a[], int n, int nx, int ny, unsigned char b[], int bit)
+{
+int i, j, k;
+int b0, b1, b2, b3;
+int s10, s00;
+
+ /*
+ * use selected bit to get amount to shift
+ */
+ b0 = 1<<bit;
+ b1 = b0<<1;
+ b2 = b0<<2;
+ b3 = b0<<3;
+ k = 0; /* k is index of b[i/2,j/2] */
+ for (i = 0; i<nx-1; i += 2) {
+ s00 = n*i; /* s00 is index of a[i,j] */
+/* tried using s00+n directly in the statements, but this had no effect on performance */
+ s10 = s00+n; /* s10 is index of a[i+1,j] */
+ for (j = 0; j<ny-1; j += 2) {
+
+/*
+ this was not any faster..
+
+ b[k] = (a[s00] & b0) ?
+ (a[s00+1] & b0) ?
+ (a[s10] & b0) ?
+ (a[s10+1] & b0) ? 15 : 14
+ : (a[s10+1] & b0) ? 13 : 12
+ : (a[s10] & b0) ?
+ (a[s10+1] & b0) ? 11 : 10
+ : (a[s10+1] & b0) ? 9 : 8
+ : (a[s00+1] & b0) ?
+ (a[s10] & b0) ?
+ (a[s10+1] & b0) ? 7 : 6
+ : (a[s10+1] & b0) ? 5 : 4
+
+ : (a[s10] & b0) ?
+ (a[s10+1] & b0) ? 3 : 2
+ : (a[s10+1] & b0) ? 1 : 0;
+*/
+
+/*
+this alternative way of calculating b[k] was slowwer than the original code
+ if ( a[s00] & b0)
+ if ( a[s00+1] & b0)
+ if ( a[s10] & b0)
+ if ( a[s10+1] & b0)
+ b[k] = 15;
+ else
+ b[k] = 14;
+ else
+ if ( a[s10+1] & b0)
+ b[k] = 13;
+ else
+ b[k] = 12;
+ else
+ if ( a[s10] & b0)
+ if ( a[s10+1] & b0)
+ b[k] = 11;
+ else
+ b[k] = 10;
+ else
+ if ( a[s10+1] & b0)
+ b[k] = 9;
+ else
+ b[k] = 8;
+ else
+ if ( a[s00+1] & b0)
+ if ( a[s10] & b0)
+ if ( a[s10+1] & b0)
+ b[k] = 7;
+ else
+ b[k] = 6;
+ else
+ if ( a[s10+1] & b0)
+ b[k] = 5;
+ else
+ b[k] = 4;
+ else
+ if ( a[s10] & b0)
+ if ( a[s10+1] & b0)
+ b[k] = 3;
+ else
+ b[k] = 2;
+ else
+ if ( a[s10+1] & b0)
+ b[k] = 1;
+ else
+ b[k] = 0;
+*/
+
+
+
+ b[k] = ( ( a[s10+1] & b0)
+ | ((a[s10 ]<<1) & b1)
+ | ((a[s00+1]<<2) & b2)
+ | ((a[s00 ]<<3) & b3) ) >> bit;
+
+ k += 1;
+ s00 += 2;
+ s10 += 2;
+ }
+ if (j < ny) {
+ /*
+ * row size is odd, do last element in row
+ * s00+1,s10+1 are off edge
+ */
+ b[k] = ( ((a[s10 ]<<1) & b1)
+ | ((a[s00 ]<<3) & b3) ) >> bit;
+ k += 1;
+ }
+ }
+ if (i < nx) {
+ /*
+ * column size is odd, do last row
+ * s10,s10+1 are off edge
+ */
+ s00 = n*i;
+ for (j = 0; j<ny-1; j += 2) {
+ b[k] = ( ((a[s00+1]<<2) & b2)
+ | ((a[s00 ]<<3) & b3) ) >> bit;
+ k += 1;
+ s00 += 2;
+ }
+ if (j < ny) {
+ /*
+ * both row and column size are odd, do corner element
+ * s00+1, s10, s10+1 are off edge
+ */
+ b[k] = ( ((a[s00 ]<<3) & b3) ) >> bit;
+ k += 1;
+ }
+ }
+}
+/* ######################################################################### */
+/*
+ * Do first quadtree reduction step on bit BIT of array A.
+ * Results put into B.
+ *
+ */
+static void
+qtree_onebit64(LONGLONG a[], int n, int nx, int ny, unsigned char b[], int bit)
+{
+int i, j, k;
+LONGLONG b0, b1, b2, b3;
+int s10, s00;
+
+ /*
+ * use selected bit to get amount to shift
+ */
+ b0 = ((LONGLONG) 1)<<bit;
+ b1 = b0<<1;
+ b2 = b0<<2;
+ b3 = b0<<3;
+ k = 0; /* k is index of b[i/2,j/2] */
+ for (i = 0; i<nx-1; i += 2) {
+ s00 = n*i; /* s00 is index of a[i,j] */
+ s10 = s00+n; /* s10 is index of a[i+1,j] */
+ for (j = 0; j<ny-1; j += 2) {
+ b[k] = (unsigned char) (( ( a[s10+1] & b0)
+ | ((a[s10 ]<<1) & b1)
+ | ((a[s00+1]<<2) & b2)
+ | ((a[s00 ]<<3) & b3) ) >> bit);
+ k += 1;
+ s00 += 2;
+ s10 += 2;
+ }
+ if (j < ny) {
+ /*
+ * row size is odd, do last element in row
+ * s00+1,s10+1 are off edge
+ */
+ b[k] = (unsigned char) (( ((a[s10 ]<<1) & b1)
+ | ((a[s00 ]<<3) & b3) ) >> bit);
+ k += 1;
+ }
+ }
+ if (i < nx) {
+ /*
+ * column size is odd, do last row
+ * s10,s10+1 are off edge
+ */
+ s00 = n*i;
+ for (j = 0; j<ny-1; j += 2) {
+ b[k] = (unsigned char) (( ((a[s00+1]<<2) & b2)
+ | ((a[s00 ]<<3) & b3) ) >> bit);
+ k += 1;
+ s00 += 2;
+ }
+ if (j < ny) {
+ /*
+ * both row and column size are odd, do corner element
+ * s00+1, s10, s10+1 are off edge
+ */
+ b[k] = (unsigned char) (( ((a[s00 ]<<3) & b3) ) >> bit);
+ k += 1;
+ }
+ }
+}
+
+/* ######################################################################### */
+/*
+ * do one quadtree reduction step on array a
+ * results put into b (which may be the same as a)
+ */
+static void
+qtree_reduce(unsigned char a[], int n, int nx, int ny, unsigned char b[])
+{
+int i, j, k;
+int s10, s00;
+
+ k = 0; /* k is index of b[i/2,j/2] */
+ for (i = 0; i<nx-1; i += 2) {
+ s00 = n*i; /* s00 is index of a[i,j] */
+ s10 = s00+n; /* s10 is index of a[i+1,j] */
+ for (j = 0; j<ny-1; j += 2) {
+ b[k] = (a[s10+1] != 0)
+ | ( (a[s10 ] != 0) << 1)
+ | ( (a[s00+1] != 0) << 2)
+ | ( (a[s00 ] != 0) << 3);
+ k += 1;
+ s00 += 2;
+ s10 += 2;
+ }
+ if (j < ny) {
+ /*
+ * row size is odd, do last element in row
+ * s00+1,s10+1 are off edge
+ */
+ b[k] = ( (a[s10 ] != 0) << 1)
+ | ( (a[s00 ] != 0) << 3);
+ k += 1;
+ }
+ }
+ if (i < nx) {
+ /*
+ * column size is odd, do last row
+ * s10,s10+1 are off edge
+ */
+ s00 = n*i;
+ for (j = 0; j<ny-1; j += 2) {
+ b[k] = ( (a[s00+1] != 0) << 2)
+ | ( (a[s00 ] != 0) << 3);
+ k += 1;
+ s00 += 2;
+ }
+ if (j < ny) {
+ /*
+ * both row and column size are odd, do corner element
+ * s00+1, s10, s10+1 are off edge
+ */
+ b[k] = ( (a[s00 ] != 0) << 3);
+ k += 1;
+ }
+ }
+}
+
+/* ######################################################################### */
+static void
+write_bdirect(char *outfile, int a[], int n,int nqx, int nqy, unsigned char scratch[], int bit)
+{
+
+ /*
+ * Write the direct bitmap warning code
+ */
+ output_nybble(outfile,0x0);
+ /*
+ * Copy A to scratch array (again!), packing 4 bits/nybble
+ */
+ qtree_onebit(a,n,nqx,nqy,scratch,bit);
+ /*
+ * write to outfile
+ */
+/*
+int i;
+ for (i = 0; i < ((nqx+1)/2) * ((nqy+1)/2); i++) {
+ output_nybble(outfile,scratch[i]);
+ }
+*/
+ output_nnybble(outfile, ((nqx+1)/2) * ((nqy+1)/2), scratch);
+
+}
+/* ######################################################################### */
+static void
+write_bdirect64(char *outfile, LONGLONG a[], int n,int nqx, int nqy, unsigned char scratch[], int bit)
+{
+
+ /*
+ * Write the direct bitmap warning code
+ */
+ output_nybble(outfile,0x0);
+ /*
+ * Copy A to scratch array (again!), packing 4 bits/nybble
+ */
+ qtree_onebit64(a,n,nqx,nqy,scratch,bit);
+ /*
+ * write to outfile
+ */
+/*
+int i;
+ for (i = 0; i < ((nqx+1)/2) * ((nqy+1)/2); i++) {
+ output_nybble(outfile,scratch[i]);
+ }
+*/
+ output_nnybble(outfile, ((nqx+1)/2) * ((nqy+1)/2), scratch);
+}
diff --git a/src/plugins/cfitsio/fits_hdecompress.c b/src/plugins/cfitsio/fits_hdecompress.c
new file mode 100644
index 0000000..2086d38
--- /dev/null
+++ b/src/plugins/cfitsio/fits_hdecompress.c
@@ -0,0 +1,2618 @@
+/* #########################################################################
+These routines to apply the H-compress decompression algorithm to a 2-D Fits
+image were written by R. White at the STScI and were obtained from the STScI at
+http://www.stsci.edu/software/hcompress.html
+
+This source file is a concatination of the following sources files in the
+original distribution
+ hinv.c
+ hsmooth.c
+ undigitize.c
+ decode.c
+ dodecode.c
+ qtree_decode.c
+ qread.c
+ bit_input.c
+
+
+The following modifications have been made to the original code:
+
+ - commented out redundant "include" statements
+ - added the nextchar global variable
+ - changed all the 'extern' declarations to 'static', since all the routines are in
+ the same source file
+ - changed the first parameter in decode (and in lower level routines from a file stream
+ to a char array
+ - modified the myread routine, and lower level byte reading routines, to copy
+ the input bytes to a char array, instead of reading them from a file stream
+ - changed the function declarations to the more modern ANSI C style
+ - changed calls to printf and perror to call the CFITSIO ffpmsg routine
+ - replace "exit" statements with "return" statements
+
+ ############################################################################ */
+
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/* WDP added test to see if min and max are already defined */
+#ifndef min
+#define min(a,b) (((a)<(b))?(a):(b))
+#endif
+#ifndef max
+#define max(a,b) (((a)>(b))?(a):(b))
+#endif
+
+static long nextchar;
+
+static int decode(unsigned char *infile, int *a, int *nx, int *ny, int *scale);
+static int decode64(unsigned char *infile, LONGLONG *a, int *nx, int *ny, int *scale);
+static int hinv(int a[], int nx, int ny, int smooth ,int scale);
+static int hinv64(LONGLONG a[], int nx, int ny, int smooth ,int scale);
+static void undigitize(int a[], int nx, int ny, int scale);
+static void undigitize64(LONGLONG a[], int nx, int ny, int scale);
+static void unshuffle(int a[], int n, int n2, int tmp[]);
+static void unshuffle64(LONGLONG a[], int n, int n2, LONGLONG tmp[]);
+static void hsmooth(int a[], int nxtop, int nytop, int ny, int scale);
+static void hsmooth64(LONGLONG a[], int nxtop, int nytop, int ny, int scale);
+static void qread(unsigned char *infile,char *a, int n);
+static int readint(unsigned char *infile);
+static LONGLONG readlonglong(unsigned char *infile);
+static int dodecode(unsigned char *infile, int a[], int nx, int ny, unsigned char nbitplanes[3]);
+static int dodecode64(unsigned char *infile, LONGLONG a[], int nx, int ny, unsigned char nbitplanes[3]);
+static int qtree_decode(unsigned char *infile, int a[], int n, int nqx, int nqy, int nbitplanes);
+static int qtree_decode64(unsigned char *infile, LONGLONG a[], int n, int nqx, int nqy, int nbitplanes);
+static void start_inputing_bits(void);
+static int input_bit(unsigned char *infile);
+static int input_nbits(unsigned char *infile, int n);
+/* make input_nybble a separate routine, for added effiency */
+/* #define input_nybble(infile) input_nbits(infile,4) */
+static int input_nybble(unsigned char *infile);
+static int input_nnybble(unsigned char *infile, int n, unsigned char *array);
+
+static void qtree_expand(unsigned char *infile, unsigned char a[], int nx, int ny, unsigned char b[]);
+static void qtree_bitins(unsigned char a[], int nx, int ny, int b[], int n, int bit);
+static void qtree_bitins64(unsigned char a[], int nx, int ny, LONGLONG b[], int n, int bit);
+static void qtree_copy(unsigned char a[], int nx, int ny, unsigned char b[], int n);
+static void read_bdirect(unsigned char *infile, int a[], int n, int nqx, int nqy, unsigned char scratch[], int bit);
+static void read_bdirect64(unsigned char *infile, LONGLONG a[], int n, int nqx, int nqy, unsigned char scratch[], int bit);
+static int input_huffman(unsigned char *infile);
+
+/* ---------------------------------------------------------------------- */
+int fits_hdecompress(unsigned char *input, int smooth, int *a, int *ny, int *nx,
+ int *scale, int *status)
+{
+ /*
+ decompress the input byte stream using the H-compress algorithm
+
+ input - input array of compressed bytes
+ a - pre-allocated array to hold the output uncompressed image
+ nx - returned X axis size
+ ny - returned Y axis size
+
+ NOTE: the nx and ny dimensions as defined within this code are reversed from
+ the usual FITS notation. ny is the fastest varying dimension, which is
+ usually considered the X axis in the FITS image display
+
+ */
+int stat;
+
+ if (*status > 0) return(*status);
+
+ /* decode the input array */
+
+ FFLOCK; /* decode uses the nextchar global variable */
+ stat = decode(input, a, nx, ny, scale);
+ FFUNLOCK;
+
+ *status = stat;
+ if (stat) return(*status);
+
+ /*
+ * Un-Digitize
+ */
+ undigitize(a, *nx, *ny, *scale);
+
+ /*
+ * Inverse H-transform
+ */
+ stat = hinv(a, *nx, *ny, smooth, *scale);
+ *status = stat;
+
+ return(*status);
+}
+/* ---------------------------------------------------------------------- */
+int fits_hdecompress64(unsigned char *input, int smooth, LONGLONG *a, int *ny, int *nx,
+ int *scale, int *status)
+{
+ /*
+ decompress the input byte stream using the H-compress algorithm
+
+ input - input array of compressed bytes
+ a - pre-allocated array to hold the output uncompressed image
+ nx - returned X axis size
+ ny - returned Y axis size
+
+ NOTE: the nx and ny dimensions as defined within this code are reversed from
+ the usual FITS notation. ny is the fastest varying dimension, which is
+ usually considered the X axis in the FITS image display
+
+ */
+ int stat, *iarray, ii, nval;
+
+ if (*status > 0) return(*status);
+
+ /* decode the input array */
+
+ FFLOCK; /* decode uses the nextchar global variable */
+ stat = decode64(input, a, nx, ny, scale);
+ FFUNLOCK;
+
+ *status = stat;
+ if (stat) return(*status);
+
+ /*
+ * Un-Digitize
+ */
+ undigitize64(a, *nx, *ny, *scale);
+
+ /*
+ * Inverse H-transform
+ */
+ stat = hinv64(a, *nx, *ny, smooth, *scale);
+
+ *status = stat;
+
+ /* pack the I*8 values back into an I*4 array */
+ iarray = (int *) a;
+ nval = (*nx) * (*ny);
+
+ for (ii = 0; ii < nval; ii++)
+ iarray[ii] = (int) a[ii];
+
+ return(*status);
+}
+
+/* ############################################################################ */
+/* ############################################################################ */
+
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* hinv.c Inverse H-transform of NX x NY integer image
+ *
+ * Programmer: R. White Date: 23 July 1993
+ */
+
+/* ############################################################################ */
+static int
+hinv(int a[], int nx, int ny, int smooth ,int scale)
+/*
+int smooth; 0 for no smoothing, else smooth during inversion
+int scale; used if smoothing is specified
+*/
+{
+int nmax, log2n, i, j, k;
+int nxtop,nytop,nxf,nyf,c;
+int oddx,oddy;
+int shift, bit0, bit1, bit2, mask0, mask1, mask2,
+ prnd0, prnd1, prnd2, nrnd0, nrnd1, nrnd2, lowbit0, lowbit1;
+int h0, hx, hy, hc;
+int s10, s00;
+int *tmp;
+
+ /*
+ * log2n is log2 of max(nx,ny) rounded up to next power of 2
+ */
+ nmax = (nx>ny) ? nx : ny;
+ log2n = (int) (log((float) nmax)/log(2.0)+0.5);
+ if ( nmax > (1<<log2n) ) {
+ log2n += 1;
+ }
+ /*
+ * get temporary storage for shuffling elements
+ */
+ tmp = (int *) malloc(((nmax+1)/2)*sizeof(int));
+ if (tmp == (int *) NULL) {
+ ffpmsg("hinv: insufficient memory");
+ return(DATA_DECOMPRESSION_ERR);
+ }
+ /*
+ * set up masks, rounding parameters
+ */
+ shift = 1;
+ bit0 = 1 << (log2n - 1);
+ bit1 = bit0 << 1;
+ bit2 = bit0 << 2;
+ mask0 = -bit0;
+ mask1 = mask0 << 1;
+ mask2 = mask0 << 2;
+ prnd0 = bit0 >> 1;
+ prnd1 = bit1 >> 1;
+ prnd2 = bit2 >> 1;
+ nrnd0 = prnd0 - 1;
+ nrnd1 = prnd1 - 1;
+ nrnd2 = prnd2 - 1;
+ /*
+ * round h0 to multiple of bit2
+ */
+ a[0] = (a[0] + ((a[0] >= 0) ? prnd2 : nrnd2)) & mask2;
+ /*
+ * do log2n expansions
+ *
+ * We're indexing a as a 2-D array with dimensions (nx,ny).
+ */
+ nxtop = 1;
+ nytop = 1;
+ nxf = nx;
+ nyf = ny;
+ c = 1<<log2n;
+ for (k = log2n-1; k>=0; k--) {
+ /*
+ * this somewhat cryptic code generates the sequence
+ * ntop[k-1] = (ntop[k]+1)/2, where ntop[log2n] = n
+ */
+ c = c>>1;
+ nxtop = nxtop<<1;
+ nytop = nytop<<1;
+ if (nxf <= c) { nxtop -= 1; } else { nxf -= c; }
+ if (nyf <= c) { nytop -= 1; } else { nyf -= c; }
+ /*
+ * double shift and fix nrnd0 (because prnd0=0) on last pass
+ */
+ if (k == 0) {
+ nrnd0 = 0;
+ shift = 2;
+ }
+ /*
+ * unshuffle in each dimension to interleave coefficients
+ */
+ for (i = 0; i<nxtop; i++) {
+ unshuffle(&a[ny*i],nytop,1,tmp);
+ }
+ for (j = 0; j<nytop; j++) {
+ unshuffle(&a[j],nxtop,ny,tmp);
+ }
+ /*
+ * smooth by interpolating coefficients if SMOOTH != 0
+ */
+ if (smooth) hsmooth(a,nxtop,nytop,ny,scale);
+ oddx = nxtop % 2;
+ oddy = nytop % 2;
+ for (i = 0; i<nxtop-oddx; i += 2) {
+ s00 = ny*i; /* s00 is index of a[i,j] */
+ s10 = s00+ny; /* s10 is index of a[i+1,j] */
+ for (j = 0; j<nytop-oddy; j += 2) {
+ h0 = a[s00 ];
+ hx = a[s10 ];
+ hy = a[s00+1];
+ hc = a[s10+1];
+ /*
+ * round hx and hy to multiple of bit1, hc to multiple of bit0
+ * h0 is already a multiple of bit2
+ */
+ hx = (hx + ((hx >= 0) ? prnd1 : nrnd1)) & mask1;
+ hy = (hy + ((hy >= 0) ? prnd1 : nrnd1)) & mask1;
+ hc = (hc + ((hc >= 0) ? prnd0 : nrnd0)) & mask0;
+ /*
+ * propagate bit0 of hc to hx,hy
+ */
+ lowbit0 = hc & bit0;
+ hx = (hx >= 0) ? (hx - lowbit0) : (hx + lowbit0);
+ hy = (hy >= 0) ? (hy - lowbit0) : (hy + lowbit0);
+ /*
+ * Propagate bits 0 and 1 of hc,hx,hy to h0.
+ * This could be simplified if we assume h0>0, but then
+ * the inversion would not be lossless for images with
+ * negative pixels.
+ */
+ lowbit1 = (hc ^ hx ^ hy) & bit1;
+ h0 = (h0 >= 0)
+ ? (h0 + lowbit0 - lowbit1)
+ : (h0 + ((lowbit0 == 0) ? lowbit1 : (lowbit0-lowbit1)));
+ /*
+ * Divide sums by 2 (4 last time)
+ */
+ a[s10+1] = (h0 + hx + hy + hc) >> shift;
+ a[s10 ] = (h0 + hx - hy - hc) >> shift;
+ a[s00+1] = (h0 - hx + hy - hc) >> shift;
+ a[s00 ] = (h0 - hx - hy + hc) >> shift;
+ s00 += 2;
+ s10 += 2;
+ }
+ if (oddy) {
+ /*
+ * do last element in row if row length is odd
+ * s00+1, s10+1 are off edge
+ */
+ h0 = a[s00 ];
+ hx = a[s10 ];
+ hx = ((hx >= 0) ? (hx+prnd1) : (hx+nrnd1)) & mask1;
+ lowbit1 = hx & bit1;
+ h0 = (h0 >= 0) ? (h0 - lowbit1) : (h0 + lowbit1);
+ a[s10 ] = (h0 + hx) >> shift;
+ a[s00 ] = (h0 - hx) >> shift;
+ }
+ }
+ if (oddx) {
+ /*
+ * do last row if column length is odd
+ * s10, s10+1 are off edge
+ */
+ s00 = ny*i;
+ for (j = 0; j<nytop-oddy; j += 2) {
+ h0 = a[s00 ];
+ hy = a[s00+1];
+ hy = ((hy >= 0) ? (hy+prnd1) : (hy+nrnd1)) & mask1;
+ lowbit1 = hy & bit1;
+ h0 = (h0 >= 0) ? (h0 - lowbit1) : (h0 + lowbit1);
+ a[s00+1] = (h0 + hy) >> shift;
+ a[s00 ] = (h0 - hy) >> shift;
+ s00 += 2;
+ }
+ if (oddy) {
+ /*
+ * do corner element if both row and column lengths are odd
+ * s00+1, s10, s10+1 are off edge
+ */
+ h0 = a[s00 ];
+ a[s00 ] = h0 >> shift;
+ }
+ }
+ /*
+ * divide all the masks and rounding values by 2
+ */
+ bit2 = bit1;
+ bit1 = bit0;
+ bit0 = bit0 >> 1;
+ mask1 = mask0;
+ mask0 = mask0 >> 1;
+ prnd1 = prnd0;
+ prnd0 = prnd0 >> 1;
+ nrnd1 = nrnd0;
+ nrnd0 = prnd0 - 1;
+ }
+ free(tmp);
+ return(0);
+}
+/* ############################################################################ */
+static int
+hinv64(LONGLONG a[], int nx, int ny, int smooth ,int scale)
+/*
+int smooth; 0 for no smoothing, else smooth during inversion
+int scale; used if smoothing is specified
+*/
+{
+int nmax, log2n, i, j, k;
+int nxtop,nytop,nxf,nyf,c;
+int oddx,oddy;
+int shift;
+LONGLONG mask0, mask1, mask2, prnd0, prnd1, prnd2, bit0, bit1, bit2;
+LONGLONG nrnd0, nrnd1, nrnd2, lowbit0, lowbit1;
+LONGLONG h0, hx, hy, hc;
+int s10, s00;
+LONGLONG *tmp;
+
+ /*
+ * log2n is log2 of max(nx,ny) rounded up to next power of 2
+ */
+ nmax = (nx>ny) ? nx : ny;
+ log2n = (int) (log((float) nmax)/log(2.0)+0.5);
+ if ( nmax > (1<<log2n) ) {
+ log2n += 1;
+ }
+ /*
+ * get temporary storage for shuffling elements
+ */
+ tmp = (LONGLONG *) malloc(((nmax+1)/2)*sizeof(LONGLONG));
+ if (tmp == (LONGLONG *) NULL) {
+ ffpmsg("hinv64: insufficient memory");
+ return(DATA_DECOMPRESSION_ERR);
+ }
+ /*
+ * set up masks, rounding parameters
+ */
+ shift = 1;
+ bit0 = ((LONGLONG) 1) << (log2n - 1);
+ bit1 = bit0 << 1;
+ bit2 = bit0 << 2;
+ mask0 = -bit0;
+ mask1 = mask0 << 1;
+ mask2 = mask0 << 2;
+ prnd0 = bit0 >> 1;
+ prnd1 = bit1 >> 1;
+ prnd2 = bit2 >> 1;
+ nrnd0 = prnd0 - 1;
+ nrnd1 = prnd1 - 1;
+ nrnd2 = prnd2 - 1;
+ /*
+ * round h0 to multiple of bit2
+ */
+ a[0] = (a[0] + ((a[0] >= 0) ? prnd2 : nrnd2)) & mask2;
+ /*
+ * do log2n expansions
+ *
+ * We're indexing a as a 2-D array with dimensions (nx,ny).
+ */
+ nxtop = 1;
+ nytop = 1;
+ nxf = nx;
+ nyf = ny;
+ c = 1<<log2n;
+ for (k = log2n-1; k>=0; k--) {
+ /*
+ * this somewhat cryptic code generates the sequence
+ * ntop[k-1] = (ntop[k]+1)/2, where ntop[log2n] = n
+ */
+ c = c>>1;
+ nxtop = nxtop<<1;
+ nytop = nytop<<1;
+ if (nxf <= c) { nxtop -= 1; } else { nxf -= c; }
+ if (nyf <= c) { nytop -= 1; } else { nyf -= c; }
+ /*
+ * double shift and fix nrnd0 (because prnd0=0) on last pass
+ */
+ if (k == 0) {
+ nrnd0 = 0;
+ shift = 2;
+ }
+ /*
+ * unshuffle in each dimension to interleave coefficients
+ */
+ for (i = 0; i<nxtop; i++) {
+ unshuffle64(&a[ny*i],nytop,1,tmp);
+ }
+ for (j = 0; j<nytop; j++) {
+ unshuffle64(&a[j],nxtop,ny,tmp);
+ }
+ /*
+ * smooth by interpolating coefficients if SMOOTH != 0
+ */
+ if (smooth) hsmooth64(a,nxtop,nytop,ny,scale);
+ oddx = nxtop % 2;
+ oddy = nytop % 2;
+ for (i = 0; i<nxtop-oddx; i += 2) {
+ s00 = ny*i; /* s00 is index of a[i,j] */
+ s10 = s00+ny; /* s10 is index of a[i+1,j] */
+ for (j = 0; j<nytop-oddy; j += 2) {
+ h0 = a[s00 ];
+ hx = a[s10 ];
+ hy = a[s00+1];
+ hc = a[s10+1];
+ /*
+ * round hx and hy to multiple of bit1, hc to multiple of bit0
+ * h0 is already a multiple of bit2
+ */
+ hx = (hx + ((hx >= 0) ? prnd1 : nrnd1)) & mask1;
+ hy = (hy + ((hy >= 0) ? prnd1 : nrnd1)) & mask1;
+ hc = (hc + ((hc >= 0) ? prnd0 : nrnd0)) & mask0;
+ /*
+ * propagate bit0 of hc to hx,hy
+ */
+ lowbit0 = hc & bit0;
+ hx = (hx >= 0) ? (hx - lowbit0) : (hx + lowbit0);
+ hy = (hy >= 0) ? (hy - lowbit0) : (hy + lowbit0);
+ /*
+ * Propagate bits 0 and 1 of hc,hx,hy to h0.
+ * This could be simplified if we assume h0>0, but then
+ * the inversion would not be lossless for images with
+ * negative pixels.
+ */
+ lowbit1 = (hc ^ hx ^ hy) & bit1;
+ h0 = (h0 >= 0)
+ ? (h0 + lowbit0 - lowbit1)
+ : (h0 + ((lowbit0 == 0) ? lowbit1 : (lowbit0-lowbit1)));
+ /*
+ * Divide sums by 2 (4 last time)
+ */
+ a[s10+1] = (h0 + hx + hy + hc) >> shift;
+ a[s10 ] = (h0 + hx - hy - hc) >> shift;
+ a[s00+1] = (h0 - hx + hy - hc) >> shift;
+ a[s00 ] = (h0 - hx - hy + hc) >> shift;
+ s00 += 2;
+ s10 += 2;
+ }
+ if (oddy) {
+ /*
+ * do last element in row if row length is odd
+ * s00+1, s10+1 are off edge
+ */
+ h0 = a[s00 ];
+ hx = a[s10 ];
+ hx = ((hx >= 0) ? (hx+prnd1) : (hx+nrnd1)) & mask1;
+ lowbit1 = hx & bit1;
+ h0 = (h0 >= 0) ? (h0 - lowbit1) : (h0 + lowbit1);
+ a[s10 ] = (h0 + hx) >> shift;
+ a[s00 ] = (h0 - hx) >> shift;
+ }
+ }
+ if (oddx) {
+ /*
+ * do last row if column length is odd
+ * s10, s10+1 are off edge
+ */
+ s00 = ny*i;
+ for (j = 0; j<nytop-oddy; j += 2) {
+ h0 = a[s00 ];
+ hy = a[s00+1];
+ hy = ((hy >= 0) ? (hy+prnd1) : (hy+nrnd1)) & mask1;
+ lowbit1 = hy & bit1;
+ h0 = (h0 >= 0) ? (h0 - lowbit1) : (h0 + lowbit1);
+ a[s00+1] = (h0 + hy) >> shift;
+ a[s00 ] = (h0 - hy) >> shift;
+ s00 += 2;
+ }
+ if (oddy) {
+ /*
+ * do corner element if both row and column lengths are odd
+ * s00+1, s10, s10+1 are off edge
+ */
+ h0 = a[s00 ];
+ a[s00 ] = h0 >> shift;
+ }
+ }
+ /*
+ * divide all the masks and rounding values by 2
+ */
+ bit2 = bit1;
+ bit1 = bit0;
+ bit0 = bit0 >> 1;
+ mask1 = mask0;
+ mask0 = mask0 >> 1;
+ prnd1 = prnd0;
+ prnd0 = prnd0 >> 1;
+ nrnd1 = nrnd0;
+ nrnd0 = prnd0 - 1;
+ }
+ free(tmp);
+ return(0);
+}
+
+/* ############################################################################ */
+static void
+unshuffle(int a[], int n, int n2, int tmp[])
+/*
+int a[]; array to shuffle
+int n; number of elements to shuffle
+int n2; second dimension
+int tmp[]; scratch storage
+*/
+{
+int i;
+int nhalf;
+int *p1, *p2, *pt;
+
+ /*
+ * copy 2nd half of array to tmp
+ */
+ nhalf = (n+1)>>1;
+ pt = tmp;
+ p1 = &a[n2*nhalf]; /* pointer to a[i] */
+ for (i=nhalf; i<n; i++) {
+ *pt = *p1;
+ p1 += n2;
+ pt += 1;
+ }
+ /*
+ * distribute 1st half of array to even elements
+ */
+ p2 = &a[ n2*(nhalf-1) ]; /* pointer to a[i] */
+ p1 = &a[(n2*(nhalf-1))<<1]; /* pointer to a[2*i] */
+ for (i=nhalf-1; i >= 0; i--) {
+ *p1 = *p2;
+ p2 -= n2;
+ p1 -= (n2+n2);
+ }
+ /*
+ * now distribute 2nd half of array (in tmp) to odd elements
+ */
+ pt = tmp;
+ p1 = &a[n2]; /* pointer to a[i] */
+ for (i=1; i<n; i += 2) {
+ *p1 = *pt;
+ p1 += (n2+n2);
+ pt += 1;
+ }
+}
+/* ############################################################################ */
+static void
+unshuffle64(LONGLONG a[], int n, int n2, LONGLONG tmp[])
+/*
+LONGLONG a[]; array to shuffle
+int n; number of elements to shuffle
+int n2; second dimension
+LONGLONG tmp[]; scratch storage
+*/
+{
+int i;
+int nhalf;
+LONGLONG *p1, *p2, *pt;
+
+ /*
+ * copy 2nd half of array to tmp
+ */
+ nhalf = (n+1)>>1;
+ pt = tmp;
+ p1 = &a[n2*nhalf]; /* pointer to a[i] */
+ for (i=nhalf; i<n; i++) {
+ *pt = *p1;
+ p1 += n2;
+ pt += 1;
+ }
+ /*
+ * distribute 1st half of array to even elements
+ */
+ p2 = &a[ n2*(nhalf-1) ]; /* pointer to a[i] */
+ p1 = &a[(n2*(nhalf-1))<<1]; /* pointer to a[2*i] */
+ for (i=nhalf-1; i >= 0; i--) {
+ *p1 = *p2;
+ p2 -= n2;
+ p1 -= (n2+n2);
+ }
+ /*
+ * now distribute 2nd half of array (in tmp) to odd elements
+ */
+ pt = tmp;
+ p1 = &a[n2]; /* pointer to a[i] */
+ for (i=1; i<n; i += 2) {
+ *p1 = *pt;
+ p1 += (n2+n2);
+ pt += 1;
+ }
+}
+
+/* ############################################################################ */
+/* ############################################################################ */
+
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* hsmooth.c Smooth H-transform image by adjusting coefficients toward
+ * interpolated values
+ *
+ * Programmer: R. White Date: 13 April 1992
+ */
+
+/* ############################################################################ */
+static void
+hsmooth(int a[], int nxtop, int nytop, int ny, int scale)
+/*
+int a[]; array of H-transform coefficients
+int nxtop,nytop; size of coefficient block to use
+int ny; actual 1st dimension of array
+int scale; truncation scale factor that was used
+*/
+{
+int i, j;
+int ny2, s10, s00, diff, dmax, dmin, s, smax;
+int hm, h0, hp, hmm, hpm, hmp, hpp, hx2, hy2;
+int m1,m2;
+
+ /*
+ * Maximum change in coefficients is determined by scale factor.
+ * Since we rounded during division (see digitize.c), the biggest
+ * permitted change is scale/2.
+ */
+ smax = (scale >> 1);
+ if (smax <= 0) return;
+ ny2 = ny << 1;
+ /*
+ * We're indexing a as a 2-D array with dimensions (nxtop,ny) of which
+ * only (nxtop,nytop) are used. The coefficients on the edge of the
+ * array are not adjusted (which is why the loops below start at 2
+ * instead of 0 and end at nxtop-2 instead of nxtop.)
+ */
+ /*
+ * Adjust x difference hx
+ */
+ for (i = 2; i<nxtop-2; i += 2) {
+ s00 = ny*i; /* s00 is index of a[i,j] */
+ s10 = s00+ny; /* s10 is index of a[i+1,j] */
+ for (j = 0; j<nytop; j += 2) {
+ /*
+ * hp is h0 (mean value) in next x zone, hm is h0 in previous x zone
+ */
+ hm = a[s00-ny2];
+ h0 = a[s00];
+ hp = a[s00+ny2];
+ /*
+ * diff = 8 * hx slope that would match h0 in neighboring zones
+ */
+ diff = hp-hm;
+ /*
+ * monotonicity constraints on diff
+ */
+ dmax = max( min( (hp-h0), (h0-hm) ), 0 ) << 2;
+ dmin = min( max( (hp-h0), (h0-hm) ), 0 ) << 2;
+ /*
+ * if monotonicity would set slope = 0 then don't change hx.
+ * note dmax>=0, dmin<=0.
+ */
+ if (dmin < dmax) {
+ diff = max( min(diff, dmax), dmin);
+ /*
+ * Compute change in slope limited to range +/- smax.
+ * Careful with rounding negative numbers when using
+ * shift for divide by 8.
+ */
+ s = diff-(a[s10]<<3);
+ s = (s>=0) ? (s>>3) : ((s+7)>>3) ;
+ s = max( min(s, smax), -smax);
+ a[s10] = a[s10]+s;
+ }
+ s00 += 2;
+ s10 += 2;
+ }
+ }
+ /*
+ * Adjust y difference hy
+ */
+ for (i = 0; i<nxtop; i += 2) {
+ s00 = ny*i+2;
+ s10 = s00+ny;
+ for (j = 2; j<nytop-2; j += 2) {
+ hm = a[s00-2];
+ h0 = a[s00];
+ hp = a[s00+2];
+ diff = hp-hm;
+ dmax = max( min( (hp-h0), (h0-hm) ), 0 ) << 2;
+ dmin = min( max( (hp-h0), (h0-hm) ), 0 ) << 2;
+ if (dmin < dmax) {
+ diff = max( min(diff, dmax), dmin);
+ s = diff-(a[s00+1]<<3);
+ s = (s>=0) ? (s>>3) : ((s+7)>>3) ;
+ s = max( min(s, smax), -smax);
+ a[s00+1] = a[s00+1]+s;
+ }
+ s00 += 2;
+ s10 += 2;
+ }
+ }
+ /*
+ * Adjust curvature difference hc
+ */
+ for (i = 2; i<nxtop-2; i += 2) {
+ s00 = ny*i+2;
+ s10 = s00+ny;
+ for (j = 2; j<nytop-2; j += 2) {
+ /*
+ * ------------------ y
+ * | hmp | | hpp | |
+ * ------------------ |
+ * | | h0 | | |
+ * ------------------ -------x
+ * | hmm | | hpm |
+ * ------------------
+ */
+ hmm = a[s00-ny2-2];
+ hpm = a[s00+ny2-2];
+ hmp = a[s00-ny2+2];
+ hpp = a[s00+ny2+2];
+ h0 = a[s00];
+ /*
+ * diff = 64 * hc value that would match h0 in neighboring zones
+ */
+ diff = hpp + hmm - hmp - hpm;
+ /*
+ * 2 times x,y slopes in this zone
+ */
+ hx2 = a[s10 ]<<1;
+ hy2 = a[s00+1]<<1;
+ /*
+ * monotonicity constraints on diff
+ */
+ m1 = min(max(hpp-h0,0)-hx2-hy2, max(h0-hpm,0)+hx2-hy2);
+ m2 = min(max(h0-hmp,0)-hx2+hy2, max(hmm-h0,0)+hx2+hy2);
+ dmax = min(m1,m2) << 4;
+ m1 = max(min(hpp-h0,0)-hx2-hy2, min(h0-hpm,0)+hx2-hy2);
+ m2 = max(min(h0-hmp,0)-hx2+hy2, min(hmm-h0,0)+hx2+hy2);
+ dmin = max(m1,m2) << 4;
+ /*
+ * if monotonicity would set slope = 0 then don't change hc.
+ * note dmax>=0, dmin<=0.
+ */
+ if (dmin < dmax) {
+ diff = max( min(diff, dmax), dmin);
+ /*
+ * Compute change in slope limited to range +/- smax.
+ * Careful with rounding negative numbers when using
+ * shift for divide by 64.
+ */
+ s = diff-(a[s10+1]<<6);
+ s = (s>=0) ? (s>>6) : ((s+63)>>6) ;
+ s = max( min(s, smax), -smax);
+ a[s10+1] = a[s10+1]+s;
+ }
+ s00 += 2;
+ s10 += 2;
+ }
+ }
+}
+/* ############################################################################ */
+static void
+hsmooth64(LONGLONG a[], int nxtop, int nytop, int ny, int scale)
+/*
+LONGLONG a[]; array of H-transform coefficients
+int nxtop,nytop; size of coefficient block to use
+int ny; actual 1st dimension of array
+int scale; truncation scale factor that was used
+*/
+{
+int i, j;
+int ny2, s10, s00;
+LONGLONG hm, h0, hp, hmm, hpm, hmp, hpp, hx2, hy2, diff, dmax, dmin, s, smax, m1, m2;
+
+ /*
+ * Maximum change in coefficients is determined by scale factor.
+ * Since we rounded during division (see digitize.c), the biggest
+ * permitted change is scale/2.
+ */
+ smax = (scale >> 1);
+ if (smax <= 0) return;
+ ny2 = ny << 1;
+ /*
+ * We're indexing a as a 2-D array with dimensions (nxtop,ny) of which
+ * only (nxtop,nytop) are used. The coefficients on the edge of the
+ * array are not adjusted (which is why the loops below start at 2
+ * instead of 0 and end at nxtop-2 instead of nxtop.)
+ */
+ /*
+ * Adjust x difference hx
+ */
+ for (i = 2; i<nxtop-2; i += 2) {
+ s00 = ny*i; /* s00 is index of a[i,j] */
+ s10 = s00+ny; /* s10 is index of a[i+1,j] */
+ for (j = 0; j<nytop; j += 2) {
+ /*
+ * hp is h0 (mean value) in next x zone, hm is h0 in previous x zone
+ */
+ hm = a[s00-ny2];
+ h0 = a[s00];
+ hp = a[s00+ny2];
+ /*
+ * diff = 8 * hx slope that would match h0 in neighboring zones
+ */
+ diff = hp-hm;
+ /*
+ * monotonicity constraints on diff
+ */
+ dmax = max( min( (hp-h0), (h0-hm) ), 0 ) << 2;
+ dmin = min( max( (hp-h0), (h0-hm) ), 0 ) << 2;
+ /*
+ * if monotonicity would set slope = 0 then don't change hx.
+ * note dmax>=0, dmin<=0.
+ */
+ if (dmin < dmax) {
+ diff = max( min(diff, dmax), dmin);
+ /*
+ * Compute change in slope limited to range +/- smax.
+ * Careful with rounding negative numbers when using
+ * shift for divide by 8.
+ */
+ s = diff-(a[s10]<<3);
+ s = (s>=0) ? (s>>3) : ((s+7)>>3) ;
+ s = max( min(s, smax), -smax);
+ a[s10] = a[s10]+s;
+ }
+ s00 += 2;
+ s10 += 2;
+ }
+ }
+ /*
+ * Adjust y difference hy
+ */
+ for (i = 0; i<nxtop; i += 2) {
+ s00 = ny*i+2;
+ s10 = s00+ny;
+ for (j = 2; j<nytop-2; j += 2) {
+ hm = a[s00-2];
+ h0 = a[s00];
+ hp = a[s00+2];
+ diff = hp-hm;
+ dmax = max( min( (hp-h0), (h0-hm) ), 0 ) << 2;
+ dmin = min( max( (hp-h0), (h0-hm) ), 0 ) << 2;
+ if (dmin < dmax) {
+ diff = max( min(diff, dmax), dmin);
+ s = diff-(a[s00+1]<<3);
+ s = (s>=0) ? (s>>3) : ((s+7)>>3) ;
+ s = max( min(s, smax), -smax);
+ a[s00+1] = a[s00+1]+s;
+ }
+ s00 += 2;
+ s10 += 2;
+ }
+ }
+ /*
+ * Adjust curvature difference hc
+ */
+ for (i = 2; i<nxtop-2; i += 2) {
+ s00 = ny*i+2;
+ s10 = s00+ny;
+ for (j = 2; j<nytop-2; j += 2) {
+ /*
+ * ------------------ y
+ * | hmp | | hpp | |
+ * ------------------ |
+ * | | h0 | | |
+ * ------------------ -------x
+ * | hmm | | hpm |
+ * ------------------
+ */
+ hmm = a[s00-ny2-2];
+ hpm = a[s00+ny2-2];
+ hmp = a[s00-ny2+2];
+ hpp = a[s00+ny2+2];
+ h0 = a[s00];
+ /*
+ * diff = 64 * hc value that would match h0 in neighboring zones
+ */
+ diff = hpp + hmm - hmp - hpm;
+ /*
+ * 2 times x,y slopes in this zone
+ */
+ hx2 = a[s10 ]<<1;
+ hy2 = a[s00+1]<<1;
+ /*
+ * monotonicity constraints on diff
+ */
+ m1 = min(max(hpp-h0,0)-hx2-hy2, max(h0-hpm,0)+hx2-hy2);
+ m2 = min(max(h0-hmp,0)-hx2+hy2, max(hmm-h0,0)+hx2+hy2);
+ dmax = min(m1,m2) << 4;
+ m1 = max(min(hpp-h0,0)-hx2-hy2, min(h0-hpm,0)+hx2-hy2);
+ m2 = max(min(h0-hmp,0)-hx2+hy2, min(hmm-h0,0)+hx2+hy2);
+ dmin = max(m1,m2) << 4;
+ /*
+ * if monotonicity would set slope = 0 then don't change hc.
+ * note dmax>=0, dmin<=0.
+ */
+ if (dmin < dmax) {
+ diff = max( min(diff, dmax), dmin);
+ /*
+ * Compute change in slope limited to range +/- smax.
+ * Careful with rounding negative numbers when using
+ * shift for divide by 64.
+ */
+ s = diff-(a[s10+1]<<6);
+ s = (s>=0) ? (s>>6) : ((s+63)>>6) ;
+ s = max( min(s, smax), -smax);
+ a[s10+1] = a[s10+1]+s;
+ }
+ s00 += 2;
+ s10 += 2;
+ }
+ }
+}
+
+
+/* ############################################################################ */
+/* ############################################################################ */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* undigitize.c undigitize H-transform
+ *
+ * Programmer: R. White Date: 9 May 1991
+ */
+
+/* ############################################################################ */
+static void
+undigitize(int a[], int nx, int ny, int scale)
+{
+int *p;
+
+ /*
+ * multiply by scale
+ */
+ if (scale <= 1) return;
+ for (p=a; p <= &a[nx*ny-1]; p++) *p = (*p)*scale;
+}
+/* ############################################################################ */
+static void
+undigitize64(LONGLONG a[], int nx, int ny, int scale)
+{
+LONGLONG *p, scale64;
+
+ /*
+ * multiply by scale
+ */
+ if (scale <= 1) return;
+ scale64 = (LONGLONG) scale; /* use a 64-bit int for efficiency in the big loop */
+
+ for (p=a; p <= &a[nx*ny-1]; p++) *p = (*p)*scale64;
+}
+
+/* ############################################################################ */
+/* ############################################################################ */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* decode.c read codes from infile and construct array
+ *
+ * Programmer: R. White Date: 2 February 1994
+ */
+
+
+static char code_magic[2] = { (char)0xDD, (char)0x99 };
+
+/* ############################################################################ */
+static int decode(unsigned char *infile, int *a, int *nx, int *ny, int *scale)
+/*
+char *infile; input file
+int *a; address of output array [nx][ny]
+int *nx,*ny; size of output array
+int *scale; scale factor for digitization
+*/
+{
+LONGLONG sumall;
+int nel, stat;
+unsigned char nbitplanes[3];
+char tmagic[2];
+
+ /* initialize the byte read position to the beginning of the array */;
+ nextchar = 0;
+
+ /*
+ * File starts either with special 2-byte magic code or with
+ * FITS keyword "SIMPLE ="
+ */
+ qread(infile, tmagic, sizeof(tmagic));
+ /*
+ * check for correct magic code value
+ */
+ if (memcmp(tmagic,code_magic,sizeof(code_magic)) != 0) {
+ ffpmsg("bad file format");
+ return(DATA_DECOMPRESSION_ERR);
+ }
+ *nx =readint(infile); /* x size of image */
+ *ny =readint(infile); /* y size of image */
+ *scale=readint(infile); /* scale factor for digitization */
+
+ nel = (*nx) * (*ny);
+
+ /* sum of all pixels */
+ sumall=readlonglong(infile);
+ /* # bits in quadrants */
+
+ qread(infile, (char *) nbitplanes, sizeof(nbitplanes));
+
+ stat = dodecode(infile, a, *nx, *ny, nbitplanes);
+ /*
+ * put sum of all pixels back into pixel 0
+ */
+ a[0] = (int) sumall;
+ return(stat);
+}
+/* ############################################################################ */
+static int decode64(unsigned char *infile, LONGLONG *a, int *nx, int *ny, int *scale)
+/*
+char *infile; input file
+LONGLONG *a; address of output array [nx][ny]
+int *nx,*ny; size of output array
+int *scale; scale factor for digitization
+*/
+{
+int nel, stat;
+LONGLONG sumall;
+unsigned char nbitplanes[3];
+char tmagic[2];
+
+ /* initialize the byte read position to the beginning of the array */;
+ nextchar = 0;
+
+ /*
+ * File starts either with special 2-byte magic code or with
+ * FITS keyword "SIMPLE ="
+ */
+ qread(infile, tmagic, sizeof(tmagic));
+ /*
+ * check for correct magic code value
+ */
+ if (memcmp(tmagic,code_magic,sizeof(code_magic)) != 0) {
+ ffpmsg("bad file format");
+ return(DATA_DECOMPRESSION_ERR);
+ }
+ *nx =readint(infile); /* x size of image */
+ *ny =readint(infile); /* y size of image */
+ *scale=readint(infile); /* scale factor for digitization */
+
+ nel = (*nx) * (*ny);
+
+ /* sum of all pixels */
+ sumall=readlonglong(infile);
+ /* # bits in quadrants */
+
+ qread(infile, (char *) nbitplanes, sizeof(nbitplanes));
+
+ stat = dodecode64(infile, a, *nx, *ny, nbitplanes);
+ /*
+ * put sum of all pixels back into pixel 0
+ */
+ a[0] = sumall;
+
+ return(stat);
+}
+
+
+/* ############################################################################ */
+/* ############################################################################ */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* dodecode.c Decode stream of characters on infile and return array
+ *
+ * This version encodes the different quadrants separately
+ *
+ * Programmer: R. White Date: 9 May 1991
+ */
+
+/* ############################################################################ */
+static int
+dodecode(unsigned char *infile, int a[], int nx, int ny, unsigned char nbitplanes[3])
+
+/* int a[];
+ int nx,ny; Array dimensions are [nx][ny]
+ unsigned char nbitplanes[3]; Number of bit planes in quadrants
+*/
+{
+int i, nel, nx2, ny2, stat;
+
+ nel = nx*ny;
+ nx2 = (nx+1)/2;
+ ny2 = (ny+1)/2;
+
+ /*
+ * initialize a to zero
+ */
+ for (i=0; i<nel; i++) a[i] = 0;
+ /*
+ * Initialize bit input
+ */
+ start_inputing_bits();
+ /*
+ * read bit planes for each quadrant
+ */
+ stat = qtree_decode(infile, &a[0], ny, nx2, ny2, nbitplanes[0]);
+ if (stat) return(stat);
+
+ stat = qtree_decode(infile, &a[ny2], ny, nx2, ny/2, nbitplanes[1]);
+ if (stat) return(stat);
+
+ stat = qtree_decode(infile, &a[ny*nx2], ny, nx/2, ny2, nbitplanes[1]);
+ if (stat) return(stat);
+
+ stat = qtree_decode(infile, &a[ny*nx2+ny2], ny, nx/2, ny/2, nbitplanes[2]);
+ if (stat) return(stat);
+
+ /*
+ * make sure there is an EOF symbol (nybble=0) at end
+ */
+ if (input_nybble(infile) != 0) {
+ ffpmsg("dodecode: bad bit plane values");
+ return(DATA_DECOMPRESSION_ERR);
+ }
+ /*
+ * now get the sign bits
+ * Re-initialize bit input
+ */
+ start_inputing_bits();
+ for (i=0; i<nel; i++) {
+ if (a[i]) {
+ /* tried putting the input_bit code in-line here, instead of */
+ /* calling the function, but it made no difference in the speed */
+ if (input_bit(infile)) a[i] = -a[i];
+ }
+ }
+ return(0);
+}
+/* ############################################################################ */
+static int
+dodecode64(unsigned char *infile, LONGLONG a[], int nx, int ny, unsigned char nbitplanes[3])
+
+/* LONGLONG a[];
+ int nx,ny; Array dimensions are [nx][ny]
+ unsigned char nbitplanes[3]; Number of bit planes in quadrants
+*/
+{
+int i, nel, nx2, ny2, stat;
+
+ nel = nx*ny;
+ nx2 = (nx+1)/2;
+ ny2 = (ny+1)/2;
+
+ /*
+ * initialize a to zero
+ */
+ for (i=0; i<nel; i++) a[i] = 0;
+ /*
+ * Initialize bit input
+ */
+ start_inputing_bits();
+ /*
+ * read bit planes for each quadrant
+ */
+ stat = qtree_decode64(infile, &a[0], ny, nx2, ny2, nbitplanes[0]);
+ if (stat) return(stat);
+
+ stat = qtree_decode64(infile, &a[ny2], ny, nx2, ny/2, nbitplanes[1]);
+ if (stat) return(stat);
+
+ stat = qtree_decode64(infile, &a[ny*nx2], ny, nx/2, ny2, nbitplanes[1]);
+ if (stat) return(stat);
+
+ stat = qtree_decode64(infile, &a[ny*nx2+ny2], ny, nx/2, ny/2, nbitplanes[2]);
+ if (stat) return(stat);
+
+ /*
+ * make sure there is an EOF symbol (nybble=0) at end
+ */
+ if (input_nybble(infile) != 0) {
+ ffpmsg("dodecode64: bad bit plane values");
+ return(DATA_DECOMPRESSION_ERR);
+ }
+ /*
+ * now get the sign bits
+ * Re-initialize bit input
+ */
+ start_inputing_bits();
+ for (i=0; i<nel; i++) {
+ if (a[i]) {
+ if (input_bit(infile) != 0) a[i] = -a[i];
+ }
+ }
+ return(0);
+}
+
+/* ############################################################################ */
+/* ############################################################################ */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* qtree_decode.c Read stream of codes from infile and construct bit planes
+ * in quadrant of 2-D array using binary quadtree coding
+ *
+ * Programmer: R. White Date: 7 May 1991
+ */
+
+/* ############################################################################ */
+static int
+qtree_decode(unsigned char *infile, int a[], int n, int nqx, int nqy, int nbitplanes)
+
+/*
+char *infile;
+int a[]; a is 2-D array with dimensions (n,n)
+int n; length of full row in a
+int nqx; partial length of row to decode
+int nqy; partial length of column (<=n)
+int nbitplanes; number of bitplanes to decode
+*/
+{
+int log2n, k, bit, b, nqmax;
+int nx,ny,nfx,nfy,c;
+int nqx2, nqy2;
+unsigned char *scratch;
+
+ /*
+ * log2n is log2 of max(nqx,nqy) rounded up to next power of 2
+ */
+ nqmax = (nqx>nqy) ? nqx : nqy;
+ log2n = (int) (log((float) nqmax)/log(2.0)+0.5);
+ if (nqmax > (1<<log2n)) {
+ log2n += 1;
+ }
+ /*
+ * allocate scratch array for working space
+ */
+ nqx2=(nqx+1)/2;
+ nqy2=(nqy+1)/2;
+ scratch = (unsigned char *) malloc(nqx2*nqy2);
+ if (scratch == (unsigned char *) NULL) {
+ ffpmsg("qtree_decode: insufficient memory");
+ return(DATA_DECOMPRESSION_ERR);
+ }
+ /*
+ * now decode each bit plane, starting at the top
+ * A is assumed to be initialized to zero
+ */
+ for (bit = nbitplanes-1; bit >= 0; bit--) {
+ /*
+ * Was bitplane was quadtree-coded or written directly?
+ */
+ b = input_nybble(infile);
+
+ if(b == 0) {
+ /*
+ * bit map was written directly
+ */
+ read_bdirect(infile,a,n,nqx,nqy,scratch,bit);
+ } else if (b != 0xf) {
+ ffpmsg("qtree_decode: bad format code");
+ return(DATA_DECOMPRESSION_ERR);
+ } else {
+ /*
+ * bitmap was quadtree-coded, do log2n expansions
+ *
+ * read first code
+ */
+ scratch[0] = input_huffman(infile);
+ /*
+ * now do log2n expansions, reading codes from file as necessary
+ */
+ nx = 1;
+ ny = 1;
+ nfx = nqx;
+ nfy = nqy;
+ c = 1<<log2n;
+ for (k = 1; k<log2n; k++) {
+ /*
+ * this somewhat cryptic code generates the sequence
+ * n[k-1] = (n[k]+1)/2 where n[log2n]=nqx or nqy
+ */
+ c = c>>1;
+ nx = nx<<1;
+ ny = ny<<1;
+ if (nfx <= c) { nx -= 1; } else { nfx -= c; }
+ if (nfy <= c) { ny -= 1; } else { nfy -= c; }
+ qtree_expand(infile,scratch,nx,ny,scratch);
+ }
+ /*
+ * now copy last set of 4-bit codes to bitplane bit of array a
+ */
+ qtree_bitins(scratch,nqx,nqy,a,n,bit);
+ }
+ }
+ free(scratch);
+ return(0);
+}
+/* ############################################################################ */
+static int
+qtree_decode64(unsigned char *infile, LONGLONG a[], int n, int nqx, int nqy, int nbitplanes)
+
+/*
+char *infile;
+LONGLONG a[]; a is 2-D array with dimensions (n,n)
+int n; length of full row in a
+int nqx; partial length of row to decode
+int nqy; partial length of column (<=n)
+int nbitplanes; number of bitplanes to decode
+*/
+{
+int log2n, k, bit, b, nqmax;
+int nx,ny,nfx,nfy,c;
+int nqx2, nqy2;
+unsigned char *scratch;
+
+ /*
+ * log2n is log2 of max(nqx,nqy) rounded up to next power of 2
+ */
+ nqmax = (nqx>nqy) ? nqx : nqy;
+ log2n = (int) (log((float) nqmax)/log(2.0)+0.5);
+ if (nqmax > (1<<log2n)) {
+ log2n += 1;
+ }
+ /*
+ * allocate scratch array for working space
+ */
+ nqx2=(nqx+1)/2;
+ nqy2=(nqy+1)/2;
+ scratch = (unsigned char *) malloc(nqx2*nqy2);
+ if (scratch == (unsigned char *) NULL) {
+ ffpmsg("qtree_decode64: insufficient memory");
+ return(DATA_DECOMPRESSION_ERR);
+ }
+ /*
+ * now decode each bit plane, starting at the top
+ * A is assumed to be initialized to zero
+ */
+ for (bit = nbitplanes-1; bit >= 0; bit--) {
+ /*
+ * Was bitplane was quadtree-coded or written directly?
+ */
+ b = input_nybble(infile);
+
+ if(b == 0) {
+ /*
+ * bit map was written directly
+ */
+ read_bdirect64(infile,a,n,nqx,nqy,scratch,bit);
+ } else if (b != 0xf) {
+ ffpmsg("qtree_decode64: bad format code");
+ return(DATA_DECOMPRESSION_ERR);
+ } else {
+ /*
+ * bitmap was quadtree-coded, do log2n expansions
+ *
+ * read first code
+ */
+ scratch[0] = input_huffman(infile);
+ /*
+ * now do log2n expansions, reading codes from file as necessary
+ */
+ nx = 1;
+ ny = 1;
+ nfx = nqx;
+ nfy = nqy;
+ c = 1<<log2n;
+ for (k = 1; k<log2n; k++) {
+ /*
+ * this somewhat cryptic code generates the sequence
+ * n[k-1] = (n[k]+1)/2 where n[log2n]=nqx or nqy
+ */
+ c = c>>1;
+ nx = nx<<1;
+ ny = ny<<1;
+ if (nfx <= c) { nx -= 1; } else { nfx -= c; }
+ if (nfy <= c) { ny -= 1; } else { nfy -= c; }
+ qtree_expand(infile,scratch,nx,ny,scratch);
+ }
+ /*
+ * now copy last set of 4-bit codes to bitplane bit of array a
+ */
+ qtree_bitins64(scratch,nqx,nqy,a,n,bit);
+ }
+ }
+ free(scratch);
+ return(0);
+}
+
+
+/* ############################################################################ */
+/*
+ * do one quadtree expansion step on array a[(nqx+1)/2,(nqy+1)/2]
+ * results put into b[nqx,nqy] (which may be the same as a)
+ */
+static void
+qtree_expand(unsigned char *infile, unsigned char a[], int nx, int ny, unsigned char b[])
+{
+int i;
+
+ /*
+ * first copy a to b, expanding each 4-bit value
+ */
+ qtree_copy(a,nx,ny,b,ny);
+ /*
+ * now read new 4-bit values into b for each non-zero element
+ */
+ for (i = nx*ny-1; i >= 0; i--) {
+ if (b[i]) b[i] = input_huffman(infile);
+ }
+}
+
+/* ############################################################################ */
+/*
+ * copy 4-bit values from a[(nx+1)/2,(ny+1)/2] to b[nx,ny], expanding
+ * each value to 2x2 pixels
+ * a,b may be same array
+ */
+static void
+qtree_copy(unsigned char a[], int nx, int ny, unsigned char b[], int n)
+/* int n; declared y dimension of b */
+{
+int i, j, k, nx2, ny2;
+int s00, s10;
+
+ /*
+ * first copy 4-bit values to b
+ * start at end in case a,b are same array
+ */
+ nx2 = (nx+1)/2;
+ ny2 = (ny+1)/2;
+ k = ny2*(nx2-1)+ny2-1; /* k is index of a[i,j] */
+ for (i = nx2-1; i >= 0; i--) {
+ s00 = 2*(n*i+ny2-1); /* s00 is index of b[2*i,2*j] */
+ for (j = ny2-1; j >= 0; j--) {
+ b[s00] = a[k];
+ k -= 1;
+ s00 -= 2;
+ }
+ }
+ /*
+ * now expand each 2x2 block
+ */
+ for (i = 0; i<nx-1; i += 2) {
+
+ /* Note:
+ Unlike the case in qtree_bitins, this code runs faster on a 32-bit linux
+ machine using the s10 intermediate variable, rather that using s00+n.
+ Go figure!
+ */
+ s00 = n*i; /* s00 is index of b[i,j] */
+ s10 = s00+n; /* s10 is index of b[i+1,j] */
+
+ for (j = 0; j<ny-1; j += 2) {
+
+ switch (b[s00]) {
+ case(0):
+ b[s10+1] = 0;
+ b[s10 ] = 0;
+ b[s00+1] = 0;
+ b[s00 ] = 0;
+
+ break;
+ case(1):
+ b[s10+1] = 1;
+ b[s10 ] = 0;
+ b[s00+1] = 0;
+ b[s00 ] = 0;
+
+ break;
+ case(2):
+ b[s10+1] = 0;
+ b[s10 ] = 1;
+ b[s00+1] = 0;
+ b[s00 ] = 0;
+
+ break;
+ case(3):
+ b[s10+1] = 1;
+ b[s10 ] = 1;
+ b[s00+1] = 0;
+ b[s00 ] = 0;
+
+ break;
+ case(4):
+ b[s10+1] = 0;
+ b[s10 ] = 0;
+ b[s00+1] = 1;
+ b[s00 ] = 0;
+
+ break;
+ case(5):
+ b[s10+1] = 1;
+ b[s10 ] = 0;
+ b[s00+1] = 1;
+ b[s00 ] = 0;
+
+ break;
+ case(6):
+ b[s10+1] = 0;
+ b[s10 ] = 1;
+ b[s00+1] = 1;
+ b[s00 ] = 0;
+
+ break;
+ case(7):
+ b[s10+1] = 1;
+ b[s10 ] = 1;
+ b[s00+1] = 1;
+ b[s00 ] = 0;
+
+ break;
+ case(8):
+ b[s10+1] = 0;
+ b[s10 ] = 0;
+ b[s00+1] = 0;
+ b[s00 ] = 1;
+
+ break;
+ case(9):
+ b[s10+1] = 1;
+ b[s10 ] = 0;
+ b[s00+1] = 0;
+ b[s00 ] = 1;
+ break;
+ case(10):
+ b[s10+1] = 0;
+ b[s10 ] = 1;
+ b[s00+1] = 0;
+ b[s00 ] = 1;
+
+ break;
+ case(11):
+ b[s10+1] = 1;
+ b[s10 ] = 1;
+ b[s00+1] = 0;
+ b[s00 ] = 1;
+
+ break;
+ case(12):
+ b[s10+1] = 0;
+ b[s10 ] = 0;
+ b[s00+1] = 1;
+ b[s00 ] = 1;
+
+ break;
+ case(13):
+ b[s10+1] = 1;
+ b[s10 ] = 0;
+ b[s00+1] = 1;
+ b[s00 ] = 1;
+
+ break;
+ case(14):
+ b[s10+1] = 0;
+ b[s10 ] = 1;
+ b[s00+1] = 1;
+ b[s00 ] = 1;
+
+ break;
+ case(15):
+ b[s10+1] = 1;
+ b[s10 ] = 1;
+ b[s00+1] = 1;
+ b[s00 ] = 1;
+
+ break;
+ }
+/*
+ b[s10+1] = b[s00] & 1;
+ b[s10 ] = (b[s00]>>1) & 1;
+ b[s00+1] = (b[s00]>>2) & 1;
+ b[s00 ] = (b[s00]>>3) & 1;
+*/
+
+ s00 += 2;
+ s10 += 2;
+ }
+
+ if (j < ny) {
+ /*
+ * row size is odd, do last element in row
+ * s00+1, s10+1 are off edge
+ */
+ /* not worth converting this to use 16 case statements */
+ b[s10 ] = (b[s00]>>1) & 1;
+ b[s00 ] = (b[s00]>>3) & 1;
+ }
+ }
+ if (i < nx) {
+ /*
+ * column size is odd, do last row
+ * s10, s10+1 are off edge
+ */
+ s00 = n*i;
+ for (j = 0; j<ny-1; j += 2) {
+ /* not worth converting this to use 16 case statements */
+ b[s00+1] = (b[s00]>>2) & 1;
+ b[s00 ] = (b[s00]>>3) & 1;
+ s00 += 2;
+ }
+ if (j < ny) {
+ /*
+ * both row and column size are odd, do corner element
+ * s00+1, s10, s10+1 are off edge
+ */
+ /* not worth converting this to use 16 case statements */
+ b[s00 ] = (b[s00]>>3) & 1;
+ }
+ }
+}
+
+/* ############################################################################ */
+/*
+ * Copy 4-bit values from a[(nx+1)/2,(ny+1)/2] to b[nx,ny], expanding
+ * each value to 2x2 pixels and inserting into bitplane BIT of B.
+ * A,B may NOT be same array (it wouldn't make sense to be inserting
+ * bits into the same array anyway.)
+ */
+static void
+qtree_bitins(unsigned char a[], int nx, int ny, int b[], int n, int bit)
+/*
+ int n; declared y dimension of b
+*/
+{
+int i, j, k;
+int s00;
+int plane_val;
+
+ plane_val = 1 << bit;
+
+ /*
+ * expand each 2x2 block
+ */
+ k = 0; /* k is index of a[i/2,j/2] */
+ for (i = 0; i<nx-1; i += 2) {
+ s00 = n*i; /* s00 is index of b[i,j] */
+
+ /* Note:
+ this code appears to run very slightly faster on a 32-bit linux
+ machine using s00+n rather than the s10 intermediate variable
+ */
+ /* s10 = s00+n; */ /* s10 is index of b[i+1,j] */
+ for (j = 0; j<ny-1; j += 2) {
+
+ switch (a[k]) {
+ case(0):
+ break;
+ case(1):
+ b[s00+n+1] |= plane_val;
+ break;
+ case(2):
+ b[s00+n ] |= plane_val;
+ break;
+ case(3):
+ b[s00+n+1] |= plane_val;
+ b[s00+n ] |= plane_val;
+ break;
+ case(4):
+ b[s00+1] |= plane_val;
+ break;
+ case(5):
+ b[s00+n+1] |= plane_val;
+ b[s00+1] |= plane_val;
+ break;
+ case(6):
+ b[s00+n ] |= plane_val;
+ b[s00+1] |= plane_val;
+ break;
+ case(7):
+ b[s00+n+1] |= plane_val;
+ b[s00+n ] |= plane_val;
+ b[s00+1] |= plane_val;
+ break;
+ case(8):
+ b[s00 ] |= plane_val;
+ break;
+ case(9):
+ b[s00+n+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(10):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(11):
+ b[s00+n+1] |= plane_val;
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(12):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(13):
+ b[s00+n+1] |= plane_val;
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(14):
+ b[s00+n ] |= plane_val;
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(15):
+ b[s00+n+1] |= plane_val;
+ b[s00+n ] |= plane_val;
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ }
+
+/*
+ b[s10+1] |= ( a[k] & 1) << bit;
+ b[s10 ] |= ((a[k]>>1) & 1) << bit;
+ b[s00+1] |= ((a[k]>>2) & 1) << bit;
+ b[s00 ] |= ((a[k]>>3) & 1) << bit;
+*/
+ s00 += 2;
+/* s10 += 2; */
+ k += 1;
+ }
+ if (j < ny) {
+ /*
+ * row size is odd, do last element in row
+ * s00+1, s10+1 are off edge
+ */
+
+ switch (a[k]) {
+ case(0):
+ break;
+ case(1):
+ break;
+ case(2):
+ b[s00+n ] |= plane_val;
+ break;
+ case(3):
+ b[s00+n ] |= plane_val;
+ break;
+ case(4):
+ break;
+ case(5):
+ break;
+ case(6):
+ b[s00+n ] |= plane_val;
+ break;
+ case(7):
+ b[s00+n ] |= plane_val;
+ break;
+ case(8):
+ b[s00 ] |= plane_val;
+ break;
+ case(9):
+ b[s00 ] |= plane_val;
+ break;
+ case(10):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(11):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(12):
+ b[s00 ] |= plane_val;
+ break;
+ case(13):
+ b[s00 ] |= plane_val;
+ break;
+ case(14):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(15):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ }
+
+/*
+ b[s10 ] |= ((a[k]>>1) & 1) << bit;
+ b[s00 ] |= ((a[k]>>3) & 1) << bit;
+*/
+ k += 1;
+ }
+ }
+ if (i < nx) {
+ /*
+ * column size is odd, do last row
+ * s10, s10+1 are off edge
+ */
+ s00 = n*i;
+ for (j = 0; j<ny-1; j += 2) {
+
+ switch (a[k]) {
+ case(0):
+ break;
+ case(1):
+ break;
+ case(2):
+ break;
+ case(3):
+ break;
+ case(4):
+ b[s00+1] |= plane_val;
+ break;
+ case(5):
+ b[s00+1] |= plane_val;
+ break;
+ case(6):
+ b[s00+1] |= plane_val;
+ break;
+ case(7):
+ b[s00+1] |= plane_val;
+ break;
+ case(8):
+ b[s00 ] |= plane_val;
+ break;
+ case(9):
+ b[s00 ] |= plane_val;
+ break;
+ case(10):
+ b[s00 ] |= plane_val;
+ break;
+ case(11):
+ b[s00 ] |= plane_val;
+ break;
+ case(12):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(13):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(14):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(15):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ }
+
+/*
+ b[s00+1] |= ((a[k]>>2) & 1) << bit;
+ b[s00 ] |= ((a[k]>>3) & 1) << bit;
+*/
+
+ s00 += 2;
+ k += 1;
+ }
+ if (j < ny) {
+ /*
+ * both row and column size are odd, do corner element
+ * s00+1, s10, s10+1 are off edge
+ */
+
+ switch (a[k]) {
+ case(0):
+ break;
+ case(1):
+ break;
+ case(2):
+ break;
+ case(3):
+ break;
+ case(4):
+ break;
+ case(5):
+ break;
+ case(6):
+ break;
+ case(7):
+ break;
+ case(8):
+ b[s00 ] |= plane_val;
+ break;
+ case(9):
+ b[s00 ] |= plane_val;
+ break;
+ case(10):
+ b[s00 ] |= plane_val;
+ break;
+ case(11):
+ b[s00 ] |= plane_val;
+ break;
+ case(12):
+ b[s00 ] |= plane_val;
+ break;
+ case(13):
+ b[s00 ] |= plane_val;
+ break;
+ case(14):
+ b[s00 ] |= plane_val;
+ break;
+ case(15):
+ b[s00 ] |= plane_val;
+ break;
+ }
+
+/*
+ b[s00 ] |= ((a[k]>>3) & 1) << bit;
+*/
+ k += 1;
+ }
+ }
+}
+/* ############################################################################ */
+/*
+ * Copy 4-bit values from a[(nx+1)/2,(ny+1)/2] to b[nx,ny], expanding
+ * each value to 2x2 pixels and inserting into bitplane BIT of B.
+ * A,B may NOT be same array (it wouldn't make sense to be inserting
+ * bits into the same array anyway.)
+ */
+static void
+qtree_bitins64(unsigned char a[], int nx, int ny, LONGLONG b[], int n, int bit)
+/*
+ int n; declared y dimension of b
+*/
+{
+int i, j, k;
+int s00;
+int plane_val;
+
+ plane_val = 1 << bit;
+
+ /*
+ * expand each 2x2 block
+ */
+ k = 0; /* k is index of a[i/2,j/2] */
+ for (i = 0; i<nx-1; i += 2) {
+ s00 = n*i; /* s00 is index of b[i,j] */
+
+ /* Note:
+ this code appears to run very slightly faster on a 32-bit linux
+ machine using s00+n rather than the s10 intermediate variable
+ */
+ /* s10 = s00+n; */ /* s10 is index of b[i+1,j] */
+ for (j = 0; j<ny-1; j += 2) {
+
+ switch (a[k]) {
+ case(0):
+ break;
+ case(1):
+ b[s00+n+1] |= plane_val;
+ break;
+ case(2):
+ b[s00+n ] |= plane_val;
+ break;
+ case(3):
+ b[s00+n+1] |= plane_val;
+ b[s00+n ] |= plane_val;
+ break;
+ case(4):
+ b[s00+1] |= plane_val;
+ break;
+ case(5):
+ b[s00+n+1] |= plane_val;
+ b[s00+1] |= plane_val;
+ break;
+ case(6):
+ b[s00+n ] |= plane_val;
+ b[s00+1] |= plane_val;
+ break;
+ case(7):
+ b[s00+n+1] |= plane_val;
+ b[s00+n ] |= plane_val;
+ b[s00+1] |= plane_val;
+ break;
+ case(8):
+ b[s00 ] |= plane_val;
+ break;
+ case(9):
+ b[s00+n+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(10):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(11):
+ b[s00+n+1] |= plane_val;
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(12):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(13):
+ b[s00+n+1] |= plane_val;
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(14):
+ b[s00+n ] |= plane_val;
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(15):
+ b[s00+n+1] |= plane_val;
+ b[s00+n ] |= plane_val;
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ }
+
+/*
+ b[s10+1] |= ((LONGLONG) ( a[k] & 1)) << bit;
+ b[s10 ] |= ((((LONGLONG)a[k])>>1) & 1) << bit;
+ b[s00+1] |= ((((LONGLONG)a[k])>>2) & 1) << bit;
+ b[s00 ] |= ((((LONGLONG)a[k])>>3) & 1) << bit;
+*/
+ s00 += 2;
+/* s10 += 2; */
+ k += 1;
+ }
+ if (j < ny) {
+ /*
+ * row size is odd, do last element in row
+ * s00+1, s10+1 are off edge
+ */
+
+ switch (a[k]) {
+ case(0):
+ break;
+ case(1):
+ break;
+ case(2):
+ b[s00+n ] |= plane_val;
+ break;
+ case(3):
+ b[s00+n ] |= plane_val;
+ break;
+ case(4):
+ break;
+ case(5):
+ break;
+ case(6):
+ b[s00+n ] |= plane_val;
+ break;
+ case(7):
+ b[s00+n ] |= plane_val;
+ break;
+ case(8):
+ b[s00 ] |= plane_val;
+ break;
+ case(9):
+ b[s00 ] |= plane_val;
+ break;
+ case(10):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(11):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(12):
+ b[s00 ] |= plane_val;
+ break;
+ case(13):
+ b[s00 ] |= plane_val;
+ break;
+ case(14):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(15):
+ b[s00+n ] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ }
+/*
+ b[s10 ] |= ((((LONGLONG)a[k])>>1) & 1) << bit;
+ b[s00 ] |= ((((LONGLONG)a[k])>>3) & 1) << bit;
+*/
+ k += 1;
+ }
+ }
+ if (i < nx) {
+ /*
+ * column size is odd, do last row
+ * s10, s10+1 are off edge
+ */
+ s00 = n*i;
+ for (j = 0; j<ny-1; j += 2) {
+
+ switch (a[k]) {
+ case(0):
+ break;
+ case(1):
+ break;
+ case(2):
+ break;
+ case(3):
+ break;
+ case(4):
+ b[s00+1] |= plane_val;
+ break;
+ case(5):
+ b[s00+1] |= plane_val;
+ break;
+ case(6):
+ b[s00+1] |= plane_val;
+ break;
+ case(7):
+ b[s00+1] |= plane_val;
+ break;
+ case(8):
+ b[s00 ] |= plane_val;
+ break;
+ case(9):
+ b[s00 ] |= plane_val;
+ break;
+ case(10):
+ b[s00 ] |= plane_val;
+ break;
+ case(11):
+ b[s00 ] |= plane_val;
+ break;
+ case(12):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(13):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(14):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ case(15):
+ b[s00+1] |= plane_val;
+ b[s00 ] |= plane_val;
+ break;
+ }
+
+/*
+ b[s00+1] |= ((((LONGLONG)a[k])>>2) & 1) << bit;
+ b[s00 ] |= ((((LONGLONG)a[k])>>3) & 1) << bit;
+*/
+ s00 += 2;
+ k += 1;
+ }
+ if (j < ny) {
+ /*
+ * both row and column size are odd, do corner element
+ * s00+1, s10, s10+1 are off edge
+ */
+
+ switch (a[k]) {
+ case(0):
+ break;
+ case(1):
+ break;
+ case(2):
+ break;
+ case(3):
+ break;
+ case(4):
+ break;
+ case(5):
+ break;
+ case(6):
+ break;
+ case(7):
+ break;
+ case(8):
+ b[s00 ] |= plane_val;
+ break;
+ case(9):
+ b[s00 ] |= plane_val;
+ break;
+ case(10):
+ b[s00 ] |= plane_val;
+ break;
+ case(11):
+ b[s00 ] |= plane_val;
+ break;
+ case(12):
+ b[s00 ] |= plane_val;
+ break;
+ case(13):
+ b[s00 ] |= plane_val;
+ break;
+ case(14):
+ b[s00 ] |= plane_val;
+ break;
+ case(15):
+ b[s00 ] |= plane_val;
+ break;
+ }
+/*
+ b[s00 ] |= ((((LONGLONG)a[k])>>3) & 1) << bit;
+*/
+ k += 1;
+ }
+ }
+}
+
+/* ############################################################################ */
+static void
+read_bdirect(unsigned char *infile, int a[], int n, int nqx, int nqy, unsigned char scratch[], int bit)
+{
+ /*
+ * read bit image packed 4 pixels/nybble
+ */
+/*
+int i;
+ for (i = 0; i < ((nqx+1)/2) * ((nqy+1)/2); i++) {
+ scratch[i] = input_nybble(infile);
+ }
+*/
+ input_nnybble(infile, ((nqx+1)/2) * ((nqy+1)/2), scratch);
+
+ /*
+ * insert in bitplane BIT of image A
+ */
+ qtree_bitins(scratch,nqx,nqy,a,n,bit);
+}
+/* ############################################################################ */
+static void
+read_bdirect64(unsigned char *infile, LONGLONG a[], int n, int nqx, int nqy, unsigned char scratch[], int bit)
+{
+ /*
+ * read bit image packed 4 pixels/nybble
+ */
+/*
+int i;
+ for (i = 0; i < ((nqx+1)/2) * ((nqy+1)/2); i++) {
+ scratch[i] = input_nybble(infile);
+ }
+*/
+ input_nnybble(infile, ((nqx+1)/2) * ((nqy+1)/2), scratch);
+
+ /*
+ * insert in bitplane BIT of image A
+ */
+ qtree_bitins64(scratch,nqx,nqy,a,n,bit);
+}
+
+/* ############################################################################ */
+/*
+ * Huffman decoding for fixed codes
+ *
+ * Coded values range from 0-15
+ *
+ * Huffman code values (hex):
+ *
+ * 3e, 00, 01, 08, 02, 09, 1a, 1b,
+ * 03, 1c, 0a, 1d, 0b, 1e, 3f, 0c
+ *
+ * and number of bits in each code:
+ *
+ * 6, 3, 3, 4, 3, 4, 5, 5,
+ * 3, 5, 4, 5, 4, 5, 6, 4
+ */
+static int input_huffman(unsigned char *infile)
+{
+int c;
+
+ /*
+ * get first 3 bits to start
+ */
+ c = input_nbits(infile,3);
+ if (c < 4) {
+ /*
+ * this is all we need
+ * return 1,2,4,8 for c=0,1,2,3
+ */
+ return(1<<c);
+ }
+ /*
+ * get the next bit
+ */
+ c = input_bit(infile) | (c<<1);
+ if (c < 13) {
+ /*
+ * OK, 4 bits is enough
+ */
+ switch (c) {
+ case 8 : return(3);
+ case 9 : return(5);
+ case 10 : return(10);
+ case 11 : return(12);
+ case 12 : return(15);
+ }
+ }
+ /*
+ * get yet another bit
+ */
+ c = input_bit(infile) | (c<<1);
+ if (c < 31) {
+ /*
+ * OK, 5 bits is enough
+ */
+ switch (c) {
+ case 26 : return(6);
+ case 27 : return(7);
+ case 28 : return(9);
+ case 29 : return(11);
+ case 30 : return(13);
+ }
+ }
+ /*
+ * need the 6th bit
+ */
+ c = input_bit(infile) | (c<<1);
+ if (c == 62) {
+ return(0);
+ } else {
+ return(14);
+ }
+}
+
+/* ############################################################################ */
+/* ############################################################################ */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+/* qread.c Read binary data
+ *
+ * Programmer: R. White Date: 11 March 1991
+ */
+
+static int readint(unsigned char *infile)
+{
+int a,i;
+unsigned char b[4];
+
+ /* Read integer A one byte at a time from infile.
+ *
+ * This is portable from Vax to Sun since it eliminates the
+ * need for byte-swapping.
+ *
+ * This routine is only called to read the first 3 values
+ * in the compressed file, so it doesn't have to be
+ * super-efficient
+ */
+ for (i=0; i<4; i++) qread(infile,(char *) &b[i],1);
+ a = b[0];
+ for (i=1; i<4; i++) a = (a<<8) + b[i];
+ return(a);
+}
+
+/* ############################################################################ */
+static LONGLONG readlonglong(unsigned char *infile)
+{
+int i;
+LONGLONG a;
+unsigned char b[8];
+
+ /* Read integer A one byte at a time from infile.
+ *
+ * This is portable from Vax to Sun since it eliminates the
+ * need for byte-swapping.
+ *
+ * This routine is only called to read the first 3 values
+ * in the compressed file, so it doesn't have to be
+ * super-efficient
+ */
+ for (i=0; i<8; i++) qread(infile,(char *) &b[i],1);
+ a = b[0];
+ for (i=1; i<8; i++) a = (a<<8) + b[i];
+ return(a);
+}
+
+/* ############################################################################ */
+static void qread(unsigned char *file, char buffer[], int n)
+{
+ /*
+ * read n bytes from file into buffer
+ *
+ */
+
+ memcpy(buffer, &file[nextchar], n);
+ nextchar += n;
+}
+
+/* ############################################################################ */
+/* ############################################################################ */
+/* Copyright (c) 1993 Association of Universities for Research
+ * in Astronomy. All rights reserved. Produced under National
+ * Aeronautics and Space Administration Contract No. NAS5-26555.
+ */
+
+/* BIT INPUT ROUTINES */
+
+/* THE BIT BUFFER */
+
+static int buffer2; /* Bits waiting to be input */
+static int bits_to_go; /* Number of bits still in buffer */
+
+/* INITIALIZE BIT INPUT */
+
+/* ############################################################################ */
+static void start_inputing_bits(void)
+{
+ /*
+ * Buffer starts out with no bits in it
+ */
+ bits_to_go = 0;
+}
+
+/* ############################################################################ */
+/* INPUT A BIT */
+
+static int input_bit(unsigned char *infile)
+{
+ if (bits_to_go == 0) { /* Read the next byte if no */
+
+ buffer2 = infile[nextchar];
+ nextchar++;
+
+ bits_to_go = 8;
+ }
+ /*
+ * Return the next bit
+ */
+ bits_to_go -= 1;
+ return((buffer2>>bits_to_go) & 1);
+}
+
+/* ############################################################################ */
+/* INPUT N BITS (N must be <= 8) */
+
+static int input_nbits(unsigned char *infile, int n)
+{
+ /* AND mask for retreiving the right-most n bits */
+ static int mask[9] = {0, 1, 3, 7, 15, 31, 63, 127, 255};
+
+ if (bits_to_go < n) {
+ /*
+ * need another byte's worth of bits
+ */
+
+ buffer2 = (buffer2<<8) | (int) infile[nextchar];
+ nextchar++;
+ bits_to_go += 8;
+ }
+ /*
+ * now pick off the first n bits
+ */
+ bits_to_go -= n;
+
+ /* there was a slight gain in speed by replacing the following line */
+/* return( (buffer2>>bits_to_go) & ((1<<n)-1) ); */
+ return( (buffer2>>bits_to_go) & (*(mask+n)) );
+}
+/* ############################################################################ */
+/* INPUT 4 BITS */
+
+static int input_nybble(unsigned char *infile)
+{
+ if (bits_to_go < 4) {
+ /*
+ * need another byte's worth of bits
+ */
+
+ buffer2 = (buffer2<<8) | (int) infile[nextchar];
+ nextchar++;
+ bits_to_go += 8;
+ }
+ /*
+ * now pick off the first 4 bits
+ */
+ bits_to_go -= 4;
+
+ return( (buffer2>>bits_to_go) & 15 );
+}
+/* ############################################################################ */
+/* INPUT array of 4 BITS */
+
+static int input_nnybble(unsigned char *infile, int n, unsigned char array[])
+{
+ /* copy n 4-bit nybbles from infile to the lower 4 bits of array */
+
+int ii, kk, shift1, shift2;
+
+/* forcing byte alignment doesn;t help, and even makes it go slightly slower
+if (bits_to_go != 8) input_nbits(infile, bits_to_go);
+*/
+ if (n == 1) {
+ array[0] = input_nybble(infile);
+ return(0);
+ }
+
+ if (bits_to_go == 8) {
+ /*
+ already have 2 full nybbles in buffer2, so
+ backspace the infile array to reuse last char
+ */
+ nextchar--;
+ bits_to_go = 0;
+ }
+
+ /* bits_to_go now has a value in the range 0 - 7. After adding */
+ /* another byte, bits_to_go effectively will be in range 8 - 15 */
+
+ shift1 = bits_to_go + 4; /* shift1 will be in range 4 - 11 */
+ shift2 = bits_to_go; /* shift2 will be in range 0 - 7 */
+ kk = 0;
+
+ /* special case */
+ if (bits_to_go == 0)
+ {
+ for (ii = 0; ii < n/2; ii++) {
+ /*
+ * refill the buffer with next byte
+ */
+ buffer2 = (buffer2<<8) | (int) infile[nextchar];
+ nextchar++;
+ array[kk] = (int) ((buffer2>>4) & 15);
+ array[kk + 1] = (int) ((buffer2) & 15); /* no shift required */
+ kk += 2;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < n/2; ii++) {
+ /*
+ * refill the buffer with next byte
+ */
+ buffer2 = (buffer2<<8) | (int) infile[nextchar];
+ nextchar++;
+ array[kk] = (int) ((buffer2>>shift1) & 15);
+ array[kk + 1] = (int) ((buffer2>>shift2) & 15);
+ kk += 2;
+ }
+ }
+
+
+ if (ii * 2 != n) { /* have to read last odd byte */
+ array[n-1] = input_nybble(infile);
+ }
+
+ return( (buffer2>>bits_to_go) & 15 );
+}
diff --git a/src/plugins/cfitsio/fitscore.c b/src/plugins/cfitsio/fitscore.c
new file mode 100644
index 0000000..cf82614
--- /dev/null
+++ b/src/plugins/cfitsio/fitscore.c
@@ -0,0 +1,9242 @@
+/* This file, fitscore.c, contains the core set of FITSIO routines. */
+
+/* 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. */
+/*
+
+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."
+
+*/
+
+
+#include <string.h>
+#include <limits.h>
+#include <stdlib.h>
+#include <math.h>
+#include <ctype.h>
+#include <errno.h>
+/* stddef.h is apparently needed to define size_t with some compilers ?? */
+#include <stddef.h>
+#include <locale.h>
+#include "fitsio2.h"
+
+#define errmsgsiz 25
+#define ESMARKER 27 /* Escape character is used as error stack marker */
+
+#define DelAll 1 /* delete all messages on the error stack */
+#define DelMark 2 /* delete newest messages back to and including marker */
+#define DelNewest 3 /* delete the newest message from the stack */
+#define GetMesg 4 /* pop and return oldest message, ignoring marks */
+#define PutMesg 5 /* add a new message to the stack */
+#define PutMark 6 /* add a marker to the stack */
+
+#ifdef _REENTRANT
+/*
+ Fitsio_Lock and Fitsio_Pthread_Status are declared in fitsio2.h.
+*/
+pthread_mutex_t Fitsio_Lock;
+int Fitsio_Pthread_Status = 0;
+
+#endif
+
+int STREAM_DRIVER = 0;
+struct lconv *lcxxx;
+
+/*--------------------------------------------------------------------------*/
+float ffvers(float *version) /* IO - version number */
+/*
+ return the current version number of the FITSIO software
+*/
+{
+ *version = (float) 3.30;
+
+/* 11 Apr 2012
+
+ Previous releases:
+ *version = 3.29 22 Sep 2011
+ *version = 3.28 12 May 2011
+ *version = 3.27 3 Mar 2011
+ *version = 3.26 30 Dec 2010
+ *version = 3.25 9 June 2010
+ *version = 3.24 26 Jan 2010
+ *version = 3.23 7 Jan 2010
+ *version = 3.22 28 Oct 2009
+ *version = 3.21 24 Sep 2009
+ *version = 3.20 31 Aug 2009
+ *version = 3.18 12 May 2009 (beta version)
+ *version = 3.14 18 Mar 2009
+ *version = 3.13 5 Jan 2009
+ *version = 3.12 8 Oct 2008
+ *version = 3.11 19 Sep 2008
+ *version = 3.10 20 Aug 2008
+ *version = 3.09 3 Jun 2008
+ *version = 3.08 15 Apr 2007 (internal release)
+ *version = 3.07 5 Nov 2007 (internal release)
+ *version = 3.06 27 Aug 2007
+ *version = 3.05 12 Jul 2007 (internal release)
+ *version = 3.03 11 Dec 2006
+ *version = 3.02 18 Sep 2006
+ *version = 3.01 May 2006 included in FTOOLS 6.1 release
+ *version = 3.006 20 Feb 2006
+ *version = 3.005 20 Dec 2005 (beta, in heasoft swift release
+ *version = 3.004 16 Sep 2005 (beta, in heasoft swift release
+ *version = 3.003 28 Jul 2005 (beta, in heasoft swift release
+ *version = 3.002 15 Apr 2005 (beta)
+ *version = 3.001 15 Mar 2005 (beta) released with heasoft 6.0
+ *version = 3.000 1 Mar 2005 (internal release only)
+ *version = 2.51 2 Dec 2004
+ *version = 2.50 28 Jul 2004
+ *version = 2.49 11 Feb 2004
+ *version = 2.48 28 Jan 2004
+ *version = 2.470 18 Aug 2003
+ *version = 2.460 20 May 2003
+ *version = 2.450 30 Apr 2003 (internal release only)
+ *version = 2.440 8 Jan 2003
+ *version = 2.430; 4 Nov 2002
+ *version = 2.420; 19 Jul 2002
+ *version = 2.410; 22 Apr 2002 used in ftools v5.2
+ *version = 2.401; 28 Jan 2002
+ *version = 2.400; 18 Jan 2002
+ *version = 2.301; 7 Dec 2001
+ *version = 2.300; 23 Oct 2001
+ *version = 2.204; 26 Jul 2001
+ *version = 2.203; 19 Jul 2001 used in ftools v5.1
+ *version = 2.202; 22 May 2001
+ *version = 2.201; 15 Mar 2001
+ *version = 2.200; 26 Jan 2001
+ *version = 2.100; 26 Sep 2000
+ *version = 2.037; 6 Jul 2000
+ *version = 2.036; 1 Feb 2000
+ *version = 2.035; 7 Dec 1999 (internal release only)
+ *version = 2.034; 23 Nov 1999
+ *version = 2.033; 17 Sep 1999
+ *version = 2.032; 25 May 1999
+ *version = 2.031; 31 Mar 1999
+ *version = 2.030; 24 Feb 1999
+ *version = 2.029; 11 Feb 1999
+ *version = 2.028; 26 Jan 1999
+ *version = 2.027; 12 Jan 1999
+ *version = 2.026; 23 Dec 1998
+ *version = 2.025; 1 Dec 1998
+ *version = 2.024; 9 Nov 1998
+ *version = 2.023; 1 Nov 1998 first full release of V2.0
+ *version = 1.42; 30 Apr 1998
+ *version = 1.40; 6 Feb 1998
+ *version = 1.33; 16 Dec 1997 (internal release only)
+ *version = 1.32; 21 Nov 1997 (internal release only)
+ *version = 1.31; 4 Nov 1997 (internal release only)
+ *version = 1.30; 11 Sep 1997
+ *version = 1.27; 3 Sep 1997 (internal release only)
+ *version = 1.25; 2 Jul 1997
+ *version = 1.24; 2 May 1997
+ *version = 1.23; 24 Apr 1997
+ *version = 1.22; 18 Apr 1997
+ *version = 1.21; 26 Mar 1997
+ *version = 1.2; 29 Jan 1997
+ *version = 1.11; 04 Dec 1996
+ *version = 1.101; 13 Nov 1996
+ *version = 1.1; 6 Nov 1996
+ *version = 1.04; 17 Sep 1996
+ *version = 1.03; 20 Aug 1996
+ *version = 1.02; 15 Aug 1996
+ *version = 1.01; 12 Aug 1996
+*/
+
+ return(*version);
+}
+/*--------------------------------------------------------------------------*/
+int ffflnm(fitsfile *fptr, /* I - FITS file pointer */
+ char *filename, /* O - name of the file */
+ int *status) /* IO - error status */
+/*
+ return the name of the FITS file
+*/
+{
+ strcpy(filename,(fptr->Fptr)->filename);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffflmd(fitsfile *fptr, /* I - FITS file pointer */
+ int *filemode, /* O - open mode of the file */
+ int *status) /* IO - error status */
+/*
+ return the access mode of the FITS file
+*/
+{
+ *filemode = (fptr->Fptr)->writemode;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+void ffgerr(int status, /* I - error status value */
+ char *errtext) /* O - error message (max 30 char long + null) */
+/*
+ Return a short descriptive error message that corresponds to the input
+ error status value. The message may be up to 30 characters long, plus
+ the terminating null character.
+*/
+{
+ errtext[0] = '\0';
+
+ if (status >= 0 && status < 300)
+ {
+ switch (status) {
+
+ case 0:
+ strcpy(errtext, "OK - no error");
+ break;
+ case 1:
+ strcpy(errtext, "non-CFITSIO program error");
+ break;
+ case 101:
+ strcpy(errtext, "same input and output files");
+ break;
+ case 103:
+ strcpy(errtext, "attempt to open too many files");
+ break;
+ case 104:
+ strcpy(errtext, "could not open the named file");
+ break;
+ case 105:
+ strcpy(errtext, "couldn't create the named file");
+ break;
+ case 106:
+ strcpy(errtext, "error writing to FITS file");
+ break;
+ case 107:
+ strcpy(errtext, "tried to move past end of file");
+ break;
+ case 108:
+ strcpy(errtext, "error reading from FITS file");
+ break;
+ case 110:
+ strcpy(errtext, "could not close the file");
+ break;
+ case 111:
+ strcpy(errtext, "array dimensions too big");
+ break;
+ case 112:
+ strcpy(errtext, "cannot write to readonly file");
+ break;
+ case 113:
+ strcpy(errtext, "could not allocate memory");
+ break;
+ case 114:
+ strcpy(errtext, "invalid fitsfile pointer");
+ break;
+ case 115:
+ strcpy(errtext, "NULL input pointer");
+ break;
+ case 116:
+ strcpy(errtext, "error seeking file position");
+ break;
+ case 121:
+ strcpy(errtext, "invalid URL prefix");
+ break;
+ case 122:
+ strcpy(errtext, "too many I/O drivers");
+ break;
+ case 123:
+ strcpy(errtext, "I/O driver init failed");
+ break;
+ case 124:
+ strcpy(errtext, "no I/O driver for this URLtype");
+ break;
+ case 125:
+ strcpy(errtext, "parse error in input file URL");
+ break;
+ case 126:
+ strcpy(errtext, "parse error in range list");
+ break;
+ case 151:
+ strcpy(errtext, "bad argument (shared mem drvr)");
+ break;
+ case 152:
+ strcpy(errtext, "null ptr arg (shared mem drvr)");
+ break;
+ case 153:
+ strcpy(errtext, "no free shared memory handles");
+ break;
+ case 154:
+ strcpy(errtext, "share mem drvr not initialized");
+ break;
+ case 155:
+ strcpy(errtext, "IPC system error (shared mem)");
+ break;
+ case 156:
+ strcpy(errtext, "no memory (shared mem drvr)");
+ break;
+ case 157:
+ strcpy(errtext, "share mem resource deadlock");
+ break;
+ case 158:
+ strcpy(errtext, "lock file open/create failed");
+ break;
+ case 159:
+ strcpy(errtext, "can't resize share mem block");
+ break;
+ case 201:
+ strcpy(errtext, "header already has keywords");
+ break;
+ case 202:
+ strcpy(errtext, "keyword not found in header");
+ break;
+ case 203:
+ strcpy(errtext, "keyword number out of bounds");
+ break;
+ case 204:
+ strcpy(errtext, "keyword value is undefined");
+ break;
+ case 205:
+ strcpy(errtext, "string missing closing quote");
+ break;
+ case 206:
+ strcpy(errtext, "error in indexed keyword name");
+ break;
+ case 207:
+ strcpy(errtext, "illegal character in keyword");
+ break;
+ case 208:
+ strcpy(errtext, "required keywords out of order");
+ break;
+ case 209:
+ strcpy(errtext, "keyword value not positive int");
+ break;
+ case 210:
+ strcpy(errtext, "END keyword not found");
+ break;
+ case 211:
+ strcpy(errtext, "illegal BITPIX keyword value");
+ break;
+ case 212:
+ strcpy(errtext, "illegal NAXIS keyword value");
+ break;
+ case 213:
+ strcpy(errtext, "illegal NAXISn keyword value");
+ break;
+ case 214:
+ strcpy(errtext, "illegal PCOUNT keyword value");
+ break;
+ case 215:
+ strcpy(errtext, "illegal GCOUNT keyword value");
+ break;
+ case 216:
+ strcpy(errtext, "illegal TFIELDS keyword value");
+ break;
+ case 217:
+ strcpy(errtext, "negative table row size");
+ break;
+ case 218:
+ strcpy(errtext, "negative number of rows");
+ break;
+ case 219:
+ strcpy(errtext, "named column not found");
+ break;
+ case 220:
+ strcpy(errtext, "illegal SIMPLE keyword value");
+ break;
+ case 221:
+ strcpy(errtext, "first keyword not SIMPLE");
+ break;
+ case 222:
+ strcpy(errtext, "second keyword not BITPIX");
+ break;
+ case 223:
+ strcpy(errtext, "third keyword not NAXIS");
+ break;
+ case 224:
+ strcpy(errtext, "missing NAXISn keywords");
+ break;
+ case 225:
+ strcpy(errtext, "first keyword not XTENSION");
+ break;
+ case 226:
+ strcpy(errtext, "CHDU not an ASCII table");
+ break;
+ case 227:
+ strcpy(errtext, "CHDU not a binary table");
+ break;
+ case 228:
+ strcpy(errtext, "PCOUNT keyword not found");
+ break;
+ case 229:
+ strcpy(errtext, "GCOUNT keyword not found");
+ break;
+ case 230:
+ strcpy(errtext, "TFIELDS keyword not found");
+ break;
+ case 231:
+ strcpy(errtext, "missing TBCOLn keyword");
+ break;
+ case 232:
+ strcpy(errtext, "missing TFORMn keyword");
+ break;
+ case 233:
+ strcpy(errtext, "CHDU not an IMAGE extension");
+ break;
+ case 234:
+ strcpy(errtext, "illegal TBCOLn keyword value");
+ break;
+ case 235:
+ strcpy(errtext, "CHDU not a table extension");
+ break;
+ case 236:
+ strcpy(errtext, "column exceeds width of table");
+ break;
+ case 237:
+ strcpy(errtext, "more than 1 matching col. name");
+ break;
+ case 241:
+ strcpy(errtext, "row width not = field widths");
+ break;
+ case 251:
+ strcpy(errtext, "unknown FITS extension type");
+ break;
+ case 252:
+ strcpy(errtext, "1st key not SIMPLE or XTENSION");
+ break;
+ case 253:
+ strcpy(errtext, "END keyword is not blank");
+ break;
+ case 254:
+ strcpy(errtext, "Header fill area not blank");
+ break;
+ case 255:
+ strcpy(errtext, "Data fill area invalid");
+ break;
+ case 261:
+ strcpy(errtext, "illegal TFORM format code");
+ break;
+ case 262:
+ strcpy(errtext, "unknown TFORM datatype code");
+ break;
+ case 263:
+ strcpy(errtext, "illegal TDIMn keyword value");
+ break;
+ case 264:
+ strcpy(errtext, "invalid BINTABLE heap pointer");
+ break;
+ default:
+ strcpy(errtext, "unknown error status");
+ break;
+ }
+ }
+ else if (status < 600)
+ {
+ switch(status) {
+
+ case 301:
+ strcpy(errtext, "illegal HDU number");
+ break;
+ case 302:
+ strcpy(errtext, "column number < 1 or > tfields");
+ break;
+ case 304:
+ strcpy(errtext, "negative byte address");
+ break;
+ case 306:
+ strcpy(errtext, "negative number of elements");
+ break;
+ case 307:
+ strcpy(errtext, "bad first row number");
+ break;
+ case 308:
+ strcpy(errtext, "bad first element number");
+ break;
+ case 309:
+ strcpy(errtext, "not an ASCII (A) column");
+ break;
+ case 310:
+ strcpy(errtext, "not a logical (L) column");
+ break;
+ case 311:
+ strcpy(errtext, "bad ASCII table datatype");
+ break;
+ case 312:
+ strcpy(errtext, "bad binary table datatype");
+ break;
+ case 314:
+ strcpy(errtext, "null value not defined");
+ break;
+ case 317:
+ strcpy(errtext, "not a variable length column");
+ break;
+ case 320:
+ strcpy(errtext, "illegal number of dimensions");
+ break;
+ case 321:
+ strcpy(errtext, "1st pixel no. > last pixel no.");
+ break;
+ case 322:
+ strcpy(errtext, "BSCALE or TSCALn = 0.");
+ break;
+ case 323:
+ strcpy(errtext, "illegal axis length < 1");
+ break;
+ case 340:
+ strcpy(errtext, "not group table");
+ break;
+ case 341:
+ strcpy(errtext, "HDU already member of group");
+ break;
+ case 342:
+ strcpy(errtext, "group member not found");
+ break;
+ case 343:
+ strcpy(errtext, "group not found");
+ break;
+ case 344:
+ strcpy(errtext, "bad group id");
+ break;
+ case 345:
+ strcpy(errtext, "too many HDUs tracked");
+ break;
+ case 346:
+ strcpy(errtext, "HDU alread tracked");
+ break;
+ case 347:
+ strcpy(errtext, "bad Grouping option");
+ break;
+ case 348:
+ strcpy(errtext, "identical pointers (groups)");
+ break;
+ case 360:
+ strcpy(errtext, "malloc failed in parser");
+ break;
+ case 361:
+ strcpy(errtext, "file read error in parser");
+ break;
+ case 362:
+ strcpy(errtext, "null pointer arg (parser)");
+ break;
+ case 363:
+ strcpy(errtext, "empty line (parser)");
+ break;
+ case 364:
+ strcpy(errtext, "cannot unread > 1 line");
+ break;
+ case 365:
+ strcpy(errtext, "parser too deeply nested");
+ break;
+ case 366:
+ strcpy(errtext, "file open failed (parser)");
+ break;
+ case 367:
+ strcpy(errtext, "hit EOF (parser)");
+ break;
+ case 368:
+ strcpy(errtext, "bad argument (parser)");
+ break;
+ case 369:
+ strcpy(errtext, "unexpected token (parser)");
+ break;
+ case 401:
+ strcpy(errtext, "bad int to string conversion");
+ break;
+ case 402:
+ strcpy(errtext, "bad float to string conversion");
+ break;
+ case 403:
+ strcpy(errtext, "keyword value not integer");
+ break;
+ case 404:
+ strcpy(errtext, "keyword value not logical");
+ break;
+ case 405:
+ strcpy(errtext, "keyword value not floating pt");
+ break;
+ case 406:
+ strcpy(errtext, "keyword value not double");
+ break;
+ case 407:
+ strcpy(errtext, "bad string to int conversion");
+ break;
+ case 408:
+ strcpy(errtext, "bad string to float conversion");
+ break;
+ case 409:
+ strcpy(errtext, "bad string to double convert");
+ break;
+ case 410:
+ strcpy(errtext, "illegal datatype code value");
+ break;
+ case 411:
+ strcpy(errtext, "illegal no. of decimals");
+ break;
+ case 412:
+ strcpy(errtext, "datatype conversion overflow");
+ break;
+ case 413:
+ strcpy(errtext, "error compressing image");
+ break;
+ case 414:
+ strcpy(errtext, "error uncompressing image");
+ break;
+ case 420:
+ strcpy(errtext, "bad date or time conversion");
+ break;
+ case 431:
+ strcpy(errtext, "syntax error in expression");
+ break;
+ case 432:
+ strcpy(errtext, "expression result wrong type");
+ break;
+ case 433:
+ strcpy(errtext, "vector result too large");
+ break;
+ case 434:
+ strcpy(errtext, "missing output column");
+ break;
+ case 435:
+ strcpy(errtext, "bad data in parsed column");
+ break;
+ case 436:
+ strcpy(errtext, "output extension of wrong type");
+ break;
+ case 501:
+ strcpy(errtext, "WCS angle too large");
+ break;
+ case 502:
+ strcpy(errtext, "bad WCS coordinate");
+ break;
+ case 503:
+ strcpy(errtext, "error in WCS calculation");
+ break;
+ case 504:
+ strcpy(errtext, "bad WCS projection type");
+ break;
+ case 505:
+ strcpy(errtext, "WCS keywords not found");
+ break;
+ default:
+ strcpy(errtext, "unknown error status");
+ break;
+ }
+ }
+ else
+ {
+ strcpy(errtext, "unknown error status");
+ }
+ return;
+}
+/*--------------------------------------------------------------------------*/
+void ffpmsg(const char *err_message)
+/*
+ put message on to error stack
+*/
+{
+ ffxmsg(PutMesg, (char *)err_message);
+ return;
+}
+/*--------------------------------------------------------------------------*/
+void ffpmrk(void)
+/*
+ write a marker to the stack. It is then possible to pop only those
+ messages following the marker off of the stack, leaving the previous
+ messages unaffected.
+
+ The marker is ignored by the ffgmsg routine.
+*/
+{
+ char *dummy = 0;
+
+ ffxmsg(PutMark, dummy);
+ return;
+}
+/*--------------------------------------------------------------------------*/
+int ffgmsg(char *err_message)
+/*
+ get oldest message from error stack, ignoring markers
+*/
+{
+ ffxmsg(GetMesg, err_message);
+ return(*err_message);
+}
+/*--------------------------------------------------------------------------*/
+void ffcmsg(void)
+/*
+ erase all messages in the error stack
+*/
+{
+ char *dummy = 0;
+
+ ffxmsg(DelAll, dummy);
+ return;
+}
+/*--------------------------------------------------------------------------*/
+void ffcmrk(void)
+/*
+ erase newest messages in the error stack, stopping if a marker is found.
+ The marker is also erased in this case.
+*/
+{
+ char *dummy = 0;
+
+ ffxmsg(DelMark, dummy);
+ return;
+}
+/*--------------------------------------------------------------------------*/
+void ffxmsg( int action,
+ char *errmsg)
+/*
+ general routine to get, put, or clear the error message stack.
+ Use a static array rather than allocating memory as needed for
+ the error messages because it is likely to be more efficient
+ and simpler to implement.
+
+ Action Code:
+DelAll 1 delete all messages on the error stack
+DelMark 2 delete messages back to and including the 1st marker
+DelNewest 3 delete the newest message from the stack
+GetMesg 4 pop and return oldest message, ignoring marks
+PutMesg 5 add a new message to the stack
+PutMark 6 add a marker to the stack
+
+*/
+{
+ int ii;
+ char markflag;
+ static char *txtbuff[errmsgsiz], *tmpbuff, *msgptr;
+ static char errbuff[errmsgsiz][81]; /* initialize all = \0 */
+ static int nummsg = 0;
+
+ FFLOCK;
+
+ if (action == DelAll) /* clear the whole message stack */
+ {
+ for (ii = 0; ii < nummsg; ii ++)
+ *txtbuff[ii] = '\0';
+
+ nummsg = 0;
+ }
+ else if (action == DelMark) /* clear up to and including first marker */
+ {
+ while (nummsg > 0) {
+ nummsg--;
+ markflag = *txtbuff[nummsg]; /* store possible marker character */
+ *txtbuff[nummsg] = '\0'; /* clear the buffer for this msg */
+
+ if (markflag == ESMARKER)
+ break; /* found a marker, so quit */
+ }
+ }
+ else if (action == DelNewest) /* remove newest message from stack */
+ {
+ if (nummsg > 0)
+ {
+ nummsg--;
+ *txtbuff[nummsg] = '\0'; /* clear the buffer for this msg */
+ }
+ }
+ else if (action == GetMesg) /* pop and return oldest message from stack */
+ { /* ignoring markers */
+ while (nummsg > 0)
+ {
+ strcpy(errmsg, txtbuff[0]); /* copy oldest message to output */
+
+ *txtbuff[0] = '\0'; /* clear the buffer for this msg */
+
+ nummsg--;
+ for (ii = 0; ii < nummsg; ii++)
+ txtbuff[ii] = txtbuff[ii + 1]; /* shift remaining pointers */
+
+ if (errmsg[0] != ESMARKER) { /* quit if this is not a marker */
+ FFUNLOCK;
+ return;
+ }
+ }
+ errmsg[0] = '\0'; /* no messages in the stack */
+ }
+ else if (action == PutMesg) /* add new message to stack */
+ {
+ msgptr = errmsg;
+ while (strlen(msgptr))
+ {
+ if (nummsg == errmsgsiz)
+ {
+ tmpbuff = txtbuff[0]; /* buffers full; reuse oldest buffer */
+ *txtbuff[0] = '\0'; /* clear the buffer for this msg */
+
+ nummsg--;
+ for (ii = 0; ii < nummsg; ii++)
+ txtbuff[ii] = txtbuff[ii + 1]; /* shift remaining pointers */
+
+ txtbuff[nummsg] = tmpbuff; /* set pointer for the new message */
+ }
+ else
+ {
+ for (ii = 0; ii < errmsgsiz; ii++)
+ {
+ if (*errbuff[ii] == '\0') /* find first empty buffer */
+ {
+ txtbuff[nummsg] = errbuff[ii];
+ break;
+ }
+ }
+ }
+
+ strncat(txtbuff[nummsg], msgptr, 80);
+ nummsg++;
+
+ msgptr += minvalue(80, strlen(msgptr));
+ }
+ }
+ else if (action == PutMark) /* put a marker on the stack */
+ {
+ if (nummsg == errmsgsiz)
+ {
+ tmpbuff = txtbuff[0]; /* buffers full; reuse oldest buffer */
+ *txtbuff[0] = '\0'; /* clear the buffer for this msg */
+
+ nummsg--;
+ for (ii = 0; ii < nummsg; ii++)
+ txtbuff[ii] = txtbuff[ii + 1]; /* shift remaining pointers */
+
+ txtbuff[nummsg] = tmpbuff; /* set pointer for the new message */
+ }
+ else
+ {
+ for (ii = 0; ii < errmsgsiz; ii++)
+ {
+ if (*errbuff[ii] == '\0') /* find first empty buffer */
+ {
+ txtbuff[nummsg] = errbuff[ii];
+ break;
+ }
+ }
+ }
+
+ *txtbuff[nummsg] = ESMARKER; /* write the marker */
+ *(txtbuff[nummsg] + 1) = '\0';
+ nummsg++;
+
+ }
+
+ FFUNLOCK;
+ return;
+}
+/*--------------------------------------------------------------------------*/
+int ffpxsz(int datatype)
+/*
+ return the number of bytes per pixel associated with the datatype
+*/
+{
+ if (datatype == TBYTE)
+ return(sizeof(char));
+ else if (datatype == TUSHORT)
+ return(sizeof(short));
+ else if (datatype == TSHORT)
+ return(sizeof(short));
+ else if (datatype == TULONG)
+ return(sizeof(long));
+ else if (datatype == TLONG)
+ return(sizeof(long));
+ else if (datatype == TINT)
+ return(sizeof(int));
+ else if (datatype == TUINT)
+ return(sizeof(int));
+ else if (datatype == TFLOAT)
+ return(sizeof(float));
+ else if (datatype == TDOUBLE)
+ return(sizeof(double));
+ else if (datatype == TLOGICAL)
+ return(sizeof(char));
+ else
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fftkey(const char *keyword, /* I - keyword name */
+ int *status) /* IO - error status */
+/*
+ Test that the keyword name conforms to the FITS standard. Must contain
+ only capital letters, digits, minus or underscore chars. Trailing spaces
+ are allowed. If the input status value is less than zero, then the test
+ is modified so that upper or lower case letters are allowed, and no
+ error messages are printed if the keyword is not legal.
+*/
+{
+ size_t maxchr, ii;
+ int spaces=0;
+ char msg[81], testchar;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ maxchr=strlen(keyword);
+ if (maxchr > 8)
+ maxchr = 8;
+
+ for (ii = 0; ii < maxchr; ii++)
+ {
+ if (*status == 0)
+ testchar = keyword[ii];
+ else
+ testchar = toupper(keyword[ii]);
+
+ if ( (testchar >= 'A' && testchar <= 'Z') ||
+ (testchar >= '0' && testchar <= '9') ||
+ testchar == '-' || testchar == '_' )
+ {
+ if (spaces)
+ {
+ if (*status == 0)
+ {
+ /* don't print error message if status < 0 */
+ sprintf(msg,
+ "Keyword name contains embedded space(s): %.8s",
+ keyword);
+ ffpmsg(msg);
+ }
+ return(*status = BAD_KEYCHAR);
+ }
+ }
+ else if (keyword[ii] == ' ')
+ spaces = 1;
+
+ else
+ {
+ if (*status == 0)
+ {
+ /* don't print error message if status < 0 */
+ sprintf(msg, "Character %d in this keyword is illegal: %.8s",
+ (int) (ii+1), keyword);
+ ffpmsg(msg);
+
+ /* explicitly flag the 2 most common cases */
+ if (keyword[ii] == 0)
+ ffpmsg(" (This a NULL (0) character).");
+ else if (keyword[ii] == 9)
+ ffpmsg(" (This an ASCII TAB (9) character).");
+ }
+
+ return(*status = BAD_KEYCHAR);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fftrec(char *card, /* I - keyword card to test */
+ int *status) /* IO - error status */
+/*
+ Test that the keyword card conforms to the FITS standard. Must contain
+ only printable ASCII characters;
+*/
+{
+ size_t ii, maxchr;
+ char msg[81];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ maxchr = strlen(card);
+
+ for (ii = 8; ii < maxchr; ii++)
+ {
+ if (card[ii] < 32 || card[ii] > 126)
+ {
+ sprintf(msg,
+ "Character %d in this keyword is illegal. Hex Value = %X",
+ (int) (ii+1), (int) card[ii] );
+
+ if (card[ii] == 0)
+ strcat(msg, " (NULL char.)");
+ else if (card[ii] == 9)
+ strcat(msg, " (TAB char.)");
+ else if (card[ii] == 10)
+ strcat(msg, " (Line Feed char.)");
+ else if (card[ii] == 11)
+ strcat(msg, " (Vertical Tab)");
+ else if (card[ii] == 12)
+ strcat(msg, " (Form Feed char.)");
+ else if (card[ii] == 13)
+ strcat(msg, " (Carriage Return)");
+ else if (card[ii] == 27)
+ strcat(msg, " (Escape char.)");
+ else if (card[ii] == 127)
+ strcat(msg, " (Delete char.)");
+
+ ffpmsg(msg);
+
+ strncpy(msg, card, 80);
+ msg[80] = '\0';
+ ffpmsg(msg);
+ return(*status = BAD_KEYCHAR);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+void ffupch(char *string)
+/*
+ convert string to upper case, in place.
+*/
+{
+ size_t len, ii;
+
+ len = strlen(string);
+ for (ii = 0; ii < len; ii++)
+ string[ii] = toupper(string[ii]);
+ return;
+}
+/*--------------------------------------------------------------------------*/
+int ffmkky(const char *keyname, /* I - keyword name */
+ char *value, /* I - keyword value */
+ const char *comm, /* I - keyword comment */
+ char *card, /* O - constructed keyword card */
+ int *status) /* IO - status value */
+/*
+ Make a complete FITS 80-byte keyword card from the input name, value and
+ comment strings. Output card is null terminated without any trailing blanks.
+*/
+{
+ size_t namelen, len, ii;
+ char tmpname[FLEN_KEYWORD], *cptr;
+ int tstatus = -1, nblank = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ *tmpname = '\0';
+ *card = '\0';
+
+ while(*(keyname + nblank) == ' ') /* skip leading blanks in the name */
+ nblank++;
+
+ strncat(tmpname, keyname + nblank, FLEN_KEYWORD - 1);
+
+ len = strlen(value);
+ namelen = strlen(tmpname);
+
+ if (namelen)
+ {
+ cptr = tmpname + namelen - 1;
+
+ while(*cptr == ' ') /* skip trailing blanks */
+ {
+ *cptr = '\0';
+ cptr--;
+ }
+
+ namelen = cptr - tmpname + 1;
+ }
+
+ if (namelen <= 8 && (fftkey(keyname, &tstatus) <= 0) )
+ {
+ /* a normal FITS keyword */
+ strcat(card, tmpname); /* copy keyword name to buffer */
+
+ for (ii = namelen; ii < 8; ii++)
+ card[ii] = ' '; /* pad keyword name with spaces */
+
+ card[8] = '='; /* append '= ' in columns 9-10 */
+ card[9] = ' ';
+ card[10] = '\0'; /* terminate the partial string */
+ namelen = 10;
+ }
+ else
+ {
+ /* use the ESO HIERARCH convention for longer keyword names */
+
+ /* check that the name does not contain an '=' (equals sign) */
+ if (strchr(tmpname, '=') )
+ {
+ ffpmsg("Illegal keyword name; contains an equals sign (=)");
+ ffpmsg(tmpname);
+ return(*status = BAD_KEYCHAR);
+ }
+
+ /* Don't repeat HIERARCH if the keyword already contains it */
+ if (FSTRNCMP(tmpname, "HIERARCH ", 9) &&
+ FSTRNCMP(tmpname, "hierarch ", 9))
+ strcat(card, "HIERARCH ");
+ else
+ namelen -= 9; /* deleted the string 'HIERARCH ' */
+
+ strcat(card, tmpname);
+
+ if (namelen + 12 + len > 80) {
+ /* save 1 char by not putting a space before the equals sign */
+ strcat(card, "= ");
+ namelen += 11;
+ } else {
+ strcat(card, " = ");
+ namelen += 12;
+ }
+ }
+
+ if (len > 0)
+ {
+ if (value[0] == '\'') /* is this a quoted string value? */
+ {
+ if (namelen > 77)
+ {
+ ffpmsg(
+ "The following keyword + value is too long to fit on a card:");
+ ffpmsg(keyname);
+ ffpmsg(value);
+ return(*status = BAD_KEYCHAR);
+ }
+
+ strncat(card, value, 80 - namelen); /* append the value string */
+ len = minvalue(80, namelen + len);
+
+ /* restore the closing quote if it got truncated */
+ if (len == 80)
+ {
+ card[79] = '\'';
+ }
+
+ if (comm)
+ {
+ if (comm[0] != 0)
+ {
+ if (len < 30)
+ {
+ for (ii = len; ii < 30; ii++)
+ card[ii] = ' '; /* fill with spaces to col 30 */
+
+ card[30] = '\0';
+ len = 30;
+ }
+ }
+ }
+ }
+ else
+ {
+ if (namelen + len > 80)
+ {
+ ffpmsg(
+ "The following keyword + value is too long to fit on a card:");
+ ffpmsg(keyname);
+ ffpmsg(value);
+ return(*status = BAD_KEYCHAR);
+ }
+ else if (namelen + len < 30)
+ {
+ /* add spaces so field ends at least in col 30 */
+ strncat(card, " ", 30 - (namelen + len));
+ }
+
+ strncat(card, value, 80 - namelen); /* append the value string */
+ len = minvalue(80, namelen + len);
+ len = maxvalue(30, len);
+ }
+
+ if (comm)
+ {
+ if ((len < 77) && ( strlen(comm) > 0) ) /* room for a comment? */
+ {
+ strcat(card, " / "); /* append comment separator */
+ strncat(card, comm, 77 - len); /* append comment (what fits) */
+ }
+ }
+ }
+ else
+ {
+ if (namelen == 10) /* This case applies to normal keywords only */
+ {
+ card[8] = ' '; /* keywords with no value have no '=' */
+ if (comm)
+ {
+ strncat(card, comm, 80 - namelen); /* append comment (what fits) */
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkey(fitsfile *fptr, /* I - FITS file pointer */
+ char *card, /* I - card string value */
+ int *status) /* IO - error status */
+/*
+ replace the previously read card (i.e. starting 80 bytes before the
+ (fptr->Fptr)->nextkey position) with the contents of the input card.
+*/
+{
+ char tcard[81];
+ size_t len, ii;
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ strncpy(tcard,card,80);
+ tcard[80] = '\0';
+
+ len = strlen(tcard);
+
+ /* silently replace any illegal characters with a space */
+ for (ii=0; ii < len; ii++)
+ if (tcard[ii] < ' ' || tcard[ii] > 126) tcard[ii] = ' ';
+
+ for (ii=len; ii < 80; ii++) /* fill card with spaces if necessary */
+ tcard[ii] = ' ';
+
+ for (ii=0; ii < 8; ii++) /* make sure keyword name is uppercase */
+ tcard[ii] = toupper(tcard[ii]);
+
+ fftkey(tcard, status); /* test keyword name contains legal chars */
+
+/* no need to do this any more, since any illegal characters have been removed
+ fftrec(tcard, status); */ /* test rest of keyword for legal chars */
+
+ /* move position of keyword to be over written */
+ ffmbyt(fptr, ((fptr->Fptr)->nextkey) - 80, REPORT_EOF, status);
+ ffpbyt(fptr, 80, tcard, status); /* write the 80 byte card */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffkeyn(const char *keyroot, /* I - root string for keyword name */
+ int value, /* I - index number to be appended to root name */
+ char *keyname, /* O - output root + index keyword name */
+ int *status) /* IO - error status */
+/*
+ Construct a keyword name string by appending the index number to the root.
+ e.g., if root = "TTYPE" and value = 12 then keyname = "TTYPE12".
+*/
+{
+ char suffix[16];
+ size_t rootlen;
+
+ keyname[0] = '\0'; /* initialize output name to null */
+ rootlen = strlen(keyroot);
+
+ if (rootlen == 0 || rootlen > 7 || value < 0 )
+ return(*status = 206);
+
+ sprintf(suffix, "%d", value); /* construct keyword suffix */
+
+ if ( strlen(suffix) + rootlen > 8)
+ return(*status = 206);
+
+ strcpy(keyname, keyroot); /* copy root string to name string */
+ strcat(keyname, suffix); /* append suffix to the root */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffnkey(int value, /* I - index number to be appended to root name */
+ char *keyroot, /* I - root string for keyword name */
+ char *keyname, /* O - output root + index keyword name */
+ int *status) /* IO - error status */
+/*
+ Construct a keyword name string by appending the root string to the index
+ number. e.g., if root = "TTYPE" and value = 12 then keyname = "12TTYPE".
+*/
+{
+ size_t rootlen;
+
+ keyname[0] = '\0'; /* initialize output name to null */
+ rootlen = strlen(keyroot);
+
+ if (rootlen == 0 || rootlen > 7 || value < 0 )
+ return(*status = 206);
+
+ sprintf(keyname, "%d", value); /* construct keyword prefix */
+
+ if (rootlen + strlen(keyname) > 8)
+ return(*status = 206);
+
+ strcat(keyname, keyroot); /* append root to the prefix */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpsvc(char *card, /* I - FITS header card (nominally 80 bytes long) */
+ char *value, /* O - value string parsed from the card */
+ char *comm, /* O - comment string parsed from the card */
+ int *status) /* IO - error status */
+/*
+ ParSe the Value and Comment strings from the input header card string.
+ If the card contains a quoted string value, the returned value string
+ includes the enclosing quote characters. If comm = NULL, don't return
+ the comment string.
+*/
+{
+ int jj;
+ size_t ii, cardlen, nblank, valpos;
+
+ if (*status > 0)
+ return(*status);
+
+ value[0] = '\0';
+ if (comm)
+ comm[0] = '\0';
+
+ cardlen = strlen(card);
+
+ /* support for ESO HIERARCH keywords; find the '=' */
+ if (FSTRNCMP(card, "HIERARCH ", 9) == 0)
+ {
+ valpos = strcspn(card, "=");
+
+ if (valpos == cardlen) /* no value indicator ??? */
+ {
+ if (comm != NULL)
+ {
+ if (cardlen > 8)
+ {
+ strcpy(comm, &card[8]);
+
+ jj=cardlen - 8;
+ for (jj--; jj >= 0; jj--) /* replace trailing blanks with nulls */
+ {
+ if (comm[jj] == ' ')
+ comm[jj] = '\0';
+ else
+ break;
+ }
+ }
+ }
+ return(*status); /* no value indicator */
+ }
+ valpos++; /* point to the position after the '=' */
+ }
+ else if (cardlen < 9 ||
+ FSTRNCMP(card, "COMMENT ", 8) == 0 || /* keywords with no value */
+ FSTRNCMP(card, "HISTORY ", 8) == 0 ||
+ FSTRNCMP(card, "END ", 8) == 0 ||
+ FSTRNCMP(card, " ", 8) == 0 ||
+ FSTRNCMP(&card[8], "= ", 2) != 0 ) /* no '= ' in cols 9-10 */
+ {
+ /* no value, so the comment extends from cols 9 - 80 */
+ if (comm != NULL)
+ {
+ if (cardlen > 8)
+ {
+ strcpy(comm, &card[8]);
+
+ jj=cardlen - 8;
+ for (jj--; jj >= 0; jj--) /* replace trailing blanks with nulls */
+ {
+ if (comm[jj] == ' ')
+ comm[jj] = '\0';
+ else
+ break;
+ }
+ }
+ }
+ return(*status);
+ }
+ else
+ {
+ valpos = 10; /* starting position of the value field */
+ }
+
+ nblank = strspn(&card[valpos], " "); /* find number of leading blanks */
+
+ if (nblank + valpos == cardlen)
+ {
+ /* the absence of a value string is legal, and simply indicates
+ that the keyword value is undefined. Don't write an error
+ message in this case.
+ */
+ return(*status);
+ }
+
+ ii = valpos + nblank;
+
+ if (card[ii] == '/' ) /* slash indicates start of the comment */
+ {
+ ii++;
+ }
+ else if (card[ii] == '\'' ) /* is this a quoted string value? */
+ {
+ value[0] = card[ii];
+ for (jj=1, ii++; ii < cardlen; ii++, jj++)
+ {
+ if (card[ii] == '\'') /* is this the closing quote? */
+ {
+ if (card[ii+1] == '\'') /* 2 successive quotes? */
+ {
+ value[jj] = card[ii];
+ ii++;
+ jj++;
+ }
+ else
+ {
+ value[jj] = card[ii];
+ break; /* found the closing quote, so exit this loop */
+ }
+ }
+ value[jj] = card[ii]; /* copy the next character to the output */
+ }
+
+ if (ii == cardlen)
+ {
+ jj = minvalue(jj, 69); /* don't exceed 70 char string length */
+ value[jj] = '\''; /* close the bad value string */
+ value[jj+1] = '\0'; /* terminate the bad value string */
+ ffpmsg("This keyword string value has no closing quote:");
+ ffpmsg(card);
+ /* May 2008 - modified to not fail on this minor error */
+/* return(*status = NO_QUOTE); */
+ }
+ else
+ {
+ value[jj+1] = '\0'; /* terminate the good value string */
+ ii++; /* point to the character following the value */
+ }
+ }
+ else if (card[ii] == '(' ) /* is this a complex value? */
+ {
+ nblank = strcspn(&card[ii], ")" ); /* find closing ) */
+ if (nblank == strlen( &card[ii] ) )
+ {
+ ffpmsg("This complex keyword value has no closing ')':");
+ ffpmsg(card);
+ return(*status = NO_QUOTE);
+ }
+
+ nblank++;
+ strncpy(value, &card[ii], nblank);
+ value[nblank] = '\0';
+ ii = ii + nblank;
+ }
+ else /* an integer, floating point, or logical FITS value string */
+ {
+ nblank = strcspn(&card[ii], " /"); /* find the end of the token */
+ strncpy(value, &card[ii], nblank);
+ value[nblank] = '\0';
+ ii = ii + nblank;
+ }
+
+ /* now find the comment string, if any */
+ if (comm)
+ {
+ nblank = strspn(&card[ii], " "); /* find next non-space character */
+ ii = ii + nblank;
+
+ if (ii < 80)
+ {
+ if (card[ii] == '/') /* ignore the slash separator */
+ {
+ ii++;
+ if (card[ii] == ' ') /* also ignore the following space */
+ ii++;
+ }
+ strcat(comm, &card[ii]); /* copy the remaining characters */
+
+ jj=strlen(comm);
+ for (jj--; jj >= 0; jj--) /* replace trailing blanks with nulls */
+ {
+ if (comm[jj] == ' ')
+ comm[jj] = '\0';
+ else
+ break;
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgthd(char *tmplt, /* I - input header template string */
+ char *card, /* O - returned FITS header record */
+ int *hdtype, /* O - how to interpreter the returned card string */
+ /*
+ -2 = modify the name of a keyword; the old keyword name
+ is returned starting at address chars[0]; the new name
+ is returned starting at address char[40] (to be consistent
+ with the Fortran version). Both names are null terminated.
+ -1 = card contains the name of a keyword that is to be deleted
+ 0 = append this keyword if it doesn't already exist, or
+ modify the value if the keyword already exists.
+ 1 = append this comment keyword ('HISTORY',
+ 'COMMENT', or blank keyword name)
+ 2 = this is the END keyword; do not write it to the header
+ */
+ int *status) /* IO - error status */
+/*
+ 'Get Template HeaDer'
+ parse a template header line and create a formated
+ character string which is suitable for appending to a FITS header
+*/
+{
+ char keyname[FLEN_KEYWORD], value[140], comment[140];
+ char *tok, *suffix, *loc, tvalue[140];
+ int len, vlen, more, tstatus;
+ double dval;
+
+ if (*status > 0)
+ return(*status);
+
+ card[0] = '\0';
+ *hdtype = 0;
+
+ if (!FSTRNCMP(tmplt, " ", 8) )
+ {
+ /* if first 8 chars of template are blank, then this is a comment */
+ strncat(card, tmplt, 80);
+ *hdtype = 1;
+ return(*status);
+ }
+
+ tok = tmplt; /* point to start of template string */
+
+ keyname[0] = '\0';
+ value[0] = '\0';
+ comment[0] = '\0';
+
+ len = strspn(tok, " "); /* no. of spaces before keyword */
+ tok += len;
+
+ /* test for pecular case where token is a string of dashes */
+ if (strncmp(tok, "--------------------", 20) == 0)
+ return(*status = BAD_KEYCHAR);
+
+ if (tok[0] == '-') /* is there a leading minus sign? */
+ {
+ /* first token is name of keyword to be deleted or renamed */
+ *hdtype = -1;
+ tok++;
+ len = strspn(tok, " "); /* no. of spaces before keyword */
+ tok += len;
+ if (len < 8) /* not a blank name? */
+ {
+ len = strcspn(tok, " ="); /* length of name */
+ if (len >= FLEN_KEYWORD)
+ return(*status = BAD_KEYCHAR);
+
+ strncat(card, tok, len);
+
+ /*
+ The HIERARCH convention supports non-standard characters
+ in the keyword name, so don't always convert to upper case or
+ abort if there are illegal characters in the name or if the
+ name is greater than 8 characters long.
+ */
+
+ if (len < 9) /* this is possibly a normal FITS keyword name */
+ {
+ ffupch(card);
+ tstatus = 0;
+ if (fftkey(card, &tstatus) > 0)
+ {
+ /* name contained non-standard characters, so reset */
+ card[0] = '\0';
+ strncat(card, tok, len);
+ }
+ }
+
+ tok += len;
+ }
+
+ /* second token, if present, is the new name for the keyword */
+
+ len = strspn(tok, " "); /* no. of spaces before next token */
+ tok += len;
+
+ if (tok[0] == '\0' || tok[0] == '=')
+ return(*status); /* no second token */
+
+ *hdtype = -2;
+ len = strcspn(tok, " "); /* length of new name */
+ if (len > 40) /* name has to fit on columns 41-80 of card */
+ return(*status = BAD_KEYCHAR);
+
+ /* copy the new name to card + 40; This is awkward, */
+ /* but is consistent with the way the Fortran FITSIO works */
+ strcat(card," ");
+ strncpy(&card[40], tok, len+1); /* copy len+1 to get terminator */
+
+ /*
+ The HIERARCH convention supports non-standard characters
+ in the keyword name, so don't always convert to upper case or
+ abort if there are illegal characters in the name or if the
+ name is greater than 8 characters long.
+ */
+
+ if (len < 9) /* this is possibly a normal FITS keyword name */
+ {
+ ffupch(&card[40]);
+ tstatus = 0;
+ if (fftkey(&card[40], &tstatus) > 0)
+ {
+ /* name contained non-standard characters, so reset */
+ strncpy(&card[40], tok, len);
+ }
+ }
+ }
+ else /* no negative sign at beginning of template */
+ {
+ /* get the keyword name token */
+
+ len = strcspn(tok, " ="); /* length of keyword name */
+ if (len >= FLEN_KEYWORD)
+ return(*status = BAD_KEYCHAR);
+
+ strncat(keyname, tok, len);
+
+ /*
+ The HIERARCH convention supports non-standard characters
+ in the keyword name, so don't always convert to upper case or
+ abort if there are illegal characters in the name or if the
+ name is greater than 8 characters long.
+ */
+
+ if (len < 9) /* this is possibly a normal FITS keyword name */
+ {
+ ffupch(keyname);
+ tstatus = 0;
+ if (fftkey(keyname, &tstatus) > 0)
+ {
+ /* name contained non-standard characters, so reset */
+ keyname[0] = '\0';
+ strncat(keyname, tok, len);
+ }
+ }
+
+ if (!FSTRCMP(keyname, "END") )
+ {
+ strcpy(card, "END");
+ *hdtype = 2;
+ return(*status);
+ }
+
+ tok += len; /* move token pointer to end of the keyword */
+
+ if (!FSTRCMP(keyname, "COMMENT") || !FSTRCMP(keyname, "HISTORY")
+ || !FSTRCMP(keyname, "HIERARCH") )
+ {
+ *hdtype = 1; /* simply append COMMENT and HISTORY keywords */
+ strcpy(card, keyname);
+ strncat(card, tok, 73);
+ return(*status);
+ }
+
+ /* look for the value token */
+ len = strspn(tok, " ="); /* spaces or = between name and value */
+ tok += len;
+
+ if (*tok == '\'') /* is value enclosed in quotes? */
+ {
+ more = TRUE;
+ while (more)
+ {
+ tok++; /* temporarily move past the quote char */
+ len = strcspn(tok, "'"); /* length of quoted string */
+ tok--;
+ strncat(value, tok, len + 2);
+
+ tok += len + 1;
+ if (tok[0] != '\'') /* check there is a closing quote */
+ return(*status = NO_QUOTE);
+
+ tok++;
+ if (tok[0] != '\'') /* 2 quote chars = literal quote */
+ more = FALSE;
+ }
+ }
+ else if (*tok == '/' || *tok == '\0') /* There is no value */
+ {
+ strcat(value, " ");
+ }
+ else /* not a quoted string value */
+ {
+ len = strcspn(tok, " /"); /* length of value string */
+
+ strncat(value, tok, len);
+ if (!( (tok[0] == 'T' || tok[0] == 'F') &&
+ (tok[1] == ' ' || tok[1] == '/' || tok[1] == '\0') ))
+ {
+ /* not a logical value */
+
+ dval = strtod(value, &suffix); /* try to read value as number */
+
+ if (*suffix != '\0' && *suffix != ' ' && *suffix != '/')
+ {
+ /* value not recognized as a number; might be because it */
+ /* contains a 'd' or 'D' exponent character */
+ strcpy(tvalue, value);
+ if ((loc = strchr(tvalue, 'D')))
+ {
+ *loc = 'E'; /* replace D's with E's. */
+ dval = strtod(tvalue, &suffix); /* read value again */
+ }
+ else if ((loc = strchr(tvalue, 'd')))
+ {
+ *loc = 'E'; /* replace d's with E's. */
+ dval = strtod(tvalue, &suffix); /* read value again */
+ }
+ else if ((loc = strchr(tvalue, '.')))
+ {
+ *loc = ','; /* replace period with a comma */
+ dval = strtod(tvalue, &suffix); /* read value again */
+ }
+ }
+
+ if (*suffix != '\0' && *suffix != ' ' && *suffix != '/')
+ {
+ /* value is not a number; must enclose it in quotes */
+ strcpy(value, "'");
+ strncat(value, tok, len);
+ strcat(value, "'");
+
+ /* the following useless statement stops the compiler warning */
+ /* that dval is not used anywhere */
+ if (dval == 0.)
+ len += (int) dval;
+ }
+ else
+ {
+ /* value is a number; convert any 'e' to 'E', or 'd' to 'D' */
+ loc = strchr(value, 'e');
+ if (loc)
+ {
+ *loc = 'E';
+ }
+ else
+ {
+ loc = strchr(value, 'd');
+ if (loc)
+ {
+ *loc = 'D';
+ }
+ }
+ }
+ }
+ tok += len;
+ }
+
+ len = strspn(tok, " /"); /* no. of spaces between value and comment */
+ tok += len;
+
+ vlen = strlen(value);
+ if (vlen > 0 && vlen < 10 && value[0] == '\'')
+ {
+ /* pad quoted string with blanks so it is at least 8 chars long */
+ value[vlen-1] = '\0';
+ strncat(value, " ", 10 - vlen);
+ strcat(&value[9], "'");
+ }
+
+ /* get the comment string */
+ strncat(comment, tok, 70);
+
+ /* construct the complete FITS header card */
+ ffmkky(keyname, value, comment, card, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_translate_keyword(
+ char *inrec, /* I - input string */
+ char *outrec, /* O - output converted string, or */
+ /* a null string if input does not */
+ /* match any of the patterns */
+ char *patterns[][2],/* I - pointer to input / output string */
+ /* templates */
+ int npat, /* I - number of templates passed */
+ int n_value, /* I - base 'n' template value of interest */
+ int n_offset, /* I - offset to be applied to the 'n' */
+ /* value in the output string */
+ int n_range, /* I - controls range of 'n' template */
+ /* values of interest (-1,0, or +1) */
+ int *pat_num, /* O - matched pattern number (0 based) or -1 */
+ int *i, /* O - value of i, if any, else 0 */
+ int *j, /* O - value of j, if any, else 0 */
+ int *m, /* O - value of m, if any, else 0 */
+ int *n, /* O - value of n, if any, else 0 */
+
+ int *status) /* IO - error status */
+
+/*
+
+Translate a keyword name to a new name, based on a set of patterns.
+The user passes an array of patterns to be matched. Input pattern
+number i is pattern[i][0], and output pattern number i is
+pattern[i][1]. Keywords are matched against the input patterns. If a
+match is found then the keyword is re-written according to the output
+pattern.
+
+Order is important. The first match is accepted. The fastest match
+will be made when templates with the same first character are grouped
+together.
+
+Several characters have special meanings:
+
+ i,j - single digits, preserved in output template
+ n - column number of one or more digits, preserved in output template
+ m - generic number of one or more digits, preserved in output template
+ a - coordinate designator, preserved in output template
+ # - number of one or more digits
+ ? - any character
+ * - only allowed in first character position, to match all
+ keywords; only useful as last pattern in the list
+
+i, j, n, and m are returned by the routine.
+
+For example, the input pattern "iCTYPn" will match "1CTYP5" (if n_value
+is 5); the output pattern "CTYPEi" will be re-written as "CTYPE1".
+Notice that "i" is preserved.
+
+The following output patterns are special
+
+Special output pattern characters:
+
+ "-" - do not copy a keyword that matches the corresponding input pattern
+
+ "+" - copy the input unchanged
+
+The inrec string could be just the 8-char keyword name, or the entire
+80-char header record. Characters 9 = 80 in the input string simply get
+appended to the translated keyword name.
+
+If n_range = 0, then only keywords with 'n' equal to n_value will be
+considered as a pattern match. If n_range = +1, then all values of
+'n' greater than or equal to n_value will be a match, and if -1,
+then values of 'n' less than or equal to n_value will match.
+
+ This routine was written by Craig Markwardt, GSFC
+*/
+
+{
+ int i1 = 0, j1 = 0, n1 = 0, m1 = 0;
+ int fac;
+ char a = ' ';
+ char oldp;
+ char c, s;
+ int ip, ic, pat, pass = 0, firstfail;
+ char *spat;
+
+ if (*status > 0)
+ return(*status);
+ if ((inrec == 0) || (outrec == 0))
+ return (*status = NULL_INPUT_PTR);
+
+ *outrec = '\0';
+/*
+ if (*inrec == '\0') return 0;
+*/
+
+ if (*inrec == '\0') /* expand to full 8 char blank keyword name */
+ strcpy(inrec, " ");
+
+ oldp = '\0';
+ firstfail = 0;
+
+ /* ===== Pattern match stage */
+ for (pat=0; pat < npat; pat++) {
+ spat = patterns[pat][0];
+
+ i1 = 0; j1 = 0; m1 = -1; n1 = -1; a = ' '; /* Initialize the place-holders */
+ pass = 0;
+
+ /* Pass the wildcard pattern */
+ if (spat[0] == '*') {
+ pass = 1;
+ break;
+ }
+
+ /* Optimization: if we have seen this initial pattern character before,
+ then it must have failed, and we can skip the pattern */
+ if (firstfail && spat[0] == oldp) continue;
+ oldp = spat[0];
+
+ /*
+ ip = index of pattern character being matched
+ ic = index of keyname character being matched
+ firstfail = 1 if we fail on the first characteor (0=not)
+ */
+
+ for (ip=0, ic=0, firstfail=1;
+ (spat[ip]) && (ic < 8);
+ ip++, ic++, firstfail=0) {
+ c = inrec[ic];
+ s = spat[ip];
+
+ if (s == 'i') {
+ /* Special pattern: 'i' placeholder */
+ if (isdigit(c)) { i1 = c - '0'; pass = 1;}
+ } else if (s == 'j') {
+ /* Special pattern: 'j' placeholder */
+ if (isdigit(c)) { j1 = c - '0'; pass = 1;}
+ } else if ((s == 'n')||(s == 'm')||(s == '#')) {
+ /* Special patterns: multi-digit number */
+ int val = 0;
+ pass = 0;
+ if (isdigit(c)) {
+ pass = 1; /* NOTE, could fail below */
+
+ /* Parse decimal number */
+ while (ic<8 && isdigit(c)) {
+ val = val*10 + (c - '0');
+ ic++; c = inrec[ic];
+ }
+ ic--; c = inrec[ic];
+
+ if (s == 'n') {
+
+ /* Is it a column number? */
+ if ( val >= 1 && val <= 999 && /* Row range check */
+ (((n_range == 0) && (val == n_value)) || /* Strict equality */
+ ((n_range == -1) && (val <= n_value)) || /* n <= n_value */
+ ((n_range == +1) && (val >= n_value))) ) { /* n >= n_value */
+ n1 = val;
+ } else {
+ pass = 0;
+ }
+ } else if (s == 'm') {
+
+ /* Generic number */
+ m1 = val;
+ }
+ }
+ } else if (s == 'a') {
+ /* Special pattern: coordinate designator */
+ if (isupper(c) || c == ' ') { a = c; pass = 1;}
+ } else if (s == '?') {
+ /* Match any individual character */
+ pass = 1;
+ } else if (c == s) {
+ /* Match a specific character */
+ pass = 1;
+ } else {
+ /* FAIL */
+ pass = 0;
+ }
+ if (!pass) break;
+ }
+
+ /* Must pass to the end of the keyword. No partial matches allowed */
+ if (pass && (ic >= 8 || inrec[ic] == ' ')) break;
+ }
+
+ /* Transfer the pattern-matched numbers to the output parameters */
+ if (i) { *i = i1; }
+ if (j) { *j = j1; }
+ if (n) { *n = n1; }
+ if (m) { *m = m1; }
+ if (pat_num) { *pat_num = pat; }
+
+ /* ===== Keyword rewriting and output stage */
+ spat = patterns[pat][1];
+
+ /* Return case: no match, or explicit deletion pattern */
+ if (pass == 0 || spat[0] == '\0' || spat[0] == '-') return 0;
+
+ /* A match: we start by copying the input record to the output */
+ strcpy(outrec, inrec);
+
+ /* Return case: return the input record unchanged */
+ if (spat[0] == '+') return 0;
+
+
+ /* Final case: a new output pattern */
+ for (ip=0, ic=0; spat[ip]; ip++, ic++) {
+ s = spat[ip];
+ if (s == 'i') {
+ outrec[ic] = (i1+'0');
+ } else if (s == 'j') {
+ outrec[ic] = (j1+'0');
+ } else if (s == 'n') {
+ if (n1 == -1) { n1 = n_value; }
+ if (n1 > 0) {
+ n1 += n_offset;
+ for (fac = 1; (n1/fac) > 0; fac *= 10);
+ fac /= 10;
+ while(fac > 0) {
+ outrec[ic] = ((n1/fac) % 10) + '0';
+ fac /= 10;
+ ic ++;
+ }
+ ic--;
+ }
+ } else if (s == 'm' && m1 >= 0) {
+ for (fac = 1; (m1/fac) > 0; fac *= 10);
+ fac /= 10;
+ while(fac > 0) {
+ outrec[ic] = ((m1/fac) % 10) + '0';
+ fac /= 10;
+ ic ++;
+ }
+ ic --;
+ } else if (s == 'a') {
+ outrec[ic] = a;
+ } else {
+ outrec[ic] = s;
+ }
+ }
+
+ /* Pad the keyword name with spaces */
+ for ( ; ic<8; ic++) { outrec[ic] = ' '; }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_translate_keywords(
+ fitsfile *infptr, /* I - pointer to input HDU */
+ fitsfile *outfptr, /* I - pointer to output HDU */
+ int firstkey, /* I - first HDU record number to start with */
+ char *patterns[][2],/* I - pointer to input / output keyword templates */
+ int npat, /* I - number of templates passed */
+ int n_value, /* I - base 'n' template value of interest */
+ int n_offset, /* I - offset to be applied to the 'n' */
+ /* value in the output string */
+ int n_range, /* I - controls range of 'n' template */
+ /* values of interest (-1,0, or +1) */
+ int *status) /* IO - error status */
+/*
+ Copy relevant keywords from the table header into the newly
+ created primary array header. Convert names of keywords where
+ appropriate. See fits_translate_keyword() for the definitions.
+
+ Translation begins at header record number 'firstkey', and
+ continues to the end of the header.
+
+ This routine was written by Craig Markwardt, GSFC
+*/
+{
+ int nrec, nkeys, nmore;
+ char rec[FLEN_CARD];
+ int i = 0, j = 0, n = 0, m = 0;
+ int pat_num = 0, maxchr, ii;
+ char outrec[FLEN_CARD];
+
+ if (*status > 0)
+ return(*status);
+
+ ffghsp(infptr, &nkeys, &nmore, status); /* get number of keywords */
+
+ for (nrec = firstkey; nrec <= nkeys; nrec++) {
+ outrec[0] = '\0';
+
+ ffgrec(infptr, nrec, rec, status);
+
+ /* silently overlook any illegal ASCII characters in the value or */
+ /* comment fields of the record. It is usually not appropriate to */
+ /* abort the process because of this minor transgression of the FITS rules. */
+ /* Set the offending character to a blank */
+
+ maxchr = strlen(rec);
+ for (ii = 8; ii < maxchr; ii++)
+ {
+ if (rec[ii] < 32 || rec[ii] > 126)
+ rec[ii] = ' ';
+ }
+
+ fits_translate_keyword(rec, outrec, patterns, npat,
+ n_value, n_offset, n_range,
+ &pat_num, &i, &j, &m, &n, status);
+
+ if (outrec[0]) {
+ ffprec(outfptr, outrec, status); /* copy the keyword */
+ rec[8] = 0; outrec[8] = 0;
+ } else {
+ rec[8] = 0; outrec[8] = 0;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_copy_pixlist2image(
+ fitsfile *infptr, /* I - pointer to input HDU */
+ fitsfile *outfptr, /* I - pointer to output HDU */
+ int firstkey, /* I - first HDU record number to start with */
+ int naxis, /* I - number of axes in the image */
+ int *colnum, /* I - numbers of the columns to be binned */
+ int *status) /* IO - error status */
+/*
+ Copy relevant keywords from the pixel list table header into a newly
+ created primary array header. Convert names of keywords where
+ appropriate. See fits_translate_pixkeyword() for the definitions.
+
+ Translation begins at header record number 'firstkey', and
+ continues to the end of the header.
+*/
+{
+ int nrec, nkeys, nmore;
+ char rec[FLEN_CARD], outrec[FLEN_CARD];
+ int pat_num = 0, npat;
+ int iret, jret, nret, mret, lret;
+ char *patterns[][2] = {
+
+ {"TCTYPn", "CTYPEn" },
+ {"TCTYna", "CTYPEna" },
+ {"TCUNIn", "CUNITn" },
+ {"TCUNna", "CUNITna" },
+ {"TCRVLn", "CRVALn" },
+ {"TCRVna", "CRVALna" },
+ {"TCDLTn", "CDELTn" },
+ {"TCDEna", "CDELTna" },
+ {"TCRPXn", "CRPIXn" },
+ {"TCRPna", "CRPIXna" },
+ {"TCROTn", "CROTAn" },
+ {"TPn_ma", "PCn_ma" },
+ {"TPCn_m", "PCn_ma" },
+ {"TCn_ma", "CDn_ma" },
+ {"TCDn_m", "CDn_ma" },
+ {"TVn_la", "PVn_la" },
+ {"TPVn_l", "PVn_la" },
+ {"TSn_la", "PSn_la" },
+ {"TPSn_l", "PSn_la" },
+ {"TWCSna", "WCSNAMEa" },
+ {"TCNAna", "CNAMEna" },
+ {"TCRDna", "CRDERna" },
+ {"TCSYna", "CSYERna" },
+ {"LONPna", "LONPOLEa" },
+ {"LATPna", "LATPOLEa" },
+ {"EQUIna", "EQUINOXa" },
+ {"MJDOBn", "MJD-OBS" },
+ {"MJDAn", "MJD-AVG" },
+ {"DAVGn", "DATE-AVG" },
+ {"RADEna", "RADESYSa" },
+ {"RFRQna", "RESTFRQa" },
+ {"RWAVna", "RESTWAVa" },
+ {"SPECna", "SPECSYSa" },
+ {"SOBSna", "SSYSOBSa" },
+ {"SSRCna", "SSYSSRCa" },
+
+ /* preserve common keywords */
+ {"LONPOLEa", "+" },
+ {"LATPOLEa", "+" },
+ {"EQUINOXa", "+" },
+ {"EPOCH", "+" },
+ {"MJD-????", "+" },
+ {"DATE????", "+" },
+ {"TIME????", "+" },
+ {"RADESYSa", "+" },
+ {"RADECSYS", "+" },
+ {"TELESCOP", "+" },
+ {"INSTRUME", "+" },
+ {"OBSERVER", "+" },
+ {"OBJECT", "+" },
+
+ /* Delete general table column keywords */
+ {"XTENSION", "-" },
+ {"BITPIX", "-" },
+ {"NAXIS", "-" },
+ {"NAXISi", "-" },
+ {"PCOUNT", "-" },
+ {"GCOUNT", "-" },
+ {"TFIELDS", "-" },
+
+ {"TDIM#", "-" },
+ {"THEAP", "-" },
+ {"EXTNAME", "-" },
+ {"EXTVER", "-" },
+ {"EXTLEVEL","-" },
+ {"CHECKSUM","-" },
+ {"DATASUM", "-" },
+ {"NAXLEN", "-" },
+ {"AXLEN#", "-" },
+ {"CPREF", "-" },
+
+ /* Delete table keywords related to other columns */
+ {"T????#a", "-" },
+ {"TC??#a", "-" },
+ {"T??#_#", "-" },
+ {"TWCS#a", "-" },
+
+ {"LONP#a", "-" },
+ {"LATP#a", "-" },
+ {"EQUI#a", "-" },
+ {"MJDOB#", "-" },
+ {"MJDA#", "-" },
+ {"RADE#a", "-" },
+ {"DAVG#", "-" },
+
+ {"iCTYP#", "-" },
+ {"iCTY#a", "-" },
+ {"iCUNI#", "-" },
+ {"iCUN#a", "-" },
+ {"iCRVL#", "-" },
+ {"iCDLT#", "-" },
+ {"iCRPX#", "-" },
+ {"iCTY#a", "-" },
+ {"iCUN#a", "-" },
+ {"iCRV#a", "-" },
+ {"iCDE#a", "-" },
+ {"iCRP#a", "-" },
+ {"ijPC#a", "-" },
+ {"ijCD#a", "-" },
+ {"iV#_#a", "-" },
+ {"iS#_#a", "-" },
+ {"iCRD#a", "-" },
+ {"iCSY#a", "-" },
+ {"iCROT#", "-" },
+ {"WCAX#a", "-" },
+ {"WCSN#a", "-" },
+ {"iCNA#a", "-" },
+
+ {"*", "+" }}; /* copy all other keywords */
+
+ if (*status > 0)
+ return(*status);
+
+ npat = sizeof(patterns)/sizeof(patterns[0][0])/2;
+
+ ffghsp(infptr, &nkeys, &nmore, status); /* get number of keywords */
+
+ for (nrec = firstkey; nrec <= nkeys; nrec++) {
+ outrec[0] = '\0';
+
+ ffgrec(infptr, nrec, rec, status);
+
+ fits_translate_pixkeyword(rec, outrec, patterns, npat,
+ naxis, colnum,
+ &pat_num, &iret, &jret, &nret, &mret, &lret, status);
+
+ if (outrec[0]) {
+ ffprec(outfptr, outrec, status); /* copy the keyword */
+ }
+
+ rec[8] = 0; outrec[8] = 0;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_translate_pixkeyword(
+ char *inrec, /* I - input string */
+ char *outrec, /* O - output converted string, or */
+ /* a null string if input does not */
+ /* match any of the patterns */
+ char *patterns[][2],/* I - pointer to input / output string */
+ /* templates */
+ int npat, /* I - number of templates passed */
+ int naxis, /* I - number of columns to be binned */
+ int *colnum, /* I - numbers of the columns to be binned */
+ int *pat_num, /* O - matched pattern number (0 based) or -1 */
+ int *i,
+ int *j,
+ int *n,
+ int *m,
+ int *l,
+ int *status) /* IO - error status */
+
+/*
+
+Translate a keyword name to a new name, based on a set of patterns.
+The user passes an array of patterns to be matched. Input pattern
+number i is pattern[i][0], and output pattern number i is
+pattern[i][1]. Keywords are matched against the input patterns. If a
+match is found then the keyword is re-written according to the output
+pattern.
+
+Order is important. The first match is accepted. The fastest match
+will be made when templates with the same first character are grouped
+together.
+
+Several characters have special meanings:
+
+ i,j - single digits, preserved in output template
+ n, m - column number of one or more digits, preserved in output template
+ k - generic number of one or more digits, preserved in output template
+ a - coordinate designator, preserved in output template
+ # - number of one or more digits
+ ? - any character
+ * - only allowed in first character position, to match all
+ keywords; only useful as last pattern in the list
+
+i, j, n, and m are returned by the routine.
+
+For example, the input pattern "iCTYPn" will match "1CTYP5" (if n_value
+is 5); the output pattern "CTYPEi" will be re-written as "CTYPE1".
+Notice that "i" is preserved.
+
+The following output patterns are special
+
+Special output pattern characters:
+
+ "-" - do not copy a keyword that matches the corresponding input pattern
+
+ "+" - copy the input unchanged
+
+The inrec string could be just the 8-char keyword name, or the entire
+80-char header record. Characters 9 = 80 in the input string simply get
+appended to the translated keyword name.
+
+If n_range = 0, then only keywords with 'n' equal to n_value will be
+considered as a pattern match. If n_range = +1, then all values of
+'n' greater than or equal to n_value will be a match, and if -1,
+then values of 'n' less than or equal to n_value will match.
+
+*/
+
+{
+ int i1 = 0, j1 = 0, val;
+ int fac, nval, mval, lval;
+ char a = ' ';
+ char oldp;
+ char c, s;
+ int ip, ic, pat, pass = 0, firstfail;
+ char *spat;
+
+ if (*status > 0)
+ return(*status);
+
+ if ((inrec == 0) || (outrec == 0))
+ return (*status = NULL_INPUT_PTR);
+
+ *outrec = '\0';
+ if (*inrec == '\0') return 0;
+
+ oldp = '\0';
+ firstfail = 0;
+
+ /* ===== Pattern match stage */
+ for (pat=0; pat < npat; pat++) {
+
+ spat = patterns[pat][0];
+
+ i1 = 0; j1 = 0; a = ' '; /* Initialize the place-holders */
+ pass = 0;
+
+ /* Pass the wildcard pattern */
+ if (spat[0] == '*') {
+ pass = 1;
+ break;
+ }
+
+ /* Optimization: if we have seen this initial pattern character before,
+ then it must have failed, and we can skip the pattern */
+ if (firstfail && spat[0] == oldp) continue;
+ oldp = spat[0];
+
+ /*
+ ip = index of pattern character being matched
+ ic = index of keyname character being matched
+ firstfail = 1 if we fail on the first characteor (0=not)
+ */
+
+ for (ip=0, ic=0, firstfail=1;
+ (spat[ip]) && (ic < 8);
+ ip++, ic++, firstfail=0) {
+ c = inrec[ic];
+ s = spat[ip];
+
+ if (s == 'i') {
+ /* Special pattern: 'i' placeholder */
+ if (isdigit(c)) { i1 = c - '0'; pass = 1;}
+ } else if (s == 'j') {
+ /* Special pattern: 'j' placeholder */
+ if (isdigit(c)) { j1 = c - '0'; pass = 1;}
+ } else if ((s == 'n')||(s == 'm')||(s == 'l')||(s == '#')) {
+ /* Special patterns: multi-digit number */
+ val = 0;
+ pass = 0;
+ if (isdigit(c)) {
+ pass = 1; /* NOTE, could fail below */
+
+ /* Parse decimal number */
+ while (ic<8 && isdigit(c)) {
+ val = val*10 + (c - '0');
+ ic++; c = inrec[ic];
+ }
+ ic--; c = inrec[ic];
+
+ if (s == 'n' || s == 'm') {
+
+ /* Is it a column number? */
+ if ( val >= 1 && val <= 999) {
+
+ if (val == colnum[0])
+ val = 1;
+ else if (val == colnum[1])
+ val = 2;
+ else if (val == colnum[2])
+ val = 3;
+ else if (val == colnum[3])
+ val = 4;
+ else {
+ pass = 0;
+ val = 0;
+ }
+
+ if (s == 'n')
+ nval = val;
+ else
+ mval = val;
+
+ } else {
+ pass = 0;
+ }
+ } else if (s == 'l') {
+ /* Generic number */
+ lval = val;
+ }
+ }
+ } else if (s == 'a') {
+ /* Special pattern: coordinate designator */
+ if (isupper(c) || c == ' ') { a = c; pass = 1;}
+ } else if (s == '?') {
+ /* Match any individual character */
+ pass = 1;
+ } else if (c == s) {
+ /* Match a specific character */
+ pass = 1;
+ } else {
+ /* FAIL */
+ pass = 0;
+ }
+
+ if (!pass) break;
+ }
+
+
+ /* Must pass to the end of the keyword. No partial matches allowed */
+ if (pass && (ic >= 8 || inrec[ic] == ' ')) break;
+ }
+
+
+ /* Transfer the pattern-matched numbers to the output parameters */
+ if (i) { *i = i1; }
+ if (j) { *j = j1; }
+ if (n) { *n = nval; }
+ if (m) { *m = mval; }
+ if (l) { *l = lval; }
+ if (pat_num) { *pat_num = pat; }
+
+ /* ===== Keyword rewriting and output stage */
+ spat = patterns[pat][1];
+
+ /* Return case: no match, or explicit deletion pattern */
+ if (pass == 0 || spat[0] == '\0' || spat[0] == '-') return 0;
+
+ /* A match: we start by copying the input record to the output */
+ strcpy(outrec, inrec);
+
+ /* Return case: return the input record unchanged */
+ if (spat[0] == '+') return 0;
+
+ /* Final case: a new output pattern */
+ for (ip=0, ic=0; spat[ip]; ip++, ic++) {
+ s = spat[ip];
+ if (s == 'i') {
+ outrec[ic] = (i1+'0');
+ } else if (s == 'j') {
+ outrec[ic] = (j1+'0');
+ } else if (s == 'n' && nval > 0) {
+ for (fac = 1; (nval/fac) > 0; fac *= 10);
+ fac /= 10;
+ while(fac > 0) {
+ outrec[ic] = ((nval/fac) % 10) + '0';
+ fac /= 10;
+ ic ++;
+ }
+ ic--;
+ } else if (s == 'm' && mval > 0) {
+ for (fac = 1; (mval/fac) > 0; fac *= 10);
+ fac /= 10;
+ while(fac > 0) {
+ outrec[ic] = ((mval/fac) % 10) + '0';
+ fac /= 10;
+ ic ++;
+ }
+ ic--;
+ } else if (s == 'l' && lval >= 0) {
+ for (fac = 1; (lval/fac) > 0; fac *= 10);
+ fac /= 10;
+ while(fac > 0) {
+ outrec[ic] = ((lval/fac) % 10) + '0';
+ fac /= 10;
+ ic ++;
+ }
+ ic --;
+ } else if (s == 'a') {
+ outrec[ic] = a;
+ } else {
+ outrec[ic] = s;
+ }
+ }
+
+ /* Pad the keyword name with spaces */
+ for ( ; ic<8; ic++) { outrec[ic] = ' '; }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffasfm(char *tform, /* I - format code from the TFORMn keyword */
+ int *dtcode, /* O - numerical datatype code */
+ long *twidth, /* O - width of the field, in chars */
+ int *decimals, /* O - number of decimal places (F, E, D format) */
+ int *status) /* IO - error status */
+{
+/*
+ parse the ASCII table TFORM column format to determine the data
+ type, the field width, and number of decimal places (if relevant)
+*/
+ int ii, datacode;
+ long longval, width;
+ float fwidth;
+ char *form, temp[FLEN_VALUE], message[FLEN_ERRMSG];
+
+ if (*status > 0)
+ return(*status);
+
+ if (dtcode)
+ *dtcode = 0;
+
+ if (twidth)
+ *twidth = 0;
+
+ if (decimals)
+ *decimals = 0;
+
+ ii = 0;
+ while (tform[ii] != 0 && tform[ii] == ' ') /* find first non-blank char */
+ ii++;
+
+ strcpy(temp, &tform[ii]); /* copy format string */
+ ffupch(temp); /* make sure it is in upper case */
+ form = temp; /* point to start of format string */
+
+
+ if (form[0] == 0)
+ {
+ ffpmsg("Error: ASCII table TFORM code is blank");
+ return(*status = BAD_TFORM);
+ }
+
+ /*-----------------------------------------------*/
+ /* determine default datatype code */
+ /*-----------------------------------------------*/
+ if (form[0] == 'A')
+ datacode = TSTRING;
+ else if (form[0] == 'I')
+ datacode = TLONG;
+ else if (form[0] == 'F')
+ datacode = TFLOAT;
+ else if (form[0] == 'E')
+ datacode = TFLOAT;
+ else if (form[0] == 'D')
+ datacode = TDOUBLE;
+ else
+ {
+ sprintf(message,
+ "Illegal ASCII table TFORMn datatype: \'%s\'", tform);
+ ffpmsg(message);
+ return(*status = BAD_TFORM_DTYPE);
+ }
+
+ if (dtcode)
+ *dtcode = datacode;
+
+ form++; /* point to the start of field width */
+
+ if (datacode == TSTRING || datacode == TLONG)
+ {
+ /*-----------------------------------------------*/
+ /* A or I data formats: */
+ /*-----------------------------------------------*/
+
+ if (ffc2ii(form, &width, status) <= 0) /* read the width field */
+ {
+ if (width <= 0)
+ {
+ width = 0;
+ *status = BAD_TFORM;
+ }
+ else
+ {
+ /* set to shorter precision if I4 or less */
+ if (width <= 4 && datacode == TLONG)
+ datacode = TSHORT;
+ }
+ }
+ }
+ else
+ {
+ /*-----------------------------------------------*/
+ /* F, E or D data formats: */
+ /*-----------------------------------------------*/
+
+ if (ffc2rr(form, &fwidth, status) <= 0) /* read ww.dd width field */
+ {
+ if (fwidth <= 0.)
+ *status = BAD_TFORM;
+ else
+ {
+ width = (long) fwidth; /* convert from float to long */
+
+ if (width > 7 && *temp == 'F')
+ datacode = TDOUBLE; /* type double if >7 digits */
+
+ if (width < 10)
+ form = form + 1; /* skip 1 digit */
+ else
+ form = form + 2; /* skip 2 digits */
+
+ if (form[0] == '.') /* should be a decimal point here */
+ {
+ form++; /* point to start of decimals field */
+
+ if (ffc2ii(form, &longval, status) <= 0) /* read decimals */
+ {
+ if (decimals)
+ *decimals = longval; /* long to short convertion */
+
+ if (longval >= width) /* width < no. of decimals */
+ *status = BAD_TFORM;
+
+ if (longval > 6 && *temp == 'E')
+ datacode = TDOUBLE; /* type double if >6 digits */
+ }
+ }
+
+ }
+ }
+ }
+ if (*status > 0)
+ {
+ *status = BAD_TFORM;
+ sprintf(message,"Illegal ASCII table TFORMn code: \'%s\'", tform);
+ ffpmsg(message);
+ }
+
+ if (dtcode)
+ *dtcode = datacode;
+
+ if (twidth)
+ *twidth = width;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffbnfm(char *tform, /* I - format code from the TFORMn keyword */
+ int *dtcode, /* O - numerical datatype code */
+ long *trepeat, /* O - repeat count of the field */
+ long *twidth, /* O - width of the field, in chars */
+ int *status) /* IO - error status */
+{
+/*
+ parse the binary table TFORM column format to determine the data
+ type, repeat count, and the field width (if it is an ASCII (A) field)
+*/
+ size_t ii, nchar;
+ int datacode, variable, iread;
+ long width, repeat;
+ char *form, temp[FLEN_VALUE], message[FLEN_ERRMSG];
+
+ if (*status > 0)
+ return(*status);
+
+ if (dtcode)
+ *dtcode = 0;
+
+ if (trepeat)
+ *trepeat = 0;
+
+ if (twidth)
+ *twidth = 0;
+
+ nchar = strlen(tform);
+
+ for (ii = 0; ii < nchar; ii++)
+ {
+ if (tform[ii] != ' ') /* find first non-space char */
+ break;
+ }
+
+ if (ii == nchar)
+ {
+ ffpmsg("Error: binary table TFORM code is blank (ffbnfm).");
+ return(*status = BAD_TFORM);
+ }
+
+ strcpy(temp, &tform[ii]); /* copy format string */
+ ffupch(temp); /* make sure it is in upper case */
+ form = temp; /* point to start of format string */
+
+ /*-----------------------------------------------*/
+ /* get the repeat count */
+ /*-----------------------------------------------*/
+
+ ii = 0;
+ while(isdigit((int) form[ii]))
+ ii++; /* look for leading digits in the field */
+
+ if (ii == 0)
+ repeat = 1; /* no explicit repeat count */
+ else
+ sscanf(form,"%ld", &repeat); /* read repeat count */
+
+ /*-----------------------------------------------*/
+ /* determine datatype code */
+ /*-----------------------------------------------*/
+
+ form = form + ii; /* skip over the repeat field */
+
+ if (form[0] == 'P' || form[0] == 'Q')
+ {
+ variable = 1; /* this is a variable length column */
+/* repeat = 1; */ /* disregard any other repeat value */
+ form++; /* move to the next data type code char */
+ }
+ else
+ variable = 0;
+
+ if (form[0] == 'U') /* internal code to signify unsigned integer */
+ {
+ datacode = TUSHORT;
+ width = 2;
+ }
+ else if (form[0] == 'I')
+ {
+ datacode = TSHORT;
+ width = 2;
+ }
+ else if (form[0] == 'V') /* internal code to signify unsigned integer */
+ {
+ datacode = TULONG;
+ width = 4;
+ }
+ else if (form[0] == 'J')
+ {
+ datacode = TLONG;
+ width = 4;
+ }
+ else if (form[0] == 'K')
+ {
+ datacode = TLONGLONG;
+ width = 8;
+ }
+ else if (form[0] == 'E')
+ {
+ datacode = TFLOAT;
+ width = 4;
+ }
+ else if (form[0] == 'D')
+ {
+ datacode = TDOUBLE;
+ width = 8;
+ }
+ else if (form[0] == 'A')
+ {
+ datacode = TSTRING;
+
+ /*
+ the following code is used to support the non-standard
+ datatype of the form rAw where r = total width of the field
+ and w = width of fixed-length substrings within the field.
+ */
+ iread = 0;
+ if (form[1] != 0)
+ {
+ if (form[1] == '(' ) /* skip parenthesis around */
+ form++; /* variable length column width */
+
+ iread = sscanf(&form[1],"%ld", &width);
+ }
+
+ if (iread != 1 || (!variable && (width > repeat)) )
+ width = repeat;
+
+ }
+ else if (form[0] == 'L')
+ {
+ datacode = TLOGICAL;
+ width = 1;
+ }
+ else if (form[0] == 'X')
+ {
+ datacode = TBIT;
+ width = 1;
+ }
+ else if (form[0] == 'B')
+ {
+ datacode = TBYTE;
+ width = 1;
+ }
+ else if (form[0] == 'S') /* internal code to signify signed byte */
+ {
+ datacode = TSBYTE;
+ width = 1;
+ }
+ else if (form[0] == 'C')
+ {
+ datacode = TCOMPLEX;
+ width = 8;
+ }
+ else if (form[0] == 'M')
+ {
+ datacode = TDBLCOMPLEX;
+ width = 16;
+ }
+ else
+ {
+ sprintf(message,
+ "Illegal binary table TFORMn datatype: \'%s\' ", tform);
+ ffpmsg(message);
+ return(*status = BAD_TFORM_DTYPE);
+ }
+
+ if (variable)
+ datacode = datacode * (-1); /* flag variable cols w/ neg type code */
+
+ if (dtcode)
+ *dtcode = datacode;
+
+ if (trepeat)
+ *trepeat = repeat;
+
+ if (twidth)
+ *twidth = width;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffbnfmll(char *tform, /* I - format code from the TFORMn keyword */
+ int *dtcode, /* O - numerical datatype code */
+ LONGLONG *trepeat, /* O - repeat count of the field */
+ long *twidth, /* O - width of the field, in chars */
+ int *status) /* IO - error status */
+{
+/*
+ parse the binary table TFORM column format to determine the data
+ type, repeat count, and the field width (if it is an ASCII (A) field)
+*/
+ size_t ii, nchar;
+ int datacode, variable, iread;
+ long width;
+ LONGLONG repeat;
+ char *form, temp[FLEN_VALUE], message[FLEN_ERRMSG];
+ double drepeat;
+
+ if (*status > 0)
+ return(*status);
+
+ if (dtcode)
+ *dtcode = 0;
+
+ if (trepeat)
+ *trepeat = 0;
+
+ if (twidth)
+ *twidth = 0;
+
+ nchar = strlen(tform);
+
+ for (ii = 0; ii < nchar; ii++)
+ {
+ if (tform[ii] != ' ') /* find first non-space char */
+ break;
+ }
+
+ if (ii == nchar)
+ {
+ ffpmsg("Error: binary table TFORM code is blank (ffbnfmll).");
+ return(*status = BAD_TFORM);
+ }
+
+ strcpy(temp, &tform[ii]); /* copy format string */
+ ffupch(temp); /* make sure it is in upper case */
+ form = temp; /* point to start of format string */
+
+ /*-----------------------------------------------*/
+ /* get the repeat count */
+ /*-----------------------------------------------*/
+
+ ii = 0;
+ while(isdigit((int) form[ii]))
+ ii++; /* look for leading digits in the field */
+
+ if (ii == 0)
+ repeat = 1; /* no explicit repeat count */
+ else {
+ /* read repeat count */
+
+ /* print as double, because the string-to-64-bit int conversion */
+ /* character is platform dependent (%lld, %ld, %I64d) */
+
+ sscanf(form,"%lf", &drepeat);
+ repeat = (LONGLONG) (drepeat + 0.1);
+ }
+ /*-----------------------------------------------*/
+ /* determine datatype code */
+ /*-----------------------------------------------*/
+
+ form = form + ii; /* skip over the repeat field */
+
+ if (form[0] == 'P' || form[0] == 'Q')
+ {
+ variable = 1; /* this is a variable length column */
+/* repeat = 1; */ /* disregard any other repeat value */
+ form++; /* move to the next data type code char */
+ }
+ else
+ variable = 0;
+
+ if (form[0] == 'U') /* internal code to signify unsigned integer */
+ {
+ datacode = TUSHORT;
+ width = 2;
+ }
+ else if (form[0] == 'I')
+ {
+ datacode = TSHORT;
+ width = 2;
+ }
+ else if (form[0] == 'V') /* internal code to signify unsigned integer */
+ {
+ datacode = TULONG;
+ width = 4;
+ }
+ else if (form[0] == 'J')
+ {
+ datacode = TLONG;
+ width = 4;
+ }
+ else if (form[0] == 'K')
+ {
+ datacode = TLONGLONG;
+ width = 8;
+ }
+ else if (form[0] == 'E')
+ {
+ datacode = TFLOAT;
+ width = 4;
+ }
+ else if (form[0] == 'D')
+ {
+ datacode = TDOUBLE;
+ width = 8;
+ }
+ else if (form[0] == 'A')
+ {
+ datacode = TSTRING;
+
+ /*
+ the following code is used to support the non-standard
+ datatype of the form rAw where r = total width of the field
+ and w = width of fixed-length substrings within the field.
+ */
+ iread = 0;
+ if (form[1] != 0)
+ {
+ if (form[1] == '(' ) /* skip parenthesis around */
+ form++; /* variable length column width */
+
+ iread = sscanf(&form[1],"%ld", &width);
+ }
+
+ if (iread != 1 || (!variable && (width > repeat)) )
+ width = (long) repeat;
+
+ }
+ else if (form[0] == 'L')
+ {
+ datacode = TLOGICAL;
+ width = 1;
+ }
+ else if (form[0] == 'X')
+ {
+ datacode = TBIT;
+ width = 1;
+ }
+ else if (form[0] == 'B')
+ {
+ datacode = TBYTE;
+ width = 1;
+ }
+ else if (form[0] == 'S') /* internal code to signify signed byte */
+ {
+ datacode = TSBYTE;
+ width = 1;
+ }
+ else if (form[0] == 'C')
+ {
+ datacode = TCOMPLEX;
+ width = 8;
+ }
+ else if (form[0] == 'M')
+ {
+ datacode = TDBLCOMPLEX;
+ width = 16;
+ }
+ else
+ {
+ sprintf(message,
+ "Illegal binary table TFORMn datatype: \'%s\' ", tform);
+ ffpmsg(message);
+ return(*status = BAD_TFORM_DTYPE);
+ }
+
+ if (variable)
+ datacode = datacode * (-1); /* flag variable cols w/ neg type code */
+
+ if (dtcode)
+ *dtcode = datacode;
+
+ if (trepeat)
+ *trepeat = repeat;
+
+ if (twidth)
+ *twidth = width;
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+void ffcfmt(char *tform, /* value of an ASCII table TFORMn keyword */
+ char *cform) /* equivalent format code in C language syntax */
+/*
+ convert the FITS format string for an ASCII Table extension column into the
+ equivalent C format string that can be used in a printf statement, after
+ the values have been read as a double.
+*/
+{
+ int ii;
+
+ cform[0] = '\0';
+ ii = 0;
+ while (tform[ii] != 0 && tform[ii] == ' ') /* find first non-blank char */
+ ii++;
+
+ if (tform[ii] == 0)
+ return; /* input format string was blank */
+
+ cform[0] = '%'; /* start the format string */
+
+ strcpy(&cform[1], &tform[ii + 1]); /* append the width and decimal code */
+
+
+ if (tform[ii] == 'A')
+ strcat(cform, "s");
+ else if (tform[ii] == 'I')
+ strcat(cform, ".0f"); /* 0 precision to suppress decimal point */
+ if (tform[ii] == 'F')
+ strcat(cform, "f");
+ if (tform[ii] == 'E')
+ strcat(cform, "E");
+ if (tform[ii] == 'D')
+ strcat(cform, "E");
+
+ return;
+}
+/*--------------------------------------------------------------------------*/
+void ffcdsp(char *tform, /* value of an ASCII table TFORMn keyword */
+ char *cform) /* equivalent format code in C language syntax */
+/*
+ convert the FITS TDISPn display format into the equivalent C format
+ suitable for use in a printf statement.
+*/
+{
+ int ii;
+
+ cform[0] = '\0';
+ ii = 0;
+ while (tform[ii] != 0 && tform[ii] == ' ') /* find first non-blank char */
+ ii++;
+
+ if (tform[ii] == 0)
+ {
+ cform[0] = '\0';
+ return; /* input format string was blank */
+ }
+
+ if (strchr(tform+ii, '%')) /* is there a % character in the string?? */
+ {
+ cform[0] = '\0';
+ return; /* illegal TFORM string (possibly even harmful) */
+ }
+
+ cform[0] = '%'; /* start the format string */
+
+ strcpy(&cform[1], &tform[ii + 1]); /* append the width and decimal code */
+
+ if (tform[ii] == 'A' || tform[ii] == 'a')
+ strcat(cform, "s");
+ else if (tform[ii] == 'I' || tform[ii] == 'i')
+ strcat(cform, "d");
+ else if (tform[ii] == 'O' || tform[ii] == 'o')
+ strcat(cform, "o");
+ else if (tform[ii] == 'Z' || tform[ii] == 'z')
+ strcat(cform, "X");
+ else if (tform[ii] == 'F' || tform[ii] == 'f')
+ strcat(cform, "f");
+ else if (tform[ii] == 'E' || tform[ii] == 'e')
+ strcat(cform, "E");
+ else if (tform[ii] == 'D' || tform[ii] == 'd')
+ strcat(cform, "E");
+ else if (tform[ii] == 'G' || tform[ii] == 'g')
+ strcat(cform, "G");
+ else
+ cform[0] = '\0'; /* unrecognized tform code */
+
+ return;
+}
+/*--------------------------------------------------------------------------*/
+int ffgcno( fitsfile *fptr, /* I - FITS file pionter */
+ int casesen, /* I - case sensitive string comparison? 0=no */
+ char *templt, /* I - input name of column (w/wildcards) */
+ int *colnum, /* O - number of the named column; 1=first col */
+ int *status) /* IO - error status */
+/*
+ Determine the column number corresponding to an input column name.
+ The first column of the table = column 1;
+ This supports the * and ? wild cards in the input template.
+*/
+{
+ char colname[FLEN_VALUE]; /* temporary string to hold column name */
+
+ ffgcnn(fptr, casesen, templt, colname, colnum, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcnn( fitsfile *fptr, /* I - FITS file pointer */
+ int casesen, /* I - case sensitive string comparison? 0=no */
+ char *templt, /* I - input name of column (w/wildcards) */
+ char *colname, /* O - full column name up to 68 + 1 chars long*/
+ int *colnum, /* O - number of the named column; 1=first col */
+ int *status) /* IO - error status */
+/*
+ Return the full column name and column number of the next column whose
+ TTYPEn keyword value matches the input template string.
+ The template may contain the * and ? wildcards. Status = 237 is
+ returned if the match is not unique. If so, one may call this routine
+ again with input status=237 to get the next match. A status value of
+ 219 is returned when there are no more matching columns.
+*/
+{
+ char errmsg[FLEN_ERRMSG];
+ static int startcol;
+ int tstatus, ii, founde, foundw, match, exact, unique;
+ long ivalue;
+ tcolumn *colptr;
+
+ if (*status <= 0)
+ {
+ startcol = 0; /* start search with first column */
+ tstatus = 0;
+ }
+ else if (*status == COL_NOT_UNIQUE) /* start search from previous spot */
+ {
+ tstatus = COL_NOT_UNIQUE;
+ *status = 0;
+ }
+ else
+ return(*status); /* bad input status value */
+
+ colname[0] = 0; /* initialize null return */
+ *colnum = 0;
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header to get col struct */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* pointer to first column */
+ colptr += (startcol); /* offset to starting column */
+
+ founde = FALSE; /* initialize 'found exact match' flag */
+ foundw = FALSE; /* initialize 'found wildcard match' flag */
+ unique = FALSE;
+
+ for (ii = startcol; ii < (fptr->Fptr)->tfield; ii++, colptr++)
+ {
+ ffcmps(templt, colptr->ttype, casesen, &match, &exact);
+ if (match)
+ {
+ if (founde && exact)
+ {
+ /* warning: this is the second exact match we've found */
+ /*reset pointer to first match so next search starts there */
+ startcol = *colnum;
+ return(*status = COL_NOT_UNIQUE);
+ }
+ else if (founde) /* a wildcard match */
+ {
+ /* already found exact match so ignore this non-exact match */
+ }
+ else if (exact)
+ {
+ /* this is the first exact match we have found, so save it. */
+ strcpy(colname, colptr->ttype);
+ *colnum = ii + 1;
+ founde = TRUE;
+ }
+ else if (foundw)
+ {
+ /* we have already found a wild card match, so not unique */
+ /* continue searching for other matches */
+ unique = FALSE;
+ }
+ else
+ {
+ /* this is the first wild card match we've found. save it */
+ strcpy(colname, colptr->ttype);
+ *colnum = ii + 1;
+ startcol = *colnum;
+ foundw = TRUE;
+ unique = TRUE;
+ }
+ }
+ }
+
+ /* OK, we've checked all the names now see if we got any matches */
+ if (founde)
+ {
+ if (tstatus == COL_NOT_UNIQUE) /* we did find 1 exact match but */
+ *status = COL_NOT_UNIQUE; /* there was a previous match too */
+ }
+ else if (foundw)
+ {
+ /* found one or more wildcard matches; report error if not unique */
+ if (!unique || tstatus == COL_NOT_UNIQUE)
+ *status = COL_NOT_UNIQUE;
+ }
+ else
+ {
+ /* didn't find a match; check if template is a positive integer */
+ ffc2ii(templt, &ivalue, &tstatus);
+ if (tstatus == 0 && ivalue <= (fptr->Fptr)->tfield && ivalue > 0)
+ {
+ *colnum = ivalue;
+
+ colptr = (fptr->Fptr)->tableptr; /* pointer to first column */
+ colptr += (ivalue - 1); /* offset to correct column */
+ strcpy(colname, colptr->ttype);
+ }
+ else
+ {
+ *status = COL_NOT_FOUND;
+ if (tstatus != COL_NOT_UNIQUE)
+ {
+ sprintf(errmsg, "ffgcnn could not find column: %.45s", templt);
+ ffpmsg(errmsg);
+ }
+ }
+ }
+
+ startcol = *colnum; /* save pointer for next time */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+void ffcmps(char *templt, /* I - input template (may have wildcards) */
+ char *colname, /* I - full column name up to 68 + 1 chars long */
+ int casesen, /* I - case sensitive string comparison? 1=yes */
+ int *match, /* O - do template and colname match? 1=yes */
+ int *exact) /* O - do strings exactly match, or wildcards */
+/*
+ compare the template to the string and test if they match.
+ The strings are limited to 68 characters or less (the max. length
+ of a FITS string keyword value. This routine reports whether
+ the two strings match and whether the match is exact or
+ involves wildcards.
+
+ This algorithm is very similar to the way unix filename wildcards
+ work except that this first treats a wild card as a literal character
+ when looking for a match. If there is no literal match, then
+ it interpretes it as a wild card. So the template 'AB*DE'
+ is considered to be an exact rather than a wild card match to
+ the string 'AB*DE'. The '#' wild card in the template string will
+ match any consecutive string of decimal digits in the colname.
+
+*/
+{
+ int ii, found, t1, s1, wildsearch = 0, tsave = 0, ssave = 0;
+ char temp[FLEN_VALUE], col[FLEN_VALUE];
+
+ *match = FALSE;
+ *exact = TRUE;
+
+ strncpy(temp, templt, FLEN_VALUE); /* copy strings to work area */
+ strncpy(col, colname, FLEN_VALUE);
+ temp[FLEN_VALUE - 1] = '\0'; /* make sure strings are terminated */
+ col[FLEN_VALUE - 1] = '\0';
+
+ /* truncate trailing non-significant blanks */
+ for (ii = strlen(temp) - 1; ii >= 0 && temp[ii] == ' '; ii--)
+ temp[ii] = '\0';
+
+ for (ii = strlen(col) - 1; ii >= 0 && col[ii] == ' '; ii--)
+ col[ii] = '\0';
+
+ if (!casesen)
+ { /* convert both strings to uppercase before comparison */
+ ffupch(temp);
+ ffupch(col);
+ }
+
+ if (!FSTRCMP(temp, col) )
+ {
+ *match = TRUE; /* strings exactly match */
+ return;
+ }
+
+ *exact = FALSE; /* strings don't exactly match */
+
+ t1 = 0; /* start comparison with 1st char of each string */
+ s1 = 0;
+
+ while(1) /* compare corresponding chars in each string */
+ {
+ if (temp[t1] == '\0' && col[s1] == '\0')
+ {
+ /* completely scanned both strings so they match */
+ *match = TRUE;
+ return;
+ }
+ else if (temp[t1] == '\0')
+ {
+ if (wildsearch)
+ {
+ /*
+ the previous wildcard search may have been going down
+ a blind alley. Backtrack, and resume the wildcard
+ search with the next character in the string.
+ */
+ t1 = tsave;
+ s1 = ssave + 1;
+ }
+ else
+ {
+ /* reached end of template string so they don't match */
+ return;
+ }
+ }
+ else if (col[s1] == '\0')
+ {
+ /* reached end of other string; they match if the next */
+ /* character in the template string is a '*' wild card */
+
+ if (temp[t1] == '*' && temp[t1 + 1] == '\0')
+ {
+ *match = TRUE;
+ }
+
+ return;
+ }
+
+ if (temp[t1] == col[s1] || (temp[t1] == '?') )
+ {
+ s1++; /* corresponding chars in the 2 strings match */
+ t1++; /* increment both pointers and loop back again */
+ }
+ else if (temp[t1] == '#' && isdigit((int) col[s1]) )
+ {
+ s1++; /* corresponding chars in the 2 strings match */
+ t1++; /* increment both pointers */
+
+ /* find the end of the string of digits */
+ while (isdigit((int) col[s1]) )
+ s1++;
+ }
+ else if (temp[t1] == '*')
+ {
+
+ /* save current string locations, in case we need to restart */
+ wildsearch = 1;
+ tsave = t1;
+ ssave = s1;
+
+ /* get next char from template and look for it in the col name */
+ t1++;
+ if (temp[t1] == '\0' || temp[t1] == ' ')
+ {
+ /* reached end of template so strings match */
+ *match = TRUE;
+ return;
+ }
+
+ found = FALSE;
+ while (col[s1] && !found)
+ {
+ if (temp[t1] == col[s1])
+ {
+ t1++; /* found matching characters; incre both pointers */
+ s1++; /* and loop back to compare next chars */
+ found = TRUE;
+ }
+ else
+ s1++; /* increment the column name pointer and try again */
+ }
+
+ if (!found)
+ {
+ return; /* hit end of column name and failed to find a match */
+ }
+ }
+ else
+ {
+ if (wildsearch)
+ {
+ /*
+ the previous wildcard search may have been going down
+ a blind alley. Backtrack, and resume the wildcard
+ search with the next character in the string.
+ */
+ t1 = tsave;
+ s1 = ssave + 1;
+ }
+ else
+ {
+ return; /* strings don't match */
+ }
+ }
+ }
+}
+/*--------------------------------------------------------------------------*/
+int ffgtcl( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ int *typecode, /* O - datatype code (21 = short, etc) */
+ long *repeat, /* O - repeat count of field */
+ long *width, /* O - if ASCII, width of field or unit string */
+ int *status) /* IO - error status */
+/*
+ Get Type of table column.
+ Returns the datatype code of the column, as well as the vector
+ repeat count and (if it is an ASCII character column) the
+ width of the field or a unit string within the field. This supports the
+ TFORMn = 'rAw' syntax for specifying arrays of substrings, so
+ if TFORMn = '60A12' then repeat = 60 and width = 12.
+*/
+{
+ LONGLONG trepeat, twidth;
+
+ ffgtclll(fptr, colnum, typecode, &trepeat, &twidth, status);
+
+ if (*status > 0)
+ return(*status);
+
+ if (repeat)
+ *repeat= (long) trepeat;
+
+ if (width)
+ *width = (long) twidth;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtclll( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ int *typecode, /* O - datatype code (21 = short, etc) */
+ LONGLONG *repeat, /* O - repeat count of field */
+ LONGLONG *width, /* O - if ASCII, width of field or unit string */
+ int *status) /* IO - error status */
+/*
+ Get Type of table column.
+ Returns the datatype code of the column, as well as the vector
+ repeat count and (if it is an ASCII character column) the
+ width of the field or a unit string within the field. This supports the
+ TFORMn = 'rAw' syntax for specifying arrays of substrings, so
+ if TFORMn = '60A12' then repeat = 60 and width = 12.
+*/
+{
+ tcolumn *colptr;
+ int hdutype, decims;
+ long tmpwidth;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+ return(*status = BAD_COL_NUM);
+
+ colptr = (fptr->Fptr)->tableptr; /* pointer to first column */
+ colptr += (colnum - 1); /* offset to correct column */
+
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == ASCII_TBL)
+ {
+ ffasfm(colptr->tform, typecode, &tmpwidth, &decims, status);
+ *width = tmpwidth;
+
+ if (repeat)
+ *repeat = 1;
+ }
+ else
+ {
+ if (typecode)
+ *typecode = colptr->tdatatype;
+
+ if (width)
+ *width = colptr->twidth;
+
+ if (repeat)
+ *repeat = colptr->trepeat;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffeqty( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ int *typecode, /* O - datatype code (21 = short, etc) */
+ long *repeat, /* O - repeat count of field */
+ long *width, /* O - if ASCII, width of field or unit string */
+ int *status) /* IO - error status */
+/*
+ Get the 'equivalent' table column type.
+
+ This routine is similar to the ffgtcl routine (which returns the physical
+ datatype of the column, as stored in the FITS file) except that if the
+ TSCALn and TZEROn keywords are defined for the column, then it returns
+ the 'equivalent' datatype. Thus, if the column is defined as '1I' (short
+ integer) this routine may return the type as 'TUSHORT' or as 'TFLOAT'
+ depending on the TSCALn and TZEROn values.
+
+ Returns the datatype code of the column, as well as the vector
+ repeat count and (if it is an ASCII character column) the
+ width of the field or a unit string within the field. This supports the
+ TFORMn = 'rAw' syntax for specifying arrays of substrings, so
+ if TFORMn = '60A12' then repeat = 60 and width = 12.
+*/
+{
+ LONGLONG trepeat, twidth;
+
+ ffeqtyll(fptr, colnum, typecode, &trepeat, &twidth, status);
+
+ if (repeat)
+ *repeat= (long) trepeat;
+
+ if (width)
+ *width = (long) twidth;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffeqtyll( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ int *typecode, /* O - datatype code (21 = short, etc) */
+ LONGLONG *repeat, /* O - repeat count of field */
+ LONGLONG *width, /* O - if ASCII, width of field or unit string */
+ int *status) /* IO - error status */
+/*
+ Get the 'equivalent' table column type.
+
+ This routine is similar to the ffgtcl routine (which returns the physical
+ datatype of the column, as stored in the FITS file) except that if the
+ TSCALn and TZEROn keywords are defined for the column, then it returns
+ the 'equivalent' datatype. Thus, if the column is defined as '1I' (short
+ integer) this routine may return the type as 'TUSHORT' or as 'TFLOAT'
+ depending on the TSCALn and TZEROn values.
+
+ Returns the datatype code of the column, as well as the vector
+ repeat count and (if it is an ASCII character column) the
+ width of the field or a unit string within the field. This supports the
+ TFORMn = 'rAw' syntax for specifying arrays of substrings, so
+ if TFORMn = '60A12' then repeat = 60 and width = 12.
+*/
+{
+ tcolumn *colptr;
+ int hdutype, decims, tcode, effcode;
+ double tscale, tzero, min_val, max_val;
+ long lngscale, lngzero = 0, tmpwidth;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+ return(*status = BAD_COL_NUM);
+
+ colptr = (fptr->Fptr)->tableptr; /* pointer to first column */
+ colptr += (colnum - 1); /* offset to correct column */
+
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == ASCII_TBL)
+ {
+ ffasfm(colptr->tform, typecode, &tmpwidth, &decims, status);
+ *width = tmpwidth;
+
+ if (repeat)
+ *repeat = 1;
+ }
+ else
+ {
+ if (typecode)
+ *typecode = colptr->tdatatype;
+
+ if (width)
+ *width = colptr->twidth;
+
+ if (repeat)
+ *repeat = colptr->trepeat;
+ }
+
+ /* return if caller is not interested in the typecode value */
+ if (!typecode)
+ return(*status);
+
+ /* check if the tscale and tzero keywords are defined, which might
+ change the effective datatype of the column */
+
+ tscale = colptr->tscale;
+ tzero = colptr->tzero;
+
+ if (tscale == 1.0 && tzero == 0.0) /* no scaling */
+ return(*status);
+
+ tcode = abs(*typecode);
+
+ switch (tcode)
+ {
+ case TBYTE: /* binary table 'rB' column */
+ min_val = 0.;
+ max_val = 255.0;
+ break;
+
+ case TSHORT:
+ min_val = -32768.0;
+ max_val = 32767.0;
+ break;
+
+ case TLONG:
+
+ min_val = -2147483648.0;
+ max_val = 2147483647.0;
+ break;
+
+ default: /* don't have to deal with other data types */
+ return(*status);
+ }
+
+ if (tscale >= 0.) {
+ min_val = tzero + tscale * min_val;
+ max_val = tzero + tscale * max_val;
+ } else {
+ max_val = tzero + tscale * min_val;
+ min_val = tzero + tscale * max_val;
+ }
+ if (tzero < 2147483648.) /* don't exceed range of 32-bit integer */
+ lngzero = (long) tzero;
+ lngscale = (long) tscale;
+
+ if ((tzero != 2147483648.) && /* special value that exceeds integer range */
+ (lngzero != tzero || lngscale != tscale)) { /* not integers? */
+ /* floating point scaled values; just decide on required precision */
+ if (tcode == TBYTE || tcode == TSHORT)
+ effcode = TFLOAT;
+ else
+ effcode = TDOUBLE;
+
+ /*
+ In all the remaining cases, TSCALn and TZEROn are integers,
+ and not equal to 1 and 0, respectively.
+ */
+
+ } else if ((min_val == -128.) && (max_val == 127.)) {
+ effcode = TSBYTE;
+
+ } else if ((min_val >= -32768.0) && (max_val <= 32767.0)) {
+ effcode = TSHORT;
+
+ } else if ((min_val >= 0.0) && (max_val <= 65535.0)) {
+ effcode = TUSHORT;
+
+ } else if ((min_val >= -2147483648.0) && (max_val <= 2147483647.0)) {
+ effcode = TLONG;
+
+ } else if ((min_val >= 0.0) && (max_val < 4294967296.0)) {
+ effcode = TULONG;
+
+ } else { /* exceeds the range of a 32-bit integer */
+ effcode = TDOUBLE;
+ }
+
+ /* return the effective datatype code (negative if variable length col.) */
+ if (*typecode < 0) /* variable length array column */
+ *typecode = -effcode;
+ else
+ *typecode = effcode;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgncl( fitsfile *fptr, /* I - FITS file pointer */
+ int *ncols, /* O - number of columns in the table */
+ int *status) /* IO - error status */
+/*
+ Get the number of columns in the table (= TFIELDS keyword)
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ return(*status = NOT_TABLE);
+
+ *ncols = (fptr->Fptr)->tfield;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgnrw( fitsfile *fptr, /* I - FITS file pointer */
+ long *nrows, /* O - number of rows in the table */
+ int *status) /* IO - error status */
+/*
+ Get the number of rows in the table (= NAXIS2 keyword)
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ return(*status = NOT_TABLE);
+
+ /* the NAXIS2 keyword may not be up to date, so use the structure value */
+ *nrows = (long) (fptr->Fptr)->numrows;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgnrwll( fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG *nrows, /* O - number of rows in the table */
+ int *status) /* IO - error status */
+/*
+ Get the number of rows in the table (= NAXIS2 keyword)
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ return(*status = NOT_TABLE);
+
+ /* the NAXIS2 keyword may not be up to date, so use the structure value */
+ *nrows = (fptr->Fptr)->numrows;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgacl( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ char *ttype, /* O - TTYPEn keyword value */
+ long *tbcol, /* O - TBCOLn keyword value */
+ char *tunit, /* O - TUNITn keyword value */
+ char *tform, /* O - TFORMn keyword value */
+ double *tscal, /* O - TSCALn keyword value */
+ double *tzero, /* O - TZEROn keyword value */
+ char *tnull, /* O - TNULLn keyword value */
+ char *tdisp, /* O - TDISPn keyword value */
+ int *status) /* IO - error status */
+/*
+ get ASCII column keyword values
+*/
+{
+ char name[FLEN_KEYWORD], comm[FLEN_COMMENT];
+ tcolumn *colptr;
+ int tstatus;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+ return(*status = BAD_COL_NUM);
+
+ /* get what we can from the column structure */
+
+ colptr = (fptr->Fptr)->tableptr; /* pointer to first column */
+ colptr += (colnum -1); /* offset to correct column */
+
+ if (ttype)
+ strcpy(ttype, colptr->ttype);
+
+ if (tbcol)
+ *tbcol = (long) ((colptr->tbcol) + 1); /* first col is 1, not 0 */
+
+ if (tform)
+ strcpy(tform, colptr->tform);
+
+ if (tscal)
+ *tscal = colptr->tscale;
+
+ if (tzero)
+ *tzero = colptr->tzero;
+
+ if (tnull)
+ strcpy(tnull, colptr->strnull);
+
+ /* read keywords to get additional parameters */
+
+ if (tunit)
+ {
+ ffkeyn("TUNIT", colnum, name, status);
+ tstatus = 0;
+ *tunit = '\0';
+ ffgkys(fptr, name, tunit, comm, &tstatus);
+ }
+
+ if (tdisp)
+ {
+ ffkeyn("TDISP", colnum, name, status);
+ tstatus = 0;
+ *tdisp = '\0';
+ ffgkys(fptr, name, tdisp, comm, &tstatus);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgbcl( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ char *ttype, /* O - TTYPEn keyword value */
+ char *tunit, /* O - TUNITn keyword value */
+ char *dtype, /* O - datatype char: I, J, E, D, etc. */
+ long *repeat, /* O - vector column repeat count */
+ double *tscal, /* O - TSCALn keyword value */
+ double *tzero, /* O - TZEROn keyword value */
+ long *tnull, /* O - TNULLn keyword value integer cols only */
+ char *tdisp, /* O - TDISPn keyword value */
+ int *status) /* IO - error status */
+/*
+ get BINTABLE column keyword values
+*/
+{
+ LONGLONG trepeat, ttnull;
+
+ if (*status > 0)
+ return(*status);
+
+ ffgbclll(fptr, colnum, ttype, tunit, dtype, &trepeat, tscal, tzero,
+ &ttnull, tdisp, status);
+
+ if (repeat)
+ *repeat = (long) trepeat;
+
+ if (tnull)
+ *tnull = (long) ttnull;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgbclll( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ char *ttype, /* O - TTYPEn keyword value */
+ char *tunit, /* O - TUNITn keyword value */
+ char *dtype, /* O - datatype char: I, J, E, D, etc. */
+ LONGLONG *repeat, /* O - vector column repeat count */
+ double *tscal, /* O - TSCALn keyword value */
+ double *tzero, /* O - TZEROn keyword value */
+ LONGLONG *tnull, /* O - TNULLn keyword value integer cols only */
+ char *tdisp, /* O - TDISPn keyword value */
+ int *status) /* IO - error status */
+/*
+ get BINTABLE column keyword values
+*/
+{
+ char name[FLEN_KEYWORD], comm[FLEN_COMMENT];
+ tcolumn *colptr;
+ int tstatus;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+ return(*status = BAD_COL_NUM);
+
+ /* get what we can from the column structure */
+
+ colptr = (fptr->Fptr)->tableptr; /* pointer to first column */
+ colptr += (colnum -1); /* offset to correct column */
+
+ if (ttype)
+ strcpy(ttype, colptr->ttype);
+
+ if (dtype)
+ {
+ if (colptr->tdatatype < 0) /* add the "P" prefix for */
+ strcpy(dtype, "P"); /* variable length columns */
+ else
+ dtype[0] = 0;
+
+ if (abs(colptr->tdatatype) == TBIT)
+ strcat(dtype, "X");
+ else if (abs(colptr->tdatatype) == TBYTE)
+ strcat(dtype, "B");
+ else if (abs(colptr->tdatatype) == TLOGICAL)
+ strcat(dtype, "L");
+ else if (abs(colptr->tdatatype) == TSTRING)
+ strcat(dtype, "A");
+ else if (abs(colptr->tdatatype) == TSHORT)
+ strcat(dtype, "I");
+ else if (abs(colptr->tdatatype) == TLONG)
+ strcat(dtype, "J");
+ else if (abs(colptr->tdatatype) == TLONGLONG)
+ strcat(dtype, "K");
+ else if (abs(colptr->tdatatype) == TFLOAT)
+ strcat(dtype, "E");
+ else if (abs(colptr->tdatatype) == TDOUBLE)
+ strcat(dtype, "D");
+ else if (abs(colptr->tdatatype) == TCOMPLEX)
+ strcat(dtype, "C");
+ else if (abs(colptr->tdatatype) == TDBLCOMPLEX)
+ strcat(dtype, "M");
+ }
+
+ if (repeat)
+ *repeat = colptr->trepeat;
+
+ if (tscal)
+ *tscal = colptr->tscale;
+
+ if (tzero)
+ *tzero = colptr->tzero;
+
+ if (tnull)
+ *tnull = colptr->tnull;
+
+ /* read keywords to get additional parameters */
+
+ if (tunit)
+ {
+ ffkeyn("TUNIT", colnum, name, status);
+ tstatus = 0;
+ *tunit = '\0';
+ ffgkys(fptr, name, tunit, comm, &tstatus);
+ }
+
+ if (tdisp)
+ {
+ ffkeyn("TDISP", colnum, name, status);
+ tstatus = 0;
+ *tdisp = '\0';
+ ffgkys(fptr, name, tdisp, comm, &tstatus);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghdn(fitsfile *fptr, /* I - FITS file pointer */
+ int *chdunum) /* O - number of the CHDU; 1 = primary array */
+/*
+ Return the number of the Current HDU in the FITS file. The primary array
+ is HDU number 1. Note that this is one of the few cfitsio routines that
+ does not return the error status value as the value of the function.
+*/
+{
+ *chdunum = (fptr->HDUposition) + 1;
+ return(*chdunum);
+}
+/*--------------------------------------------------------------------------*/
+int ffghadll(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG *headstart, /* O - byte offset to beginning of CHDU */
+ LONGLONG *datastart, /* O - byte offset to beginning of next HDU */
+ LONGLONG *dataend, /* O - byte offset to beginning of next HDU */
+ int *status) /* IO - error status */
+/*
+ Return the address (= byte offset) in the FITS file to the beginning of
+ the current HDU, the beginning of the data unit, and the end of the data unit.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ if (ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status) > 0)
+ return(*status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if (ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ if (headstart)
+ *headstart = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu];
+
+ if (datastart)
+ *datastart = (fptr->Fptr)->datastart;
+
+ if (dataend)
+ *dataend = (fptr->Fptr)->headstart[((fptr->Fptr)->curhdu) + 1];
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghof(fitsfile *fptr, /* I - FITS file pointer */
+ OFF_T *headstart, /* O - byte offset to beginning of CHDU */
+ OFF_T *datastart, /* O - byte offset to beginning of next HDU */
+ OFF_T *dataend, /* O - byte offset to beginning of next HDU */
+ int *status) /* IO - error status */
+/*
+ Return the address (= byte offset) in the FITS file to the beginning of
+ the current HDU, the beginning of the data unit, and the end of the data unit.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ if (ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status) > 0)
+ return(*status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if (ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ if (headstart)
+ *headstart = (OFF_T) (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu];
+
+ if (datastart)
+ *datastart = (OFF_T) (fptr->Fptr)->datastart;
+
+ if (dataend)
+ *dataend = (OFF_T) (fptr->Fptr)->headstart[((fptr->Fptr)->curhdu) + 1];
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghad(fitsfile *fptr, /* I - FITS file pointer */
+ long *headstart, /* O - byte offset to beginning of CHDU */
+ long *datastart, /* O - byte offset to beginning of next HDU */
+ long *dataend, /* O - byte offset to beginning of next HDU */
+ int *status) /* IO - error status */
+/*
+ Return the address (= byte offset) in the FITS file to the beginning of
+ the current HDU, the beginning of the data unit, and the end of the data unit.
+*/
+{
+ LONGLONG shead, sdata, edata;
+
+ if (*status > 0)
+ return(*status);
+
+ ffghadll(fptr, &shead, &sdata, &edata, status);
+
+ if (headstart)
+ {
+ if (shead > LONG_MAX)
+ *status = NUM_OVERFLOW;
+ else
+ *headstart = (long) shead;
+ }
+
+ if (datastart)
+ {
+ if (sdata > LONG_MAX)
+ *status = NUM_OVERFLOW;
+ else
+ *datastart = (long) sdata;
+ }
+
+ if (dataend)
+ {
+ if (edata > LONG_MAX)
+ *status = NUM_OVERFLOW;
+ else
+ *dataend = (long) edata;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffrhdu(fitsfile *fptr, /* I - FITS file pointer */
+ int *hdutype, /* O - type of HDU */
+ int *status) /* IO - error status */
+/*
+ read the required keywords of the CHDU and initialize the corresponding
+ structure elements that describe the format of the HDU
+*/
+{
+ int ii, tstatus;
+ char card[FLEN_CARD];
+ char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
+ char xname[FLEN_VALUE], *xtension, urltype[20];
+
+ if (*status > 0)
+ return(*status);
+
+ if (ffgrec(fptr, 1, card, status) > 0 ) /* get the 80-byte card */
+ {
+ ffpmsg("Cannot read first keyword in header (ffrhdu).");
+ return(*status);
+ }
+ strncpy(name,card,8); /* first 8 characters = the keyword name */
+ name[8] = '\0';
+
+ for (ii=7; ii >= 0; ii--) /* replace trailing blanks with nulls */
+ {
+ if (name[ii] == ' ')
+ name[ii] = '\0';
+ else
+ break;
+ }
+
+ if (ffpsvc(card, value, comm, status) > 0) /* parse value and comment */
+ {
+ ffpmsg("Cannot read value of first keyword in header (ffrhdu):");
+ ffpmsg(card);
+ return(*status);
+ }
+
+ if (!strcmp(name, "SIMPLE")) /* this is the primary array */
+ {
+
+ ffpinit(fptr, status); /* initialize the primary array */
+
+ if (hdutype != NULL)
+ *hdutype = 0;
+ }
+
+ else if (!strcmp(name, "XTENSION")) /* this is an XTENSION keyword */
+ {
+ if (ffc2s(value, xname, status) > 0) /* get the value string */
+ {
+ ffpmsg("Bad value string for XTENSION keyword:");
+ ffpmsg(value);
+ return(*status);
+ }
+
+ xtension = xname;
+ while (*xtension == ' ') /* ignore any leading spaces in name */
+ xtension++;
+
+ if (!strcmp(xtension, "TABLE"))
+ {
+ ffainit(fptr, status); /* initialize the ASCII table */
+ if (hdutype != NULL)
+ *hdutype = 1;
+ }
+
+ else if (!strcmp(xtension, "BINTABLE") ||
+ !strcmp(xtension, "A3DTABLE") ||
+ !strcmp(xtension, "3DTABLE") )
+ {
+ ffbinit(fptr, status); /* initialize the binary table */
+ if (hdutype != NULL)
+ *hdutype = 2;
+ }
+
+ else
+ {
+ tstatus = 0;
+ ffpinit(fptr, &tstatus); /* probably an IMAGE extension */
+
+ if (tstatus == UNKNOWN_EXT && hdutype != NULL)
+ *hdutype = -1; /* don't recognize this extension type */
+ else
+ {
+ *status = tstatus;
+ if (hdutype != NULL)
+ *hdutype = 0;
+ }
+ }
+ }
+
+ else /* not the start of a new extension */
+ {
+ if (card[0] == 0 ||
+ card[0] == 10) /* some editors append this character to EOF */
+ {
+ *status = END_OF_FILE;
+ }
+ else
+ {
+ *status = UNKNOWN_REC; /* found unknown type of record */
+ ffpmsg
+ ("Extension doesn't start with SIMPLE or XTENSION keyword. (ffrhdu)");
+ ffpmsg(card);
+ }
+ }
+
+ /* compare the starting position of the next HDU (if any) with the size */
+ /* of the whole file to see if this is the last HDU in the file */
+
+ if ((fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] <
+ (fptr->Fptr)->logfilesize )
+ {
+ (fptr->Fptr)->lasthdu = 0; /* no, not the last HDU */
+ }
+ else
+ {
+ (fptr->Fptr)->lasthdu = 1; /* yes, this is the last HDU */
+
+ /* special code for mem:// type files (FITS file in memory) */
+ /* Allocate enough memory to hold the entire HDU. */
+ /* Without this code, CFITSIO would repeatedly realloc memory */
+ /* to incrementally increase the size of the file by 2880 bytes */
+ /* at a time, until it reached the final size */
+
+ ffurlt(fptr, urltype, status);
+ if (!strcmp(urltype,"mem://") || !strcmp(urltype,"memkeep://"))
+ {
+ fftrun(fptr, (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1],
+ status);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpinit(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ initialize the parameters defining the structure of the primary array
+ or an Image extension
+*/
+{
+ int groups, tstatus, simple, bitpix, naxis, extend, nspace;
+ int ttype = 0, bytlen = 0, ii;
+ long pcount, gcount;
+ LONGLONG naxes[999], npix, blank;
+ double bscale, bzero;
+ char comm[FLEN_COMMENT];
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ (fptr->Fptr)->hdutype = IMAGE_HDU; /* primary array or IMAGE extension */
+ (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize; /* set max size */
+
+ groups = 0;
+ tstatus = *status;
+
+ /* get all the descriptive info about this HDU */
+ ffgphd(fptr, 999, &simple, &bitpix, &naxis, naxes, &pcount, &gcount,
+ &extend, &bscale, &bzero, &blank, &nspace, status);
+
+ if (*status == NOT_IMAGE)
+ *status = tstatus; /* ignore 'unknown extension type' error */
+ else if (*status > 0)
+ return(*status);
+
+ /*
+ the logical end of the header is 80 bytes before the current position,
+ minus any trailing blank keywords just before the END keyword.
+ */
+ (fptr->Fptr)->headend = (fptr->Fptr)->nextkey - (80 * (nspace + 1));
+
+ /* the data unit begins at the beginning of the next logical block */
+ (fptr->Fptr)->datastart = (((fptr->Fptr)->nextkey - 80) / 2880 + 1)
+ * 2880;
+
+ if (naxis > 0 && naxes[0] == 0) /* test for 'random groups' */
+ {
+ tstatus = 0;
+ ffmaky(fptr, 2, status); /* reset to beginning of header */
+
+ if (ffgkyl(fptr, "GROUPS", &groups, comm, &tstatus))
+ groups = 0; /* GROUPS keyword not found */
+ }
+
+ if (bitpix == BYTE_IMG) /* test bitpix and set the datatype code */
+ {
+ ttype=TBYTE;
+ bytlen=1;
+ }
+ else if (bitpix == SHORT_IMG)
+ {
+ ttype=TSHORT;
+ bytlen=2;
+ }
+ else if (bitpix == LONG_IMG)
+ {
+ ttype=TLONG;
+ bytlen=4;
+ }
+ else if (bitpix == LONGLONG_IMG)
+ {
+ ttype=TLONGLONG;
+ bytlen=8;
+ }
+ else if (bitpix == FLOAT_IMG)
+ {
+ ttype=TFLOAT;
+ bytlen=4;
+ }
+ else if (bitpix == DOUBLE_IMG)
+ {
+ ttype=TDOUBLE;
+ bytlen=8;
+ }
+
+ /* calculate the size of the primary array */
+ (fptr->Fptr)->imgdim = naxis;
+ if (naxis == 0)
+ {
+ npix = 0;
+ }
+ else
+ {
+ if (groups)
+ {
+ npix = 1; /* NAXIS1 = 0 is a special flag for 'random groups' */
+ }
+ else
+ {
+ npix = naxes[0];
+ }
+
+ (fptr->Fptr)->imgnaxis[0] = naxes[0];
+ for (ii=1; ii < naxis; ii++)
+ {
+ npix = npix*naxes[ii]; /* calc number of pixels in the array */
+ (fptr->Fptr)->imgnaxis[ii] = naxes[ii];
+ }
+ }
+
+ /*
+ now we know everything about the array; just fill in the parameters:
+ the next HDU begins in the next logical block after the data
+ */
+
+ (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] =
+ (fptr->Fptr)->datastart +
+ ( ((LONGLONG) pcount + npix) * bytlen * gcount + 2879) / 2880 * 2880;
+
+ /*
+ initialize the fictitious heap starting address (immediately following
+ the array data) and a zero length heap. This is used to find the
+ end of the data when checking the fill values in the last block.
+ */
+ (fptr->Fptr)->heapstart = (npix + pcount) * bytlen * gcount;
+ (fptr->Fptr)->heapsize = 0;
+
+ (fptr->Fptr)->compressimg = 0; /* this is not a compressed image */
+
+ if (naxis == 0)
+ {
+ (fptr->Fptr)->rowlength = 0; /* rows have zero length */
+ (fptr->Fptr)->tfield = 0; /* table has no fields */
+
+ /* free the tile-compressed image cache, if it exists */
+ if ((fptr->Fptr)->tiledata) {
+ free((fptr->Fptr)->tiledata);
+ (fptr->Fptr)->tiledata = 0;
+ (fptr->Fptr)->tilerow = 0;
+ (fptr->Fptr)->tiledatasize = 0;
+ (fptr->Fptr)->tiletype = 0;
+ }
+
+ if ((fptr->Fptr)->tilenullarray) {
+ free((fptr->Fptr)->tilenullarray);
+ (fptr->Fptr)->tilenullarray = 0;
+ }
+
+ if ((fptr->Fptr)->tableptr)
+ free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */
+
+ (fptr->Fptr)->tableptr = 0; /* set a null table structure pointer */
+ (fptr->Fptr)->numrows = 0;
+ (fptr->Fptr)->origrows = 0;
+ }
+ else
+ {
+ /*
+ The primary array is actually interpreted as a binary table. There
+ are two columns: the first column contains the group parameters if any.
+ The second column contains the primary array of data as a single vector
+ column element. In the case of 'random grouped' format, each group
+ is stored in a separate row of the table.
+ */
+ /* the number of rows is equal to the number of groups */
+ (fptr->Fptr)->numrows = gcount;
+ (fptr->Fptr)->origrows = gcount;
+
+ (fptr->Fptr)->rowlength = (npix + pcount) * bytlen; /* total size */
+ (fptr->Fptr)->tfield = 2; /* 2 fields: group params and the image */
+
+ /* free the tile-compressed image cache, if it exists */
+
+ /* free the tile-compressed image cache, if it exists */
+ if ((fptr->Fptr)->tiledata) {
+ free((fptr->Fptr)->tiledata);
+ (fptr->Fptr)->tiledata = 0;
+ (fptr->Fptr)->tilerow = 0;
+ (fptr->Fptr)->tiledatasize = 0;
+ (fptr->Fptr)->tiletype = 0;
+ }
+
+ if ((fptr->Fptr)->tilenullarray) {
+ free((fptr->Fptr)->tilenullarray);
+ (fptr->Fptr)->tilenullarray = 0;
+ }
+
+ if ((fptr->Fptr)->tableptr)
+ free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */
+
+ colptr = (tcolumn *) calloc(2, sizeof(tcolumn) ) ;
+
+ if (!colptr)
+ {
+ ffpmsg
+ ("malloc failed to get memory for FITS array descriptors (ffpinit)");
+ (fptr->Fptr)->tableptr = 0; /* set a null table structure pointer */
+ return(*status = ARRAY_TOO_BIG);
+ }
+
+ /* copy the table structure address to the fitsfile structure */
+ (fptr->Fptr)->tableptr = colptr;
+
+ /* the first column represents the group parameters, if any */
+ colptr->tbcol = 0;
+ colptr->tdatatype = ttype;
+ colptr->twidth = bytlen;
+ colptr->trepeat = (LONGLONG) pcount;
+ colptr->tscale = 1.;
+ colptr->tzero = 0.;
+ colptr->tnull = blank;
+
+ colptr++; /* increment pointer to the second column */
+
+ /* the second column represents the image array */
+ colptr->tbcol = pcount * bytlen; /* col starts after the group parms */
+ colptr->tdatatype = ttype;
+ colptr->twidth = bytlen;
+ colptr->trepeat = npix;
+ colptr->tscale = bscale;
+ colptr->tzero = bzero;
+ colptr->tnull = blank;
+ }
+
+ /* reset next keyword pointer to the start of the header */
+ (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu ];
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffainit(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+{
+/*
+ initialize the parameters defining the structure of an ASCII table
+*/
+ int ii, nspace;
+ long tfield;
+ LONGLONG pcount, rowlen, nrows, tbcoln;
+ tcolumn *colptr = 0;
+ char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
+ char message[FLEN_ERRMSG], errmsg[81];
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ (fptr->Fptr)->hdutype = ASCII_TBL; /* set that this is an ASCII table */
+ (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize; /* set max size */
+
+ /* get table parameters and test that the header is a valid: */
+ if (ffgttb(fptr, &rowlen, &nrows, &pcount, &tfield, status) > 0)
+ return(*status);
+
+ if (pcount != 0)
+ {
+ ffpmsg("PCOUNT keyword not equal to 0 in ASCII table (ffainit).");
+ sprintf(errmsg, " PCOUNT = %ld", (long) pcount);
+ ffpmsg(errmsg);
+ return(*status = BAD_PCOUNT);
+ }
+
+ (fptr->Fptr)->rowlength = rowlen; /* store length of a row */
+ (fptr->Fptr)->tfield = tfield; /* store number of table fields in row */
+
+ /* free the tile-compressed image cache, if it exists */
+ if ((fptr->Fptr)->tiledata) {
+ free((fptr->Fptr)->tiledata);
+ (fptr->Fptr)->tiledata = 0;
+ (fptr->Fptr)->tilerow = 0;
+ (fptr->Fptr)->tiledatasize = 0;
+ (fptr->Fptr)->tiletype = 0;
+ }
+
+ if ((fptr->Fptr)->tilenullarray) {
+ free((fptr->Fptr)->tilenullarray);
+ (fptr->Fptr)->tilenullarray = 0;
+ }
+
+
+ if ((fptr->Fptr)->tableptr)
+ free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */
+
+ /* mem for column structures ; space is initialized = 0 */
+ if (tfield > 0)
+ {
+ colptr = (tcolumn *) calloc(tfield, sizeof(tcolumn) );
+ if (!colptr)
+ {
+ ffpmsg
+ ("malloc failed to get memory for FITS table descriptors (ffainit)");
+ (fptr->Fptr)->tableptr = 0; /* set a null table structure pointer */
+ return(*status = ARRAY_TOO_BIG);
+ }
+ }
+
+ /* copy the table structure address to the fitsfile structure */
+ (fptr->Fptr)->tableptr = colptr;
+
+ /* initialize the table field parameters */
+ for (ii = 0; ii < tfield; ii++, colptr++)
+ {
+ colptr->ttype[0] = '\0'; /* null column name */
+ colptr->tscale = 1.;
+ colptr->tzero = 0.;
+ colptr->strnull[0] = ASCII_NULL_UNDEFINED; /* null value undefined */
+ colptr->tbcol = -1; /* initialize to illegal value */
+ colptr->tdatatype = -9999; /* initialize to illegal value */
+ }
+
+ /*
+ Initialize the fictitious heap starting address (immediately following
+ the table data) and a zero length heap. This is used to find the
+ end of the table data when checking the fill values in the last block.
+ There is no special data following an ASCII table.
+ */
+ (fptr->Fptr)->numrows = nrows;
+ (fptr->Fptr)->origrows = nrows;
+ (fptr->Fptr)->heapstart = rowlen * nrows;
+ (fptr->Fptr)->heapsize = 0;
+
+ (fptr->Fptr)->compressimg = 0; /* this is not a compressed image */
+
+ /* now search for the table column keywords and the END keyword */
+
+ for (nspace = 0, ii = 8; 1; ii++) /* infinite loop */
+ {
+ ffgkyn(fptr, ii, name, value, comm, status);
+
+ /* try to ignore minor syntax errors */
+ if (*status == NO_QUOTE)
+ {
+ strcat(value, "'");
+ *status = 0;
+ }
+ else if (*status == BAD_KEYCHAR)
+ {
+ *status = 0;
+ }
+
+ if (*status == END_OF_FILE)
+ {
+ ffpmsg("END keyword not found in ASCII table header (ffainit).");
+ return(*status = NO_END);
+ }
+ else if (*status > 0)
+ return(*status);
+
+ else if (name[0] == 'T') /* keyword starts with 'T' ? */
+ ffgtbp(fptr, name, value, status); /* test if column keyword */
+
+ else if (!FSTRCMP(name, "END")) /* is this the END keyword? */
+ break;
+
+ if (!name[0] && !value[0] && !comm[0]) /* a blank keyword? */
+ nspace++;
+
+ else
+ nspace = 0;
+ }
+
+ /* test that all required keywords were found and have legal values */
+ colptr = (fptr->Fptr)->tableptr;
+ for (ii = 0; ii < tfield; ii++, colptr++)
+ {
+ tbcoln = colptr->tbcol; /* the starting column number (zero based) */
+
+ if (colptr->tdatatype == -9999)
+ {
+ ffkeyn("TFORM", ii+1, name, status); /* construct keyword name */
+ sprintf(message,"Required %s keyword not found (ffainit).", name);
+ ffpmsg(message);
+ return(*status = NO_TFORM);
+ }
+
+ else if (tbcoln == -1)
+ {
+ ffkeyn("TBCOL", ii+1, name, status); /* construct keyword name */
+ sprintf(message,"Required %s keyword not found (ffainit).", name);
+ ffpmsg(message);
+ return(*status = NO_TBCOL);
+ }
+
+ else if ((fptr->Fptr)->rowlength != 0 &&
+ (tbcoln < 0 || tbcoln >= (fptr->Fptr)->rowlength ) )
+ {
+ ffkeyn("TBCOL", ii+1, name, status); /* construct keyword name */
+ sprintf(message,"Value of %s keyword out of range: %ld (ffainit).",
+ name, (long) tbcoln);
+ ffpmsg(message);
+ return(*status = BAD_TBCOL);
+ }
+
+ else if ((fptr->Fptr)->rowlength != 0 &&
+ tbcoln + colptr->twidth > (fptr->Fptr)->rowlength )
+ {
+ sprintf(message,"Column %d is too wide to fit in table (ffainit)",
+ ii+1);
+ ffpmsg(message);
+ sprintf(message, " TFORM = %s and NAXIS1 = %ld",
+ colptr->tform, (long) (fptr->Fptr)->rowlength);
+ ffpmsg(message);
+ return(*status = COL_TOO_WIDE);
+ }
+ }
+
+ /*
+ now we know everything about the table; just fill in the parameters:
+ the 'END' record is 80 bytes before the current position, minus
+ any trailing blank keywords just before the END keyword.
+ */
+ (fptr->Fptr)->headend = (fptr->Fptr)->nextkey - (80 * (nspace + 1));
+
+ /* the data unit begins at the beginning of the next logical block */
+ (fptr->Fptr)->datastart = (((fptr->Fptr)->nextkey - 80) / 2880 + 1)
+ * 2880;
+
+ /* the next HDU begins in the next logical block after the data */
+ (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] =
+ (fptr->Fptr)->datastart +
+ ( ((LONGLONG)rowlen * nrows + 2879) / 2880 * 2880 );
+
+ /* reset next keyword pointer to the start of the header */
+ (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu ];
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffbinit(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+{
+/*
+ initialize the parameters defining the structure of a binary table
+*/
+ int ii, nspace;
+ long tfield;
+ LONGLONG pcount, rowlen, nrows, totalwidth;
+ tcolumn *colptr = 0;
+ char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
+ char message[FLEN_ERRMSG];
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ (fptr->Fptr)->hdutype = BINARY_TBL; /* set that this is a binary table */
+ (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize; /* set max size */
+
+ /* get table parameters and test that the header is valid: */
+ if (ffgttb(fptr, &rowlen, &nrows, &pcount, &tfield, status) > 0)
+ return(*status);
+
+ (fptr->Fptr)->rowlength = rowlen; /* store length of a row */
+ (fptr->Fptr)->tfield = tfield; /* store number of table fields in row */
+
+
+ /* free the tile-compressed image cache, if it exists */
+ if ((fptr->Fptr)->tiledata) {
+ free((fptr->Fptr)->tiledata);
+ (fptr->Fptr)->tiledata = 0;
+ (fptr->Fptr)->tilerow = 0;
+ (fptr->Fptr)->tiledatasize = 0;
+ (fptr->Fptr)->tiletype = 0;
+ }
+
+ if ((fptr->Fptr)->tilenullarray) {
+ free((fptr->Fptr)->tilenullarray);
+ (fptr->Fptr)->tilenullarray = 0;
+ }
+
+ if ((fptr->Fptr)->tableptr)
+ free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */
+
+ /* mem for column structures ; space is initialized = 0 */
+ if (tfield > 0)
+ {
+ colptr = (tcolumn *) calloc(tfield, sizeof(tcolumn) );
+ if (!colptr)
+ {
+ ffpmsg
+ ("malloc failed to get memory for FITS table descriptors (ffbinit)");
+ (fptr->Fptr)->tableptr = 0; /* set a null table structure pointer */
+ return(*status = ARRAY_TOO_BIG);
+ }
+ }
+
+ /* copy the table structure address to the fitsfile structure */
+ (fptr->Fptr)->tableptr = colptr;
+
+ /* initialize the table field parameters */
+ for (ii = 0; ii < tfield; ii++, colptr++)
+ {
+ colptr->ttype[0] = '\0'; /* null column name */
+ colptr->tscale = 1.;
+ colptr->tzero = 0.;
+ colptr->tnull = NULL_UNDEFINED; /* (integer) null value undefined */
+ colptr->tdatatype = -9999; /* initialize to illegal value */
+ colptr->trepeat = 1;
+ colptr->strnull[0] = '\0'; /* for ASCII string columns (TFORM = rA) */
+ }
+
+ /*
+ Initialize the heap starting address (immediately following
+ the table data) and the size of the heap. This is used to find the
+ end of the table data when checking the fill values in the last block.
+ */
+ (fptr->Fptr)->numrows = nrows;
+ (fptr->Fptr)->origrows = nrows;
+ (fptr->Fptr)->heapstart = rowlen * nrows;
+ (fptr->Fptr)->heapsize = pcount;
+
+ (fptr->Fptr)->compressimg = 0; /* initialize as not a compressed image */
+
+ /* now search for the table column keywords and the END keyword */
+
+ for (nspace = 0, ii = 8; 1; ii++) /* infinite loop */
+ {
+ ffgkyn(fptr, ii, name, value, comm, status);
+
+ /* try to ignore minor syntax errors */
+ if (*status == NO_QUOTE)
+ {
+ strcat(value, "'");
+ *status = 0;
+ }
+ else if (*status == BAD_KEYCHAR)
+ {
+ *status = 0;
+ }
+
+ if (*status == END_OF_FILE)
+ {
+ ffpmsg("END keyword not found in binary table header (ffbinit).");
+ return(*status = NO_END);
+ }
+ else if (*status > 0)
+ return(*status);
+
+ else if (name[0] == 'T') /* keyword starts with 'T' ? */
+ ffgtbp(fptr, name, value, status); /* test if column keyword */
+
+ else if (!FSTRCMP(name, "ZIMAGE"))
+ {
+ if (value[0] == 'T')
+ (fptr->Fptr)->compressimg = 1; /* this is a compressed image */
+ }
+ else if (!FSTRCMP(name, "END")) /* is this the END keyword? */
+ break;
+
+
+ if (!name[0] && !value[0] && !comm[0]) /* a blank keyword? */
+ nspace++;
+
+ else
+ nspace = 0; /* reset number of consecutive spaces before END */
+ }
+
+ /* test that all the required keywords were found and have legal values */
+ colptr = (fptr->Fptr)->tableptr; /* set pointer to first column */
+
+ for (ii = 0; ii < tfield; ii++, colptr++)
+ {
+ if (colptr->tdatatype == -9999)
+ {
+ ffkeyn("TFORM", ii+1, name, status); /* construct keyword name */
+ sprintf(message,"Required %s keyword not found (ffbinit).", name);
+ ffpmsg(message);
+ return(*status = NO_TFORM);
+ }
+ }
+
+ /*
+ now we know everything about the table; just fill in the parameters:
+ the 'END' record is 80 bytes before the current position, minus
+ any trailing blank keywords just before the END keyword.
+ */
+
+ (fptr->Fptr)->headend = (fptr->Fptr)->nextkey - (80 * (nspace + 1));
+
+ /* the data unit begins at the beginning of the next logical block */
+ (fptr->Fptr)->datastart = (((fptr->Fptr)->nextkey - 80) / 2880 + 1)
+ * 2880;
+
+ /* the next HDU begins in the next logical block after the data */
+ (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] =
+ (fptr->Fptr)->datastart +
+ ( (rowlen * nrows + pcount + 2879) / 2880 * 2880 );
+
+ /* determine the byte offset to the beginning of each column */
+ ffgtbc(fptr, &totalwidth, status);
+
+ if (totalwidth != rowlen)
+ {
+ sprintf(message,
+ "NAXIS1 = %ld is not equal to the sum of column widths: %ld",
+ (long) rowlen, (long) totalwidth);
+ ffpmsg(message);
+ *status = BAD_ROW_WIDTH;
+ }
+
+ /* reset next keyword pointer to the start of the header */
+ (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu ];
+
+ if ( (fptr->Fptr)->compressimg == 1) /* Is this a compressed image */
+ imcomp_get_compressed_image_par(fptr, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgabc(int tfields, /* I - number of columns in the table */
+ char **tform, /* I - value of TFORMn keyword for each column */
+ int space, /* I - number of spaces to leave between cols */
+ long *rowlen, /* O - total width of a table row */
+ long *tbcol, /* O - starting byte in row for each column */
+ int *status) /* IO - error status */
+/*
+ calculate the starting byte offset of each column of an ASCII table
+ and the total length of a row, in bytes. The input space value determines
+ how many blank spaces to leave between each column (1 is recommended).
+*/
+{
+ int ii, datacode, decims;
+ long width;
+
+ if (*status > 0)
+ return(*status);
+
+ *rowlen=0;
+
+ if (tfields <= 0)
+ return(*status);
+
+ tbcol[0] = 1;
+
+ for (ii = 0; ii < tfields; ii++)
+ {
+ tbcol[ii] = *rowlen + 1; /* starting byte in row of column */
+
+ ffasfm(tform[ii], &datacode, &width, &decims, status);
+
+ *rowlen += (width + space); /* total length of row */
+ }
+
+ *rowlen -= space; /* don't add space after the last field */
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtbc(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG *totalwidth, /* O - total width of a table row */
+ int *status) /* IO - error status */
+{
+/*
+ calculate the starting byte offset of each column of a binary table.
+ Use the values of the datatype code and repeat counts in the
+ column structure. Return the total length of a row, in bytes.
+*/
+ int tfields, ii;
+ LONGLONG nbytes;
+ tcolumn *colptr;
+ char message[FLEN_ERRMSG], *cptr;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ tfields = (fptr->Fptr)->tfield;
+ colptr = (fptr->Fptr)->tableptr; /* point to first column structure */
+
+ *totalwidth = 0;
+
+ for (ii = 0; ii < tfields; ii++, colptr++)
+ {
+ colptr->tbcol = *totalwidth; /* byte offset in row to this column */
+
+ if (colptr->tdatatype == TSTRING)
+ {
+ nbytes = colptr->trepeat; /* one byte per char */
+ }
+ else if (colptr->tdatatype == TBIT)
+ {
+ nbytes = ( colptr->trepeat + 7) / 8;
+ }
+ else if (colptr->tdatatype > 0)
+ {
+ nbytes = colptr->trepeat * (colptr->tdatatype / 10);
+ }
+ else {
+
+ cptr = colptr->tform;
+ while (isdigit(*cptr)) cptr++;
+
+ if (*cptr == 'P')
+ /* this is a 'P' variable length descriptor (neg. tdatatype) */
+ nbytes = colptr->trepeat * 8;
+ else if (*cptr == 'Q')
+ /* this is a 'Q' variable length descriptor (neg. tdatatype) */
+ nbytes = colptr->trepeat * 16;
+
+ else {
+ sprintf(message,
+ "unknown binary table column type: %s", colptr->tform);
+ ffpmsg(message);
+ *status = BAD_TFORM;
+ return(*status);
+ }
+ }
+
+ *totalwidth = *totalwidth + nbytes;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtbp(fitsfile *fptr, /* I - FITS file pointer */
+ char *name, /* I - name of the keyword */
+ char *value, /* I - value string of the keyword */
+ int *status) /* IO - error status */
+{
+/*
+ Get TaBle Parameter. The input keyword name begins with the letter T.
+ Test if the keyword is one of the table column definition keywords
+ of an ASCII or binary table. If so, decode it and update the value
+ in the structure.
+*/
+ int tstatus, datacode, decimals;
+ long width, repeat, nfield, ivalue;
+ LONGLONG jjvalue;
+ double dvalue;
+ char tvalue[FLEN_VALUE], *loc;
+ char message[FLEN_ERRMSG];
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ tstatus = 0;
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if(!FSTRNCMP(name + 1, "TYPE", 4) )
+ {
+ /* get the index number */
+ if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */
+ return(*status); /* must not be an indexed keyword */
+
+ if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */
+ colptr = colptr + nfield - 1; /* point to the correct column */
+
+ if (ffc2s(value, tvalue, &tstatus) > 0) /* remove quotes */
+ return(*status);
+
+ strcpy(colptr->ttype, tvalue); /* copy col name to structure */
+ }
+ else if(!FSTRNCMP(name + 1, "FORM", 4) )
+ {
+ /* get the index number */
+ if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */
+ return(*status); /* must not be an indexed keyword */
+
+ if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */
+ colptr = colptr + nfield - 1; /* point to the correct column */
+
+ if (ffc2s(value, tvalue, &tstatus) > 0) /* remove quotes */
+ return(*status);
+
+ strncpy(colptr->tform, tvalue, 9); /* copy TFORM to structure */
+ colptr->tform[9] = '\0'; /* make sure it is terminated */
+
+ if ((fptr->Fptr)->hdutype == ASCII_TBL) /* ASCII table */
+ {
+ if (ffasfm(tvalue, &datacode, &width, &decimals, status) > 0)
+ return(*status); /* bad format code */
+
+ colptr->tdatatype = TSTRING; /* store datatype code */
+ colptr->trepeat = 1; /* field repeat count == 1 */
+ colptr->twidth = width; /* the width of the field, in bytes */
+ }
+ else /* binary table */
+ {
+ if (ffbnfm(tvalue, &datacode, &repeat, &width, status) > 0)
+ return(*status); /* bad format code */
+
+ colptr->tdatatype = datacode; /* store datatype code */
+ colptr->trepeat = (LONGLONG) repeat; /* field repeat count */
+
+ /* Don't overwrite the unit string width if it was previously */
+ /* set by a TDIMn keyword and has a legal value */
+ if (datacode == TSTRING) {
+ if (colptr->twidth == 0 || colptr->twidth > repeat)
+ colptr->twidth = width; /* width of a unit string */
+
+ } else {
+ colptr->twidth = width; /* width of a unit value in chars */
+ }
+ }
+ }
+ else if(!FSTRNCMP(name + 1, "BCOL", 4) )
+ {
+ /* get the index number */
+ if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */
+ return(*status); /* must not be an indexed keyword */
+
+ if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */
+ colptr = colptr + nfield - 1; /* point to the correct column */
+
+ if ((fptr->Fptr)->hdutype == BINARY_TBL)
+ return(*status); /* binary tables don't have TBCOL keywords */
+
+ if (ffc2ii(value, &ivalue, status) > 0)
+ {
+ sprintf(message,
+ "Error reading value of %s as an integer: %s", name, value);
+ ffpmsg(message);
+ return(*status);
+ }
+ colptr->tbcol = ivalue - 1; /* convert to zero base */
+ }
+ else if(!FSTRNCMP(name + 1, "SCAL", 4) )
+ {
+ /* get the index number */
+ if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */
+ return(*status); /* must not be an indexed keyword */
+
+ if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */
+ colptr = colptr + nfield - 1; /* point to the correct column */
+
+ if (ffc2dd(value, &dvalue, &tstatus) > 0)
+ {
+ sprintf(message,
+ "Error reading value of %s as a double: %s", name, value);
+ ffpmsg(message);
+
+ /* ignore this error, so don't return error status */
+ return(*status);
+ }
+ colptr->tscale = dvalue;
+ }
+ else if(!FSTRNCMP(name + 1, "ZERO", 4) )
+ {
+ /* get the index number */
+ if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */
+ return(*status); /* must not be an indexed keyword */
+
+ if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */
+ colptr = colptr + nfield - 1; /* point to the correct column */
+
+ if (ffc2dd(value, &dvalue, &tstatus) > 0)
+ {
+ sprintf(message,
+ "Error reading value of %s as a double: %s", name, value);
+ ffpmsg(message);
+
+ /* ignore this error, so don't return error status */
+ return(*status);
+ }
+ colptr->tzero = dvalue;
+ }
+ else if(!FSTRNCMP(name + 1, "NULL", 4) )
+ {
+ /* get the index number */
+ if( ffc2ii(name + 5, &nfield, &tstatus) > 0) /* read index no. */
+ return(*status); /* must not be an indexed keyword */
+
+ if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */
+ colptr = colptr + nfield - 1; /* point to the correct column */
+
+ if ((fptr->Fptr)->hdutype == ASCII_TBL) /* ASCII table */
+ {
+ if (ffc2s(value, tvalue, &tstatus) > 0) /* remove quotes */
+ return(*status);
+
+ strncpy(colptr->strnull, tvalue, 17); /* copy TNULL string */
+ colptr->strnull[17] = '\0'; /* terminate the strnull field */
+
+ }
+ else /* binary table */
+ {
+ if (ffc2jj(value, &jjvalue, &tstatus) > 0)
+ {
+ sprintf(message,
+ "Error reading value of %s as an integer: %s", name, value);
+ ffpmsg(message);
+
+ /* ignore this error, so don't return error status */
+ return(*status);
+ }
+ colptr->tnull = jjvalue; /* null value for integer column */
+ }
+ }
+ else if(!FSTRNCMP(name + 1, "DIM", 3) )
+ {
+ if ((fptr->Fptr)->hdutype == ASCII_TBL) /* ASCII table */
+ return(*status); /* ASCII tables don't support TDIMn keyword */
+
+ /* get the index number */
+ if( ffc2ii(name + 4, &nfield, &tstatus) > 0) /* read index no. */
+ return(*status); /* must not be an indexed keyword */
+
+ if (nfield < 1 || nfield > (fptr->Fptr)->tfield ) /* out of range */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* get pointer to columns */
+ colptr = colptr + nfield - 1; /* point to the correct column */
+
+ /* uninitialized columns have tdatatype set = -9999 */
+ if (colptr->tdatatype != -9999 && colptr->tdatatype != TSTRING)
+ return(*status); /* this is not an ASCII string column */
+
+ loc = strchr(value, '(' ); /* find the opening parenthesis */
+ if (!loc)
+ return(*status); /* not a proper TDIM keyword */
+
+ loc++;
+ width = strtol(loc, &loc, 10); /* read size of first dimension */
+ if (colptr->trepeat != 1 && colptr->trepeat < width)
+ return(*status); /* string length is greater than column width */
+
+ colptr->twidth = width; /* set width of a unit string in chars */
+ }
+ else if (!FSTRNCMP(name + 1, "HEAP", 4) )
+ {
+ if ((fptr->Fptr)->hdutype == ASCII_TBL) /* ASCII table */
+ return(*status); /* ASCII tables don't have a heap */
+
+ if (ffc2jj(value, &jjvalue, &tstatus) > 0)
+ {
+ sprintf(message,
+ "Error reading value of %s as an integer: %s", name, value);
+ ffpmsg(message);
+
+ /* ignore this error, so don't return error status */
+ return(*status);
+ }
+ (fptr->Fptr)->heapstart = jjvalue; /* starting byte of the heap */
+ return(*status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcprll( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number (1 = 1st column of table) */
+ LONGLONG firstrow, /* I - first row (1 = 1st row of table) */
+ LONGLONG firstelem, /* I - first element within vector (1 = 1st) */
+ LONGLONG nelem, /* I - number of elements to read or write */
+ int writemode, /* I - = 1 if writing data, = 0 if reading data */
+ /* If = 2, then writing data, but don't modify */
+ /* the returned values of repeat and incre. */
+ /* If = -1, then reading data in reverse */
+ /* direction. */
+ double *scale, /* O - FITS scaling factor (TSCALn keyword value) */
+ double *zero, /* O - FITS scaling zero pt (TZEROn keyword value) */
+ char *tform, /* O - ASCII column format: value of TFORMn keyword */
+ long *twidth, /* O - width of ASCII column (characters) */
+ int *tcode, /* O - column datatype code: I*4=41, R*4=42, etc */
+ int *maxelem, /* O - max number of elements that fit in buffer */
+ LONGLONG *startpos,/* O - offset in file to starting row & column */
+ LONGLONG *elemnum, /* O - starting element number ( 0 = 1st element) */
+ long *incre, /* O - byte offset between elements within a row */
+ LONGLONG *repeat, /* O - number of elements in a row (vector column) */
+ LONGLONG *rowlen, /* O - length of a row, in bytes */
+ int *hdutype, /* O - HDU type: 0, 1, 2 = primary, table, bintable */
+ LONGLONG *tnull, /* O - null value for integer columns */
+ char *snull, /* O - null value for ASCII table columns */
+ int *status) /* IO - error status */
+/*
+ Get Column PaRameters, and test starting row and element numbers for
+ validity. This is a workhorse routine that is call by nearly every
+ other routine that reads or writes to FITS files.
+*/
+{
+ int nulpos, rangecheck = 1, tstatus = 0;
+ LONGLONG datastart, endpos;
+ long nblock;
+ LONGLONG heapoffset, lrepeat, endrow, nrows, tbcol;
+ char message[81];
+ tcolumn *colptr;
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu) {
+ /* reset position to the correct HDU if necessary */
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ } else if ((fptr->Fptr)->datastart == DATA_UNDEFINED) {
+ /* rescan header if data structure is undefined */
+ if ( ffrdef(fptr, status) > 0)
+ return(*status);
+
+ } else if (writemode > 0) {
+
+ /* Only terminate the header with the END card if */
+ /* writing to the stdout stream (don't have random access). */
+
+ /* Initialize STREAM_DRIVER to be the device number for */
+ /* writing FITS files directly out to the stdout stream. */
+ /* This only needs to be done once and is thread safe. */
+ if (STREAM_DRIVER <= 0 || STREAM_DRIVER > 40) {
+ urltype2driver("stream://", &STREAM_DRIVER);
+ }
+
+ if (((fptr->Fptr)->driver == STREAM_DRIVER)) {
+ if ((fptr->Fptr)->ENDpos !=
+ maxvalue((fptr->Fptr)->headend , (fptr->Fptr)->datastart -2880)) {
+ ffwend(fptr, status);
+ }
+ }
+ }
+
+ /* Do sanity check of input parameters */
+ if (firstrow < 1)
+ {
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU) /* Primary Array or IMAGE */
+ {
+ sprintf(message, "Image group number is less than 1: %.0f",
+ (double) firstrow);
+ ffpmsg(message);
+ return(*status = BAD_ROW_NUM);
+ }
+ else
+ {
+ sprintf(message, "Starting row number is less than 1: %.0f",
+ (double) firstrow);
+ ffpmsg(message);
+ return(*status = BAD_ROW_NUM);
+ }
+ }
+ else if ((fptr->Fptr)->hdutype != ASCII_TBL && firstelem < 1)
+ {
+ sprintf(message, "Starting element number less than 1: %ld",
+ (long) firstelem);
+ ffpmsg(message);
+ return(*status = BAD_ELEM_NUM);
+ }
+ else if (nelem < 0)
+ {
+ sprintf(message, "Tried to read or write less than 0 elements: %.0f",
+ (double) nelem);
+ ffpmsg(message);
+ return(*status = NEG_BYTES);
+ }
+ else if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+ {
+ sprintf(message, "Specified column number is out of range: %d",
+ colnum);
+ ffpmsg(message);
+ sprintf(message, " There are %d columns in this table.",
+ (fptr->Fptr)->tfield );
+ ffpmsg(message);
+
+ return(*status = BAD_COL_NUM);
+ }
+
+ /* copy relevant parameters from the structure */
+
+ *hdutype = (fptr->Fptr)->hdutype; /* image, ASCII table, or BINTABLE */
+ *rowlen = (fptr->Fptr)->rowlength; /* width of the table, in bytes */
+ datastart = (fptr->Fptr)->datastart; /* offset in file to start of table */
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ *scale = colptr->tscale; /* value scaling factor; default = 1.0 */
+ *zero = colptr->tzero; /* value scaling zeropoint; default = 0.0 */
+ *tnull = colptr->tnull; /* null value for integer columns */
+ tbcol = colptr->tbcol; /* offset to start of column within row */
+ *twidth = colptr->twidth; /* width of a single datum, in bytes */
+ *incre = colptr->twidth; /* increment between datums, in bytes */
+
+ *tcode = colptr->tdatatype;
+ *repeat = colptr->trepeat;
+
+ strcpy(tform, colptr->tform); /* value of TFORMn keyword */
+ strcpy(snull, colptr->strnull); /* null value for ASCII table columns */
+
+ if (*hdutype == ASCII_TBL && snull[0] == '\0')
+ {
+ /* In ASCII tables, a null value is equivalent to all spaces */
+
+ strcpy(snull, " "); /* maximum of 17 spaces */
+ nulpos = minvalue(17, *twidth); /* truncate to width of column */
+ snull[nulpos] = '\0';
+ }
+
+ /* Special case: interpret writemode = -1 as reading data, but */
+ /* don't do error check for exceeding the range of pixels */
+ if (writemode == -1)
+ {
+ writemode = 0;
+ rangecheck = 0;
+ }
+
+ /* Special case: interprete 'X' column as 'B' */
+ if (abs(*tcode) == TBIT)
+ {
+ *tcode = *tcode / TBIT * TBYTE;
+ *repeat = (*repeat + 7) / 8;
+ }
+
+ /* Special case: support the 'rAw' format in BINTABLEs */
+ if (*hdutype == BINARY_TBL && *tcode == TSTRING) {
+ *repeat = *repeat / *twidth; /* repeat = # of unit strings in field */
+ }
+ else if (*hdutype == BINARY_TBL && *tcode == -TSTRING) {
+ /* variable length string */
+ *incre = 1;
+ *twidth = (long) nelem;
+ }
+
+ if (*hdutype == ASCII_TBL)
+ *elemnum = 0; /* ASCII tables don't have vector elements */
+ else
+ *elemnum = firstelem - 1;
+
+ /* interprete complex and double complex as pairs of floats or doubles */
+ if (abs(*tcode) >= TCOMPLEX)
+ {
+ if (*tcode > 0)
+ *tcode = (*tcode + 1) / 2;
+ else
+ *tcode = (*tcode - 1) / 2;
+
+ *repeat = *repeat * 2;
+ *twidth = *twidth / 2;
+ *incre = *incre / 2;
+ }
+
+ /* calculate no. of pixels that fit in buffer */
+ /* allow for case where floats are 8 bytes long */
+ if (abs(*tcode) == TFLOAT)
+ *maxelem = DBUFFSIZE / sizeof(float);
+ else if (abs(*tcode) == TDOUBLE)
+ *maxelem = DBUFFSIZE / sizeof(double);
+ else if (abs(*tcode) == TSTRING)
+ {
+ *maxelem = (DBUFFSIZE - 1)/ *twidth; /* leave room for final \0 */
+ if (*maxelem == 0) {
+ sprintf(message,
+ "ASCII string column is too wide: %ld; max supported width is %d",
+ *twidth, DBUFFSIZE - 1);
+ ffpmsg(message);
+ return(*status = COL_TOO_WIDE);
+ }
+ }
+ else
+ *maxelem = DBUFFSIZE / *twidth;
+
+ /* calc starting byte position to 1st element of col */
+ /* (this does not apply to variable length columns) */
+ *startpos = datastart + ((LONGLONG)(firstrow - 1) * *rowlen) + tbcol;
+
+ if (*hdutype == IMAGE_HDU && writemode) /* Primary Array or IMAGE */
+ { /*
+ For primary arrays, set the repeat count greater than the total
+ number of pixels to be written. This prevents an out-of-range
+ error message in cases where the final image array size is not
+ yet known or defined.
+ */
+ if (*repeat < *elemnum + nelem)
+ *repeat = *elemnum + nelem;
+ }
+ else if (*tcode > 0) /* Fixed length table column */
+ {
+ if (*elemnum >= *repeat)
+ {
+ sprintf(message,
+ "First element to write is too large: %ld; max allowed value is %ld",
+ (long) ((*elemnum) + 1), (long) *repeat);
+ ffpmsg(message);
+ return(*status = BAD_ELEM_NUM);
+ }
+
+ /* last row number to be read or written */
+ endrow = ((*elemnum + nelem - 1) / *repeat) + firstrow;
+
+ if (writemode)
+ {
+ /* check if we are writing beyond the current end of table */
+ if ((endrow > (fptr->Fptr)->numrows) && (nelem > 0) )
+ {
+ /* if there are more HDUs following the current one, or */
+ /* if there is a data heap, then we must insert space */
+ /* for the new rows. */
+ if ( !((fptr->Fptr)->lasthdu) || (fptr->Fptr)->heapsize > 0)
+ {
+ nrows = endrow - ((fptr->Fptr)->numrows);
+ if (ffirow(fptr, (fptr->Fptr)->numrows, nrows, status) > 0)
+ {
+ sprintf(message,
+ "Failed to add space for %.0f new rows in table.",
+ (double) nrows);
+ ffpmsg(message);
+ return(*status);
+ }
+ }
+ else
+ {
+ /* update heap starting address */
+ (fptr->Fptr)->heapstart +=
+ ((LONGLONG)(endrow - (fptr->Fptr)->numrows) *
+ (fptr->Fptr)->rowlength );
+
+ (fptr->Fptr)->numrows = endrow; /* update number of rows */
+ }
+ }
+ }
+ else /* reading from the file */
+ {
+ if ( endrow > (fptr->Fptr)->numrows && rangecheck)
+ {
+ if (*hdutype == IMAGE_HDU) /* Primary Array or IMAGE */
+ {
+ if (firstrow > (fptr->Fptr)->numrows)
+ {
+ sprintf(message,
+ "Attempted to read from group %ld of the HDU,", (long) firstrow);
+ ffpmsg(message);
+
+ sprintf(message,
+ "however the HDU only contains %ld group(s).",
+ (long) ((fptr->Fptr)->numrows) );
+ ffpmsg(message);
+ }
+ else
+ {
+ ffpmsg("Attempt to read past end of array:");
+ sprintf(message,
+ " Image has %ld elements;", (long) *repeat);
+ ffpmsg(message);
+
+ sprintf(message,
+ " Tried to read %ld elements starting at element %ld.",
+ (long) nelem, (long) firstelem);
+ ffpmsg(message);
+ }
+ }
+ else
+ {
+ ffpmsg("Attempt to read past end of table:");
+ sprintf(message,
+ " Table has %.0f rows with %.0f elements per row;",
+ (double) ((fptr->Fptr)->numrows), (double) *repeat);
+ ffpmsg(message);
+
+ sprintf(message,
+ " Tried to read %.0f elements starting at row %.0f, element %.0f.",
+ (double) nelem, (double) firstrow, (double) ((*elemnum) + 1));
+ ffpmsg(message);
+
+ }
+ return(*status = BAD_ROW_NUM);
+ }
+ }
+
+ if (*repeat == 1 && nelem > 1 && writemode != 2)
+ { /*
+ When accessing a scalar column, fool the calling routine into
+ thinking that this is a vector column with very big elements.
+ This allows multiple values (up to the maxelem number of elements
+ that will fit in the buffer) to be read or written with a single
+ routine call, which increases the efficiency.
+
+ If writemode == 2, then the calling program does not want to
+ have this efficiency trick applied.
+ */
+ *incre = (long) *rowlen;
+ *repeat = nelem;
+ }
+ }
+ else /* Variable length Binary Table column */
+ {
+ *tcode *= (-1);
+
+ if (writemode) /* return next empty heap address for writing */
+ {
+
+ *repeat = nelem + *elemnum; /* total no. of elements in the field */
+
+ /* first, check if we are overwriting an existing row, and */
+ /* if so, if the existing space is big enough for the new vector */
+
+ if ( firstrow <= (fptr->Fptr)->numrows )
+ {
+ ffgdesll(fptr, colnum, firstrow, &lrepeat, &heapoffset, &tstatus);
+ if (!tstatus)
+ {
+ if (colptr->tdatatype <= -TCOMPLEX)
+ lrepeat = lrepeat * 2; /* no. of float or double values */
+ else if (colptr->tdatatype == -TBIT)
+ lrepeat = (lrepeat + 7) / 8; /* convert from bits to bytes */
+
+ if (lrepeat >= *repeat) /* enough existing space? */
+ {
+ *startpos = datastart + heapoffset + (fptr->Fptr)->heapstart;
+
+ /* write the descriptor into the fixed length part of table */
+ if (colptr->tdatatype <= -TCOMPLEX)
+ {
+ /* divide repeat count by 2 to get no. of complex values */
+ ffpdes(fptr, colnum, firstrow, *repeat / 2,
+ heapoffset, status);
+ }
+ else
+ {
+ ffpdes(fptr, colnum, firstrow, *repeat,
+ heapoffset, status);
+ }
+ return(*status);
+ }
+ }
+ }
+
+ /* Add more rows to the table, if writing beyond the end. */
+ /* It is necessary to shift the heap down in this case */
+ if ( firstrow > (fptr->Fptr)->numrows)
+ {
+ nrows = firstrow - ((fptr->Fptr)->numrows);
+ if (ffirow(fptr, (fptr->Fptr)->numrows, nrows, status) > 0)
+ {
+ sprintf(message,
+ "Failed to add space for %.0f new rows in table.",
+ (double) nrows);
+ ffpmsg(message);
+ return(*status);
+ }
+ }
+
+ /* calculate starting position (for writing new data) in the heap */
+ *startpos = datastart + (fptr->Fptr)->heapstart +
+ (fptr->Fptr)->heapsize;
+
+ /* write the descriptor into the fixed length part of table */
+ if (colptr->tdatatype <= -TCOMPLEX)
+ {
+ /* divide repeat count by 2 to get no. of complex values */
+ ffpdes(fptr, colnum, firstrow, *repeat / 2,
+ (fptr->Fptr)->heapsize, status);
+ }
+ else
+ {
+ ffpdes(fptr, colnum, firstrow, *repeat, (fptr->Fptr)->heapsize,
+ status);
+ }
+
+ /* If this is not the last HDU in the file, then check if */
+ /* extending the heap would overwrite the following header. */
+ /* If so, then have to insert more blocks. */
+ if ( !((fptr->Fptr)->lasthdu) )
+ {
+ endpos = datastart + (fptr->Fptr)->heapstart +
+ (fptr->Fptr)->heapsize + ( *repeat * (*incre));
+
+ if (endpos > (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1])
+ {
+ /* calc the number of blocks that need to be added */
+ nblock = (long) (((endpos - 1 -
+ (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] )
+ / 2880) + 1);
+
+ if (ffiblk(fptr, nblock, 1, status) > 0) /* insert blocks */
+ {
+ sprintf(message,
+ "Failed to extend the size of the variable length heap by %ld blocks.",
+ nblock);
+ ffpmsg(message);
+ return(*status);
+ }
+ }
+ }
+
+ /* increment the address to the next empty heap position */
+ (fptr->Fptr)->heapsize += ( *repeat * (*incre));
+ }
+ else /* get the read start position in the heap */
+ {
+ if ( firstrow > (fptr->Fptr)->numrows)
+ {
+ ffpmsg("Attempt to read past end of table");
+ sprintf(message,
+ " Table has %.0f rows and tried to read row %.0f.",
+ (double) ((fptr->Fptr)->numrows), (double) firstrow);
+ ffpmsg(message);
+ return(*status = BAD_ROW_NUM);
+ }
+
+ ffgdesll(fptr, colnum, firstrow, &lrepeat, &heapoffset, status);
+ *repeat = lrepeat;
+
+ if (colptr->tdatatype <= -TCOMPLEX)
+ *repeat = *repeat * 2; /* no. of float or double values */
+ else if (colptr->tdatatype == -TBIT)
+ *repeat = (*repeat + 7) / 8; /* convert from bits to bytes */
+
+ if (*elemnum >= *repeat)
+ {
+ sprintf(message,
+ "Starting element to read in variable length column is too large: %ld",
+ (long) firstelem);
+ ffpmsg(message);
+ sprintf(message,
+ " This row only contains %ld elements", (long) *repeat);
+ ffpmsg(message);
+ return(*status = BAD_ELEM_NUM);
+ }
+
+ *startpos = datastart + heapoffset + (fptr->Fptr)->heapstart;
+ }
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int fftheap(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG *heapsz, /* O - current size of the heap */
+ LONGLONG *unused, /* O - no. of unused bytes in the heap */
+ LONGLONG *overlap, /* O - no. of bytes shared by > 1 descriptors */
+ int *valid, /* O - are all the heap addresses valid? */
+ int *status) /* IO - error status */
+/*
+ Tests the contents of the binary table variable length array heap.
+ Returns the number of bytes that are currently not pointed to by any
+ of the descriptors, and also the number of bytes that are pointed to
+ by more than one descriptor. It returns valid = FALSE if any of the
+ descriptors point to addresses that are out of the bounds of the
+ heap.
+*/
+{
+ int jj, typecode, pixsize;
+ long ii, kk, theapsz, nbytes;
+ LONGLONG repeat, offset, tunused = 0, toverlap = 0;
+ char *buffer, message[81];
+
+ if (*status > 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 to make sure everything is up to date */
+ else if ( ffrdef(fptr, status) > 0)
+ return(*status);
+
+ if (valid) *valid = TRUE;
+ if (heapsz) *heapsz = (fptr->Fptr)->heapsize;
+ if (unused) *unused = 0;
+ if (overlap) *overlap = 0;
+
+ /* return if this is not a binary table HDU or if the heap is empty */
+ if ( (fptr->Fptr)->hdutype != BINARY_TBL || (fptr->Fptr)->heapsize == 0 )
+ return(*status);
+
+ if ((fptr->Fptr)->heapsize > LONG_MAX) {
+ ffpmsg("Heap is too big to test ( > 2**31 bytes). (fftheap)");
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ theapsz = (long) (fptr->Fptr)->heapsize;
+ buffer = calloc(1, theapsz); /* allocate temp space */
+ if (!buffer )
+ {
+ sprintf(message,"Failed to allocate buffer to test the heap");
+ ffpmsg(message);
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* loop over all cols */
+ for (jj = 1; jj <= (fptr->Fptr)->tfield && *status <= 0; jj++)
+ {
+ ffgtcl(fptr, jj, &typecode, NULL, NULL, status);
+ if (typecode > 0)
+ continue; /* ignore fixed length columns */
+
+ pixsize = -typecode / 10;
+
+ for (ii = 1; ii <= (fptr->Fptr)->numrows; ii++)
+ {
+ ffgdesll(fptr, jj, ii, &repeat, &offset, status);
+ if (typecode == -TBIT)
+ nbytes = (long) (repeat + 7) / 8;
+ else
+ nbytes = (long) repeat * pixsize;
+
+ if (offset < 0 || offset + nbytes > theapsz)
+ {
+ if (valid) *valid = FALSE; /* address out of bounds */
+ sprintf(message,
+ "Descriptor in row %ld, column %d has invalid heap address",
+ ii, jj);
+ ffpmsg(message);
+ }
+ else
+ {
+ for (kk = 0; kk < nbytes; kk++)
+ buffer[kk + offset]++; /* increment every used byte */
+ }
+ }
+ }
+
+ for (kk = 0; kk < theapsz; kk++)
+ {
+ if (buffer[kk] == 0)
+ tunused++;
+ else if (buffer[kk] > 1)
+ toverlap++;
+ }
+
+ if (heapsz) *heapsz = theapsz;
+ if (unused) *unused = tunused;
+ if (overlap) *overlap = toverlap;
+
+ free(buffer);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcmph(fitsfile *fptr, /* I -FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ compress the binary table heap by reordering the contents heap and
+ recovering any unused space
+*/
+{
+ fitsfile *tptr;
+ int jj, typecode, pixsize, valid;
+ long ii, buffsize = 10000, nblock, nbytes;
+ LONGLONG unused, overlap;
+ LONGLONG repeat, offset;
+ char *buffer, *tbuff, comm[FLEN_COMMENT];
+ char message[81];
+ LONGLONG pcount;
+ LONGLONG readheapstart, writeheapstart, endpos, t1heapsize, t2heapsize;
+
+ if (*status > 0)
+ return(*status);
+
+ /* get information about the current heap */
+ fftheap(fptr, NULL, &unused, &overlap, &valid, status);
+
+ if (!valid)
+ return(*status = BAD_HEAP_PTR); /* bad heap pointers */
+
+ /* return if this is not a binary table HDU or if the heap is OK as is */
+ if ( (fptr->Fptr)->hdutype != BINARY_TBL || (fptr->Fptr)->heapsize == 0 ||
+ (unused == 0 && overlap == 0) || *status > 0 )
+ return(*status);
+
+ /* copy the current HDU to a temporary file in memory */
+ if (ffinit( &tptr, "mem://tempheapfile", status) )
+ {
+ sprintf(message,"Failed to create temporary file for the heap");
+ ffpmsg(message);
+ return(*status);
+ }
+ if ( ffcopy(fptr, tptr, 0, status) )
+ {
+ sprintf(message,"Failed to create copy of the heap");
+ ffpmsg(message);
+ ffclos(tptr, status);
+ return(*status);
+ }
+
+ buffer = (char *) malloc(buffsize); /* allocate initial buffer */
+ if (!buffer)
+ {
+ sprintf(message,"Failed to allocate buffer to copy the heap");
+ ffpmsg(message);
+ ffclos(tptr, status);
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ readheapstart = (tptr->Fptr)->datastart + (tptr->Fptr)->heapstart;
+ writeheapstart = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart;
+
+ t1heapsize = (fptr->Fptr)->heapsize; /* save original heap size */
+ (fptr->Fptr)->heapsize = 0; /* reset heap to zero */
+
+ /* loop over all cols */
+ for (jj = 1; jj <= (fptr->Fptr)->tfield && *status <= 0; jj++)
+ {
+ ffgtcl(tptr, jj, &typecode, NULL, NULL, status);
+ if (typecode > 0)
+ continue; /* ignore fixed length columns */
+
+ pixsize = -typecode / 10;
+
+ /* copy heap data, row by row */
+ for (ii = 1; ii <= (fptr->Fptr)->numrows; ii++)
+ {
+ ffgdesll(tptr, jj, ii, &repeat, &offset, status);
+ if (typecode == -TBIT)
+ nbytes = (long) (repeat + 7) / 8;
+ else
+ nbytes = (long) repeat * pixsize;
+
+ /* increase size of buffer if necessary to read whole array */
+ if (nbytes > buffsize)
+ {
+ tbuff = realloc(buffer, nbytes);
+
+ if (tbuff)
+ {
+ buffer = tbuff;
+ buffsize = nbytes;
+ }
+ else
+ *status = MEMORY_ALLOCATION;
+ }
+
+ /* If this is not the last HDU in the file, then check if */
+ /* extending the heap would overwrite the following header. */
+ /* If so, then have to insert more blocks. */
+ if ( !((fptr->Fptr)->lasthdu) )
+ {
+ endpos = writeheapstart + (fptr->Fptr)->heapsize + nbytes;
+
+ if (endpos > (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1])
+ {
+ /* calc the number of blocks that need to be added */
+ nblock = (long) (((endpos - 1 -
+ (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] )
+ / 2880) + 1);
+
+ if (ffiblk(fptr, nblock, 1, status) > 0) /* insert blocks */
+ {
+ sprintf(message,
+ "Failed to extend the size of the variable length heap by %ld blocks.",
+ nblock);
+ ffpmsg(message);
+ }
+ }
+ }
+
+ /* read arrray of bytes from temporary copy */
+ ffmbyt(tptr, readheapstart + offset, REPORT_EOF, status);
+ ffgbyt(tptr, nbytes, buffer, status);
+
+ /* write arrray of bytes back to original file */
+ ffmbyt(fptr, writeheapstart + (fptr->Fptr)->heapsize,
+ IGNORE_EOF, status);
+ ffpbyt(fptr, nbytes, buffer, status);
+
+ /* write descriptor */
+ ffpdes(fptr, jj, ii, repeat,
+ (fptr->Fptr)->heapsize, status);
+
+ (fptr->Fptr)->heapsize += nbytes; /* update heapsize */
+
+ if (*status > 0)
+ {
+ free(buffer);
+ ffclos(tptr, status);
+ return(*status);
+ }
+ }
+ }
+
+ free(buffer);
+ ffclos(tptr, status);
+
+ /* delete any empty blocks at the end of the HDU */
+ nblock = (long) (( (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] -
+ (writeheapstart + (fptr->Fptr)->heapsize) ) / 2880);
+
+ if (nblock > 0)
+ {
+ t2heapsize = (fptr->Fptr)->heapsize; /* save new heap size */
+ (fptr->Fptr)->heapsize = t1heapsize; /* restore original heap size */
+
+ ffdblk(fptr, nblock, status);
+ (fptr->Fptr)->heapsize = t2heapsize; /* reset correct heap size */
+ }
+
+ /* update the PCOUNT value (size of heap) */
+ ffmaky(fptr, 2, status); /* reset to beginning of header */
+
+ ffgkyjj(fptr, "PCOUNT", &pcount, comm, status);
+ if ((fptr->Fptr)->heapsize != pcount)
+ {
+ ffmkyj(fptr, "PCOUNT", (fptr->Fptr)->heapsize, comm, status);
+ }
+ ffrdef(fptr, status); /* rescan new HDU structure */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgdes(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number (1 = 1st column of table) */
+ LONGLONG rownum, /* I - row number (1 = 1st row of table) */
+ long *length, /* O - number of elements in the row */
+ long *heapaddr, /* O - heap pointer to the data */
+ int *status) /* IO - error status */
+/*
+ get (read) the variable length vector descriptor from the table.
+*/
+{
+ LONGLONG lengthjj, heapaddrjj;
+
+ if (ffgdesll(fptr, colnum, rownum, &lengthjj, &heapaddrjj, status) > 0)
+ return(*status);
+
+ /* convert the temporary 8-byte values to 4-byte values */
+ /* check for overflow */
+ if (length) {
+ if (lengthjj > LONG_MAX)
+ *status = NUM_OVERFLOW;
+ else
+ *length = (long) lengthjj;
+ }
+
+ if (heapaddr) {
+ if (heapaddrjj > LONG_MAX)
+ *status = NUM_OVERFLOW;
+ else
+ *heapaddr = (long) heapaddrjj;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgdesll(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number (1 = 1st column of table) */
+ LONGLONG rownum, /* I - row number (1 = 1st row of table) */
+ LONGLONG *length, /* O - number of elements in the row */
+ LONGLONG *heapaddr, /* O - heap pointer to the data */
+ int *status) /* IO - error status */
+/*
+ get (read) the variable length vector descriptor from the binary table.
+ This is similar to ffgdes, except it supports the full 8-byte range of the
+ length and offset values in 'Q' columns, as well as 'P' columns.
+*/
+{
+ LONGLONG bytepos;
+ unsigned int descript4[2] = {0,0};
+ LONGLONG descript8[2] = {0,0};
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column structure */
+ colptr += (colnum - 1); /* offset to the correct column */
+
+ if (colptr->tdatatype >= 0) {
+ *status = NOT_VARI_LEN;
+ return(*status);
+ }
+
+ bytepos = (fptr->Fptr)->datastart +
+ ((fptr->Fptr)->rowlength * (rownum - 1)) +
+ colptr->tbcol;
+
+ if (colptr->tform[0] == 'P' || colptr->tform[1] == 'P')
+ {
+ /* read 4-byte descriptor */
+ if (ffgi4b(fptr, bytepos, 2, 4, (INT32BIT *) descript4, status) <= 0)
+ {
+ if (length)
+ *length = (LONGLONG) descript4[0]; /* 1st word is the length */
+ if (heapaddr)
+ *heapaddr = (LONGLONG) descript4[1]; /* 2nd word is the address */
+ }
+
+ }
+ else /* this is for 'Q' columns */
+ {
+ /* read 8 byte descriptor */
+ if (ffgi8b(fptr, bytepos, 2, 8, (long *) descript8, status) <= 0)
+ {
+ if (length)
+ *length = descript8[0]; /* 1st word is the length */
+ if (heapaddr)
+ *heapaddr = descript8[1]; /* 2nd word is the address */
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgdess(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number (1 = 1st column of table) */
+ LONGLONG firstrow, /* I - first row (1 = 1st row of table) */
+ LONGLONG nrows, /* I - number or rows to read */
+ long *length, /* O - number of elements in the row */
+ long *heapaddr, /* O - heap pointer to the data */
+ int *status) /* IO - error status */
+/*
+ get (read) a range of variable length vector descriptors from the table.
+*/
+{
+ LONGLONG rowsize, bytepos;
+ long ii;
+ INT32BIT descript4[2] = {0,0};
+ LONGLONG descript8[2] = {0,0};
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column structure */
+ colptr += (colnum - 1); /* offset to the correct column */
+
+ if (colptr->tdatatype >= 0) {
+ *status = NOT_VARI_LEN;
+ return(*status);
+ }
+
+ rowsize = (fptr->Fptr)->rowlength;
+ bytepos = (fptr->Fptr)->datastart +
+ (rowsize * (firstrow - 1)) +
+ colptr->tbcol;
+
+ if (colptr->tform[0] == 'P' || colptr->tform[1] == 'P')
+ {
+ /* read 4-byte descriptors */
+ for (ii = 0; ii < nrows; ii++)
+ {
+ /* read descriptors */
+ if (ffgi4b(fptr, bytepos, 2, 4, descript4, status) <= 0)
+ {
+ if (length) {
+ *length = (long) descript4[0]; /* 1st word is the length */
+ length++;
+ }
+
+ if (heapaddr) {
+ *heapaddr = (long) descript4[1]; /* 2nd word is the address */
+ heapaddr++;
+ }
+ bytepos += rowsize;
+ }
+ else
+ return(*status);
+ }
+ }
+ else /* this is for 'Q' columns */
+ {
+ /* read 8-byte descriptors */
+ for (ii = 0; ii < nrows; ii++)
+ {
+ /* read descriptors */
+ if (ffgi8b(fptr, bytepos, 2, 8, (long *) descript8, status) <= 0)
+ {
+ if (length) {
+ if (descript8[0] > LONG_MAX)*status = NUM_OVERFLOW;
+ *length = (long) descript8[0]; /* 1st word is the length */
+ length++;
+ }
+ if (heapaddr) {
+ if (descript8[1] > LONG_MAX)*status = NUM_OVERFLOW;
+ *heapaddr = (long) descript8[1]; /* 2nd word is the address */
+ heapaddr++;
+ }
+ bytepos += rowsize;
+ }
+ else
+ return(*status);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgdessll(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number (1 = 1st column of table) */
+ LONGLONG firstrow, /* I - first row (1 = 1st row of table) */
+ LONGLONG nrows, /* I - number or rows to read */
+ LONGLONG *length, /* O - number of elements in the row */
+ LONGLONG *heapaddr, /* O - heap pointer to the data */
+ int *status) /* IO - error status */
+/*
+ get (read) a range of variable length vector descriptors from the table.
+*/
+{
+ LONGLONG rowsize, bytepos;
+ long ii;
+ unsigned int descript4[2] = {0,0};
+ LONGLONG descript8[2] = {0,0};
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column structure */
+ colptr += (colnum - 1); /* offset to the correct column */
+
+ if (colptr->tdatatype >= 0) {
+ *status = NOT_VARI_LEN;
+ return(*status);
+ }
+
+ rowsize = (fptr->Fptr)->rowlength;
+ bytepos = (fptr->Fptr)->datastart +
+ (rowsize * (firstrow - 1)) +
+ colptr->tbcol;
+
+ if (colptr->tform[0] == 'P' || colptr->tform[1] == 'P')
+ {
+ /* read 4-byte descriptors */
+ for (ii = 0; ii < nrows; ii++)
+ {
+ /* read descriptors */
+ if (ffgi4b(fptr, bytepos, 2, 4, (INT32BIT *) descript4, status) <= 0)
+ {
+ if (length) {
+ *length = (LONGLONG) descript4[0]; /* 1st word is the length */
+ length++;
+ }
+
+ if (heapaddr) {
+ *heapaddr = (LONGLONG) descript4[1]; /* 2nd word is the address */
+ heapaddr++;
+ }
+ bytepos += rowsize;
+ }
+ else
+ return(*status);
+ }
+ }
+ else /* this is for 'Q' columns */
+ {
+ /* read 8-byte descriptors */
+ for (ii = 0; ii < nrows; ii++)
+ {
+ /* read descriptors */
+ /* cast to type (long *) even though it is actually (LONGLONG *) */
+ if (ffgi8b(fptr, bytepos, 2, 8, (long *) descript8, status) <= 0)
+ {
+ if (length) {
+ *length = descript8[0]; /* 1st word is the length */
+ length++;
+ }
+
+ if (heapaddr) {
+ *heapaddr = descript8[1]; /* 2nd word is the address */
+ heapaddr++;
+ }
+ bytepos += rowsize;
+ }
+ else
+ return(*status);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpdes(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number (1 = 1st column of table) */
+ LONGLONG rownum, /* I - row number (1 = 1st row of table) */
+ LONGLONG length, /* I - number of elements in the row */
+ LONGLONG heapaddr, /* I - heap pointer to the data */
+ int *status) /* IO - error status */
+/*
+ put (write) the variable length vector descriptor to the table.
+*/
+{
+ LONGLONG bytepos;
+ unsigned int descript4[2];
+ LONGLONG descript8[2];
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column structure */
+ colptr += (colnum - 1); /* offset to the correct column */
+
+ if (colptr->tdatatype >= 0)
+ *status = NOT_VARI_LEN;
+
+ bytepos = (fptr->Fptr)->datastart +
+ ((fptr->Fptr)->rowlength * (rownum - 1)) +
+ colptr->tbcol;
+
+ ffmbyt(fptr, bytepos, IGNORE_EOF, status); /* move to element */
+
+ if (colptr->tform[0] == 'P' || colptr->tform[1] == 'P')
+ {
+ if (length > UINT_MAX || length < 0 ||
+ heapaddr > UINT_MAX || heapaddr < 0) {
+ ffpmsg("P variable length column descriptor is out of range");
+ *status = NUM_OVERFLOW;
+ return(*status);
+ }
+
+ descript4[0] = (unsigned int) length; /* 1st word is the length */
+ descript4[1] = (unsigned int) heapaddr; /* 2nd word is the address */
+
+ ffpi4b(fptr, 2, 4, (INT32BIT *) descript4, status); /* write the descriptor */
+ }
+ else /* this is a 'Q' descriptor column */
+ {
+ descript8[0] = length; /* 1st word is the length */
+ descript8[1] = heapaddr; /* 2nd word is the address */
+
+ ffpi8b(fptr, 2, 8, (long *) descript8, status); /* write the descriptor */
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffchdu(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+{
+/*
+ close the current HDU. If we have write access to the file, then:
+ - write the END keyword and pad header with blanks if necessary
+ - check the data fill values, and rewrite them if not correct
+*/
+ char message[FLEN_ERRMSG];
+ int stdriver;
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ /* no need to do any further updating of the HDU */
+ }
+ else if ((fptr->Fptr)->writemode == 1)
+ {
+ urltype2driver("stream://", &stdriver);
+
+ /* don't rescan header in special case of writing to stdout */
+ if (((fptr->Fptr)->driver != stdriver))
+ ffrdef(fptr, status);
+
+ if ((fptr->Fptr)->heapsize > 0) {
+ ffuptf(fptr, status); /* update the variable length TFORM values */
+ }
+
+ ffpdfl(fptr, status); /* insure correct data fill values */
+ }
+
+ if ((fptr->Fptr)->open_count == 1)
+ {
+ /* free memory for the CHDU structure only if no other files are using it */
+ if ((fptr->Fptr)->tableptr)
+ {
+ free((fptr->Fptr)->tableptr);
+ (fptr->Fptr)->tableptr = NULL;
+
+ /* free the tile-compressed image cache, if it exists */
+ if ((fptr->Fptr)->tiledata) {
+ free((fptr->Fptr)->tiledata);
+ (fptr->Fptr)->tiledata = 0;
+ (fptr->Fptr)->tilerow = 0;
+ (fptr->Fptr)->tiledatasize = 0;
+ (fptr->Fptr)->tiletype = 0;
+ }
+
+ if ((fptr->Fptr)->tilenullarray) {
+ free((fptr->Fptr)->tilenullarray);
+ (fptr->Fptr)->tilenullarray = 0;
+ }
+ }
+ }
+
+ if (*status > 0 && *status != NO_CLOSE_ERROR)
+ {
+ sprintf(message,
+ "Error while closing HDU number %d (ffchdu).", (fptr->Fptr)->curhdu);
+ ffpmsg(message);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffuptf(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ Update the value of the TFORM keywords for the variable length array
+ columns to make sure they all have the form 1Px(len) or Px(len) where
+ 'len' is the maximum length of the vector in the table (e.g., '1PE(400)')
+*/
+{
+ int ii;
+ long tflds;
+ LONGLONG length, addr, maxlen, naxis2, jj;
+ char comment[FLEN_COMMENT], keyname[FLEN_KEYWORD];
+ char tform[FLEN_VALUE], newform[FLEN_VALUE], lenval[40];
+ char card[FLEN_CARD];
+ char message[FLEN_ERRMSG];
+ char *tmp;
+
+ ffmaky(fptr, 2, status); /* reset to beginning of header */
+ ffgkyjj(fptr, "NAXIS2", &naxis2, comment, status);
+ ffgkyj(fptr, "TFIELDS", &tflds, comment, status);
+
+ for (ii = 1; ii <= tflds; ii++) /* loop over all the columns */
+ {
+ ffkeyn("TFORM", ii, keyname, status); /* construct name */
+ if (ffgkys(fptr, keyname, tform, comment, status) > 0)
+ {
+ sprintf(message,
+ "Error while updating variable length vector TFORMn values (ffuptf).");
+ ffpmsg(message);
+ return(*status);
+ }
+ /* is this a variable array length column ? */
+ if (tform[0] == 'P' || tform[1] == 'P' || tform[0] == 'Q' || tform[1] == 'Q')
+ {
+ /* get the max length */
+ maxlen = 0;
+ for (jj=1; jj <= naxis2; jj++)
+ {
+ ffgdesll(fptr, ii, jj, &length, &addr, status);
+
+ if (length > maxlen)
+ maxlen = length;
+ }
+
+ /* construct the new keyword value */
+ strcpy(newform, "'");
+ tmp = strchr(tform, '('); /* truncate old length, if present */
+ if (tmp) *tmp = 0;
+ strcat(newform, tform);
+
+ /* print as double, because the string-to-64-bit */
+ /* conversion is platform dependent (%lld, %ld, %I64d) */
+
+ sprintf(lenval, "(%.0f)", (double) maxlen);
+
+ strcat(newform,lenval);
+ while(strlen(newform) < 9)
+ strcat(newform," "); /* append spaces 'till length = 8 */
+ strcat(newform,"'" ); /* append closing parenthesis */
+ /* would be simpler to just call ffmkyj here, but this */
+ /* would force linking in all the modkey & putkey routines */
+ ffmkky(keyname, newform, comment, card, status); /* make new card */
+ ffmkey(fptr, card, status); /* replace last read keyword */
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffrdef(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ ReDEFine the structure of a data unit. This routine re-reads
+ the CHDU header keywords to determine the structure and length of the
+ current data unit. This redefines the start of the next HDU.
+*/
+{
+ int dummy, tstatus = 0;
+ LONGLONG naxis2;
+ LONGLONG pcount;
+ char card[FLEN_CARD], comm[FLEN_COMMENT], valstring[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->writemode == 1) /* write access to the file? */
+ {
+ /* don't need to check NAXIS2 and PCOUNT if data hasn't been written */
+ if ((fptr->Fptr)->datastart != DATA_UNDEFINED)
+ {
+ /* update NAXIS2 keyword if more rows were written to the table */
+ /* and if the user has not explicitly reset the NAXIS2 value */
+ if ((fptr->Fptr)->hdutype != IMAGE_HDU)
+ {
+ ffmaky(fptr, 2, status);
+ if (ffgkyjj(fptr, "NAXIS2", &naxis2, comm, &tstatus) > 0)
+ {
+ /* Couldn't read NAXIS2 (odd!); in certain circumstances */
+ /* this may be normal, so ignore the error. */
+ naxis2 = (fptr->Fptr)->numrows;
+ }
+
+ if ((fptr->Fptr)->numrows > naxis2
+ && (fptr->Fptr)->origrows == naxis2)
+ /* if origrows is not equal to naxis2, then the user must */
+ /* have manually modified the NAXIS2 keyword value, and */
+ /* we will assume that the current value is correct. */
+ {
+ /* would be simpler to just call ffmkyj here, but this */
+ /* would force linking in all the modkey & putkey routines */
+
+ /* print as double because the 64-bit int conversion */
+ /* is platform dependent (%lld, %ld, %I64 ) */
+
+ sprintf(valstring, "%.0f", (double) ((fptr->Fptr)->numrows));
+
+ ffmkky("NAXIS2", valstring, comm, card, status);
+ ffmkey(fptr, card, status);
+ }
+ }
+
+ /* if data has been written to variable length columns in a */
+ /* binary table, then we may need to update the PCOUNT value */
+ if ((fptr->Fptr)->heapsize > 0)
+ {
+ ffmaky(fptr, 2, status);
+ ffgkyjj(fptr, "PCOUNT", &pcount, comm, status);
+ if ((fptr->Fptr)->heapsize != pcount)
+ {
+ ffmkyj(fptr, "PCOUNT", (fptr->Fptr)->heapsize, comm, status);
+ }
+ }
+ }
+
+ if (ffwend(fptr, status) <= 0) /* rewrite END keyword and fill */
+ {
+ ffrhdu(fptr, &dummy, status); /* re-scan the header keywords */
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffhdef(fitsfile *fptr, /* I - FITS file pointer */
+ int morekeys, /* I - reserve space for this many keywords */
+ int *status) /* IO - error status */
+/*
+ based on the number of keywords which have already been written,
+ plus the number of keywords to reserve space for, we then can
+ define where the data unit should start (it must start at the
+ beginning of a 2880-byte logical block).
+
+ This routine will only have any effect if the starting location of the
+ data unit following the header is not already defined. In any case,
+ it is always possible to add more keywords to the header even if the
+ data has already been written. It is just more efficient to reserve
+ the space in advance.
+*/
+{
+ LONGLONG delta;
+
+ if (*status > 0 || morekeys < 1)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ ffrdef(fptr, status);
+
+ /* ffrdef defines the offset to datastart and the start of */
+ /* the next HDU based on the number of existing keywords. */
+ /* We need to increment both of these values based on */
+ /* the number of new keywords to be added. */
+
+ delta = (((fptr->Fptr)->headend + (morekeys * 80)) / 2880 + 1)
+ * 2880 - (fptr->Fptr)->datastart;
+
+ (fptr->Fptr)->datastart += delta;
+
+ (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] += delta;
+
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffwend(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ write the END card and following fill (space chars) in the current header
+*/
+{
+ int ii, tstatus;
+ LONGLONG endpos;
+ long nspace;
+ char blankkey[FLEN_CARD], endkey[FLEN_CARD], keyrec[FLEN_CARD] = "";
+
+ if (*status > 0)
+ return(*status);
+
+ endpos = (fptr->Fptr)->headend;
+
+ /* we assume that the HDUposition == curhdu in all cases */
+
+ /* calc the data starting position if not currently defined */
+ if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ (fptr->Fptr)->datastart = ( endpos / 2880 + 1 ) * 2880;
+
+ /* calculate the number of blank keyword slots in the header */
+ nspace = (long) (( (fptr->Fptr)->datastart - endpos ) / 80);
+
+ /* construct a blank and END keyword (80 spaces ) */
+ strcpy(blankkey, " ");
+ strcat(blankkey, " ");
+ strcpy(endkey, "END ");
+ strcat(endkey, " ");
+
+ /* check if header is already correctly terminated with END and fill */
+ tstatus=0;
+ ffmbyt(fptr, endpos, REPORT_EOF, &tstatus); /* move to header end */
+ for (ii=0; ii < nspace; ii++)
+ {
+ ffgbyt(fptr, 80, keyrec, &tstatus); /* get next keyword */
+ if (tstatus) break;
+ if (strncmp(keyrec, blankkey, 80) && strncmp(keyrec, endkey, 80))
+ break;
+ }
+
+ if (ii == nspace && !tstatus)
+ {
+ /* check if the END keyword exists at the correct position */
+ endpos=maxvalue( endpos, ( (fptr->Fptr)->datastart - 2880 ) );
+ ffmbyt(fptr, endpos, REPORT_EOF, &tstatus); /* move to END position */
+ ffgbyt(fptr, 80, keyrec, &tstatus); /* read the END keyword */
+ if ( !strncmp(keyrec, endkey, 80) && !tstatus) {
+
+ /* store this position, for later reference */
+ (fptr->Fptr)->ENDpos = endpos;
+
+ return(*status); /* END card was already correct */
+ }
+ }
+
+ /* header was not correctly terminated, so write the END and blank fill */
+ endpos = (fptr->Fptr)->headend;
+ ffmbyt(fptr, endpos, IGNORE_EOF, status); /* move to header end */
+ for (ii=0; ii < nspace; ii++)
+ ffpbyt(fptr, 80, blankkey, status); /* write the blank keywords */
+
+ /*
+ The END keyword must either be placed immediately after the last
+ keyword that was written (as indicated by the headend value), or
+ must be in the first 80 bytes of the 2880-byte FITS record immediately
+ preceeding the data unit, whichever is further in the file. The
+ latter will occur if space has been reserved for more header keywords
+ which have not yet been written.
+ */
+
+ endpos=maxvalue( endpos, ( (fptr->Fptr)->datastart - 2880 ) );
+ ffmbyt(fptr, endpos, REPORT_EOF, status); /* move to END position */
+
+ ffpbyt(fptr, 80, endkey, status); /* write the END keyword to header */
+
+ /* store this position, for later reference */
+ (fptr->Fptr)->ENDpos = endpos;
+
+ if (*status > 0)
+ ffpmsg("Error while writing END card (ffwend).");
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpdfl(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ Write the Data Unit Fill values if they are not already correct.
+ The fill values are used to fill out the last 2880 byte block of the HDU.
+ Fill the data unit with zeros or blanks depending on the type of HDU
+ from the end of the data to the end of the current FITS 2880 byte block
+*/
+{
+ char chfill, fill[2880];
+ LONGLONG fillstart;
+ int nfill, tstatus, ii;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ return(*status); /* fill has already been correctly written */
+
+ if ((fptr->Fptr)->heapstart == 0)
+ return(*status); /* null data unit, so there is no fill */
+
+ fillstart = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart +
+ (fptr->Fptr)->heapsize;
+
+ nfill = (long) ((fillstart + 2879) / 2880 * 2880 - fillstart);
+
+ if ((fptr->Fptr)->hdutype == ASCII_TBL)
+ chfill = 32; /* ASCII tables are filled with spaces */
+ else
+ chfill = 0; /* all other extensions are filled with zeros */
+
+ tstatus = 0;
+
+ if (!nfill) /* no fill bytes; just check that entire table exists */
+ {
+ fillstart--;
+ nfill = 1;
+ ffmbyt(fptr, fillstart, REPORT_EOF, &tstatus); /* move to last byte */
+ ffgbyt(fptr, nfill, fill, &tstatus); /* get the last byte */
+
+ if (tstatus == 0)
+ return(*status); /* no EOF error, so everything is OK */
+ }
+ else
+ {
+ ffmbyt(fptr, fillstart, REPORT_EOF, &tstatus); /* move to fill area */
+ ffgbyt(fptr, nfill, fill, &tstatus); /* get the fill bytes */
+
+ if (tstatus == 0)
+ {
+ for (ii = 0; ii < nfill; ii++)
+ {
+ if (fill[ii] != chfill)
+ break;
+ }
+
+ if (ii == nfill)
+ return(*status); /* all the fill values were correct */
+ }
+ }
+
+ /* fill values are incorrect or have not been written, so write them */
+
+ memset(fill, chfill, nfill); /* fill the buffer with the fill value */
+
+ ffmbyt(fptr, fillstart, IGNORE_EOF, status); /* move to fill area */
+ ffpbyt(fptr, nfill, fill, status); /* write the fill bytes */
+
+ if (*status > 0)
+ ffpmsg("Error writing Data Unit fill bytes (ffpdfl).");
+
+ return(*status);
+}
+/**********************************************************************
+ ffchfl : Check Header Fill values
+
+ Check that the header unit is correctly filled with blanks from
+ the END card to the end of the current FITS 2880-byte block
+
+ Function parameters:
+ fptr Fits file pointer
+ status output error status
+
+ Translated ftchfl into C by Peter Wilson, Oct. 1997
+**********************************************************************/
+int ffchfl( fitsfile *fptr, int *status)
+{
+ int nblank,i,gotend;
+ LONGLONG endpos;
+ char rec[FLEN_CARD];
+ char *blanks=" "; /* 80 spaces */
+
+ if( *status > 0 ) return (*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ /* calculate the number of blank keyword slots in the header */
+
+ endpos=(fptr->Fptr)->headend;
+ nblank=(long) (((fptr->Fptr)->datastart-endpos)/80);
+
+ /* move the i/o pointer to the end of the header keywords */
+
+ ffmbyt(fptr,endpos,TRUE,status);
+
+ /* find the END card (there may be blank keywords perceeding it) */
+
+ gotend=FALSE;
+ for(i=0;i<nblank;i++) {
+ ffgbyt(fptr,80,rec,status);
+ if( !strncmp(rec, "END ", 8) ) {
+ if( gotend ) {
+ /* There is a duplicate END record */
+ *status=BAD_HEADER_FILL;
+ ffpmsg("Warning: Header fill area contains duplicate END card:");
+ }
+ gotend=TRUE;
+ if( strncmp( rec+8, blanks+8, 72) ) {
+ /* END keyword has extra characters */
+ *status=END_JUNK;
+ ffpmsg(
+ "Warning: END keyword contains extraneous non-blank characters:");
+ }
+ } else if( gotend ) {
+ if( strncmp( rec, blanks, 80 ) ) {
+ /* The fill area contains extraneous characters */
+ *status=BAD_HEADER_FILL;
+ ffpmsg(
+ "Warning: Header fill area contains extraneous non-blank characters:");
+ }
+ }
+
+ if( *status > 0 ) {
+ rec[FLEN_CARD - 1] = '\0'; /* make sure string is null terminated */
+ ffpmsg(rec);
+ return( *status );
+ }
+ }
+ return( *status );
+}
+
+/**********************************************************************
+ ffcdfl : Check Data Unit Fill values
+
+ Check that the data unit is correctly filled with zeros or
+ blanks from the end of the data to the end of the current
+ FITS 2880 byte block
+
+ Function parameters:
+ fptr Fits file pointer
+ status output error status
+
+ Translated ftcdfl into C by Peter Wilson, Oct. 1997
+**********************************************************************/
+int ffcdfl( fitsfile *fptr, int *status)
+{
+ int nfill,i;
+ LONGLONG filpos;
+ char chfill,chbuff[2880];
+
+ if( *status > 0 ) return( *status );
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ /* check if the data unit is null */
+ if( (fptr->Fptr)->heapstart==0 ) return( *status );
+
+ /* calculate starting position of the fill bytes, if any */
+ filpos = (fptr->Fptr)->datastart
+ + (fptr->Fptr)->heapstart
+ + (fptr->Fptr)->heapsize;
+
+ /* calculate the number of fill bytes */
+ nfill = (long) ((filpos + 2879) / 2880 * 2880 - filpos);
+ if( nfill == 0 ) return( *status );
+
+ /* move to the beginning of the fill bytes */
+ ffmbyt(fptr, filpos, FALSE, status);
+
+ if( ffgbyt(fptr, nfill, chbuff, status) > 0)
+ {
+ ffpmsg("Error reading data unit fill bytes (ffcdfl).");
+ return( *status );
+ }
+
+ if( (fptr->Fptr)->hdutype==ASCII_TBL )
+ chfill = 32; /* ASCII tables are filled with spaces */
+ else
+ chfill = 0; /* all other extensions are filled with zeros */
+
+ /* check for all zeros or blanks */
+
+ for(i=0;i<nfill;i++) {
+ if( chbuff[i] != chfill ) {
+ *status=BAD_DATA_FILL;
+ if( (fptr->Fptr)->hdutype==ASCII_TBL )
+ ffpmsg("Warning: remaining bytes following ASCII table data are not filled with blanks.");
+ else
+ ffpmsg("Warning: remaining bytes following data are not filled with zeros.");
+ return( *status );
+ }
+ }
+ return( *status );
+}
+/*--------------------------------------------------------------------------*/
+int ffcrhd(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ CReate Header Data unit: Create, initialize, and move the i/o pointer
+ to a new extension appended to the end of the FITS file.
+*/
+{
+ int tstatus = 0;
+ LONGLONG bytepos, *ptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ /* If the current header is empty, we don't have to do anything */
+ if ((fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+ return(*status);
+
+ while (ffmrhd(fptr, 1, 0, &tstatus) == 0); /* move to end of file */
+
+ if ((fptr->Fptr)->maxhdu == (fptr->Fptr)->MAXHDU)
+ {
+ /* allocate more space for the headstart array */
+ ptr = (LONGLONG*) realloc( (fptr->Fptr)->headstart,
+ ((fptr->Fptr)->MAXHDU + 1001) * sizeof(LONGLONG) );
+
+ if (ptr == NULL)
+ return (*status = MEMORY_ALLOCATION);
+ else {
+ (fptr->Fptr)->MAXHDU = (fptr->Fptr)->MAXHDU + 1000;
+ (fptr->Fptr)->headstart = ptr;
+ }
+ }
+
+ if (ffchdu(fptr, status) <= 0) /* close the current HDU */
+ {
+ bytepos = (fptr->Fptr)->headstart[(fptr->Fptr)->maxhdu + 1]; /* last */
+ ffmbyt(fptr, bytepos, IGNORE_EOF, status); /* move file ptr to it */
+ (fptr->Fptr)->maxhdu++; /* increment the known number of HDUs */
+ (fptr->Fptr)->curhdu = (fptr->Fptr)->maxhdu; /* set current HDU loc */
+ fptr->HDUposition = (fptr->Fptr)->maxhdu; /* set current HDU loc */
+ (fptr->Fptr)->nextkey = bytepos; /* next keyword = start of header */
+ (fptr->Fptr)->headend = bytepos; /* end of header */
+ (fptr->Fptr)->datastart = DATA_UNDEFINED; /* start data unit undefined */
+
+ /* any other needed resets */
+
+ /* reset the dithering offset that may have been calculated for the */
+ /* previous HDU back to the requested default value */
+ (fptr->Fptr)->dither_offset = (fptr->Fptr)->request_dither_offset;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdblk(fitsfile *fptr, /* I - FITS file pointer */
+ long nblocks, /* I - number of 2880-byte blocks to delete */
+ int *status) /* IO - error status */
+/*
+ Delete the specified number of 2880-byte blocks from the end
+ of the CHDU by shifting all following extensions up this
+ number of blocks.
+*/
+{
+ char buffer[2880];
+ int tstatus, ii;
+ LONGLONG readpos, writepos;
+
+ if (*status > 0 || nblocks <= 0)
+ return(*status);
+
+ tstatus = 0;
+ /* pointers to the read and write positions */
+
+ readpos = (fptr->Fptr)->datastart +
+ (fptr->Fptr)->heapstart +
+ (fptr->Fptr)->heapsize;
+ readpos = ((readpos + 2879) / 2880) * 2880; /* start of block */
+
+/* the following formula is wrong because the current data unit
+ may have been extended without updating the headstart value
+ of the following HDU.
+
+ readpos = (fptr->Fptr)->headstart[((fptr->Fptr)->curhdu) + 1];
+*/
+ writepos = readpos - ((LONGLONG)nblocks * 2880);
+
+ while ( !ffmbyt(fptr, readpos, REPORT_EOF, &tstatus) &&
+ !ffgbyt(fptr, 2880L, buffer, &tstatus) )
+ {
+ ffmbyt(fptr, writepos, REPORT_EOF, status);
+ ffpbyt(fptr, 2880L, buffer, status);
+
+ if (*status > 0)
+ {
+ ffpmsg("Error deleting FITS blocks (ffdblk)");
+ return(*status);
+ }
+ readpos += 2880; /* increment to next block to transfer */
+ writepos += 2880;
+ }
+
+ /* now fill the last nblock blocks with zeros */
+ memset(buffer, 0, 2880);
+ ffmbyt(fptr, writepos, REPORT_EOF, status);
+
+ for (ii = 0; ii < nblocks; ii++)
+ ffpbyt(fptr, 2880L, buffer, status);
+
+ /* move back before the deleted blocks, since they may be deleted */
+ /* and we do not want to delete the current active buffer */
+ ffmbyt(fptr, writepos - 1, REPORT_EOF, status);
+
+ /* truncate the file to the new size, if supported on this device */
+ fftrun(fptr, writepos, status);
+
+ /* recalculate the starting location of all subsequent HDUs */
+ for (ii = (fptr->Fptr)->curhdu; ii <= (fptr->Fptr)->maxhdu; ii++)
+ (fptr->Fptr)->headstart[ii + 1] -= ((LONGLONG)nblocks * 2880);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghdt(fitsfile *fptr, /* I - FITS file pointer */
+ int *exttype, /* O - type of extension, 0, 1, or 2 */
+ /* for IMAGE_HDU, ASCII_TBL, or BINARY_TBL */
+ int *status) /* IO - error status */
+/*
+ Return the type of the CHDU. This returns the 'logical' type of the HDU,
+ not necessarily the physical type, so in the case of a compressed image
+ stored in a binary table, this will return the type as an Image, not a
+ binary table.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition == 0 && (fptr->Fptr)->headend == 0) {
+ /* empty primary array is alway an IMAGE_HDU */
+ *exttype = IMAGE_HDU;
+ }
+ else {
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ /* rescan header if data structure is undefined */
+ if ( ffrdef(fptr, status) > 0)
+ return(*status);
+ }
+
+ *exttype = (fptr->Fptr)->hdutype; /* return the type of HDU */
+
+ /* check if this is a compressed image */
+ if ((fptr->Fptr)->compressimg)
+ *exttype = IMAGE_HDU;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_is_reentrant(void)
+/*
+ Was CFITSIO compiled with the -D_REENTRANT flag? 1 = yes, 0 = no.
+ Note that specifying the -D_REENTRANT flag is required, but may not be
+ sufficient, to ensure that CFITSIO can be safely used in a multi-threaded
+ environoment.
+*/
+{
+#ifdef _REENTRANT
+ return(1);
+#else
+ return(0);
+#endif
+}
+/*--------------------------------------------------------------------------*/
+int fits_is_compressed_image(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ Returns TRUE if the CHDU is a compressed image, else returns zero.
+*/
+{
+ if (*status > 0)
+ return(0);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ /* rescan header if data structure is undefined */
+ if ( ffrdef(fptr, status) > 0)
+ return(*status);
+ }
+
+ /* check if this is a compressed image */
+ if ((fptr->Fptr)->compressimg)
+ return(1);
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int ffgipr(fitsfile *infptr, /* I - FITS file pointer */
+ int maxaxis, /* I - max number of axes to return */
+ int *bitpix, /* O - image data type */
+ int *naxis, /* O - image dimension (NAXIS value) */
+ long *naxes, /* O - size of image dimensions */
+ int *status) /* IO - error status */
+
+/*
+ get the datatype and size of the input image
+*/
+{
+
+ if (*status > 0)
+ return(*status);
+
+ /* don't return the parameter if a null pointer was given */
+
+ if (bitpix)
+ fits_get_img_type(infptr, bitpix, status); /* get BITPIX value */
+
+ if (naxis)
+ fits_get_img_dim(infptr, naxis, status); /* get NAXIS value */
+
+ if (naxes)
+ fits_get_img_size(infptr, maxaxis, naxes, status); /* get NAXISn values */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgiprll(fitsfile *infptr, /* I - FITS file pointer */
+ int maxaxis, /* I - max number of axes to return */
+ int *bitpix, /* O - image data type */
+ int *naxis, /* O - image dimension (NAXIS value) */
+ LONGLONG *naxes, /* O - size of image dimensions */
+ int *status) /* IO - error status */
+
+/*
+ get the datatype and size of the input image
+*/
+{
+
+ if (*status > 0)
+ return(*status);
+
+ /* don't return the parameter if a null pointer was given */
+
+ if (bitpix)
+ fits_get_img_type(infptr, bitpix, status); /* get BITPIX value */
+
+ if (naxis)
+ fits_get_img_dim(infptr, naxis, status); /* get NAXIS value */
+
+ if (naxes)
+ fits_get_img_sizell(infptr, maxaxis, naxes, status); /* get NAXISn values */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgidt( fitsfile *fptr, /* I - FITS file pointer */
+ int *imgtype, /* O - image data type */
+ int *status) /* IO - error status */
+/*
+ Get the datatype of the image (= BITPIX keyword for normal image, or
+ ZBITPIX for a compressed image)
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ /* reset to beginning of header */
+ ffmaky(fptr, 1, status); /* simply move to beginning of header */
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ ffgky(fptr, TINT, "BITPIX", imgtype, NULL, status);
+ }
+ else if ((fptr->Fptr)->compressimg)
+ {
+ /* this is a binary table containing a compressed image */
+ ffgky(fptr, TINT, "ZBITPIX", imgtype, NULL, status);
+ }
+ else
+ {
+ *status = NOT_IMAGE;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgiet( fitsfile *fptr, /* I - FITS file pointer */
+ int *imgtype, /* O - image data type */
+ int *status) /* IO - error status */
+/*
+ Get the effective datatype of the image (= BITPIX keyword for normal image,
+ or ZBITPIX for a compressed image)
+*/
+{
+ int tstatus;
+ long lngscale, lngzero = 0;
+ double bscale, bzero, min_val, max_val;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ /* reset to beginning of header */
+ ffmaky(fptr, 2, status); /* simply move to beginning of header */
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ ffgky(fptr, TINT, "BITPIX", imgtype, NULL, status);
+ }
+ else if ((fptr->Fptr)->compressimg)
+ {
+ /* this is a binary table containing a compressed image */
+ ffgky(fptr, TINT, "ZBITPIX", imgtype, NULL, status);
+ }
+ else
+ {
+ *status = NOT_IMAGE;
+ return(*status);
+
+ }
+
+ /* check if the BSCALE and BZERO keywords are defined, which might
+ change the effective datatype of the image */
+ tstatus = 0;
+ ffgky(fptr, TDOUBLE, "BSCALE", &bscale, NULL, &tstatus);
+ if (tstatus)
+ bscale = 1.0;
+
+ tstatus = 0;
+ ffgky(fptr, TDOUBLE, "BZERO", &bzero, NULL, &tstatus);
+ if (tstatus)
+ bzero = 0.0;
+
+ if (bscale == 1.0 && bzero == 0.0) /* no scaling */
+ return(*status);
+
+ switch (*imgtype)
+ {
+ case BYTE_IMG: /* 8-bit image */
+ min_val = 0.;
+ max_val = 255.0;
+ break;
+
+ case SHORT_IMG:
+ min_val = -32768.0;
+ max_val = 32767.0;
+ break;
+
+ case LONG_IMG:
+
+ min_val = -2147483648.0;
+ max_val = 2147483647.0;
+ break;
+
+ default: /* don't have to deal with other data types */
+ return(*status);
+ }
+
+ if (bscale >= 0.) {
+ min_val = bzero + bscale * min_val;
+ max_val = bzero + bscale * max_val;
+ } else {
+ max_val = bzero + bscale * min_val;
+ min_val = bzero + bscale * max_val;
+ }
+ if (bzero < 2147483648.) /* don't exceed range of 32-bit integer */
+ lngzero = (long) bzero;
+ lngscale = (long) bscale;
+
+ if ((bzero != 2147483648.) && /* special value that exceeds integer range */
+ (lngzero != bzero || lngscale != bscale)) { /* not integers? */
+ /* floating point scaled values; just decide on required precision */
+ if (*imgtype == BYTE_IMG || *imgtype == SHORT_IMG)
+ *imgtype = FLOAT_IMG;
+ else
+ *imgtype = DOUBLE_IMG;
+
+ /*
+ In all the remaining cases, BSCALE and BZERO are integers,
+ and not equal to 1 and 0, respectively.
+ */
+
+ } else if ((min_val == -128.) && (max_val == 127.)) {
+ *imgtype = SBYTE_IMG;
+
+ } else if ((min_val >= -32768.0) && (max_val <= 32767.0)) {
+ *imgtype = SHORT_IMG;
+
+ } else if ((min_val >= 0.0) && (max_val <= 65535.0)) {
+ *imgtype = USHORT_IMG;
+
+ } else if ((min_val >= -2147483648.0) && (max_val <= 2147483647.0)) {
+ *imgtype = LONG_IMG;
+
+ } else if ((min_val >= 0.0) && (max_val < 4294967296.0)) {
+ *imgtype = ULONG_IMG;
+
+ } else { /* exceeds the range of a 32-bit integer */
+ *imgtype = DOUBLE_IMG;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgidm( fitsfile *fptr, /* I - FITS file pointer */
+ int *naxis , /* O - image dimension (NAXIS value) */
+ int *status) /* IO - error status */
+/*
+ Get the dimension of the image (= NAXIS keyword for normal image, or
+ ZNAXIS for a compressed image)
+ These values are cached for faster access.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ *naxis = (fptr->Fptr)->imgdim;
+ }
+ else if ((fptr->Fptr)->compressimg)
+ {
+ *naxis = (fptr->Fptr)->zndim;
+ }
+ else
+ {
+ *status = NOT_IMAGE;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgisz( fitsfile *fptr, /* I - FITS file pointer */
+ int nlen, /* I - number of axes to return */
+ long *naxes, /* O - size of image dimensions */
+ int *status) /* IO - error status */
+/*
+ Get the size of the image dimensions (= NAXISn keywords for normal image, or
+ ZNAXISn for a compressed image)
+ These values are cached for faster access.
+
+*/
+{
+ int ii, naxis;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ naxis = minvalue((fptr->Fptr)->imgdim, nlen);
+ for (ii = 0; ii < naxis; ii++)
+ {
+ naxes[ii] = (long) (fptr->Fptr)->imgnaxis[ii];
+ }
+ }
+ else if ((fptr->Fptr)->compressimg)
+ {
+ naxis = minvalue( (fptr->Fptr)->zndim, nlen);
+ for (ii = 0; ii < naxis; ii++)
+ {
+ naxes[ii] = (long) (fptr->Fptr)->znaxis[ii];
+ }
+ }
+ else
+ {
+ *status = NOT_IMAGE;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgiszll( fitsfile *fptr, /* I - FITS file pointer */
+ int nlen, /* I - number of axes to return */
+ LONGLONG *naxes, /* O - size of image dimensions */
+ int *status) /* IO - error status */
+/*
+ Get the size of the image dimensions (= NAXISn keywords for normal image, or
+ ZNAXISn for a compressed image)
+*/
+{
+ int ii, naxis;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if ((fptr->Fptr)->hdutype == IMAGE_HDU)
+ {
+ naxis = minvalue((fptr->Fptr)->imgdim, nlen);
+ for (ii = 0; ii < naxis; ii++)
+ {
+ naxes[ii] = (fptr->Fptr)->imgnaxis[ii];
+ }
+ }
+ else if ((fptr->Fptr)->compressimg)
+ {
+ naxis = minvalue( (fptr->Fptr)->zndim, nlen);
+ for (ii = 0; ii < naxis; ii++)
+ {
+ naxes[ii] = (fptr->Fptr)->znaxis[ii];
+ }
+ }
+ else
+ {
+ *status = NOT_IMAGE;
+ }
+
+ return(*status);
+}/*--------------------------------------------------------------------------*/
+int ffmahd(fitsfile *fptr, /* I - FITS file pointer */
+ int hdunum, /* I - number of the HDU to move to */
+ int *exttype, /* O - type of extension, 0, 1, or 2 */
+ int *status) /* IO - error status */
+/*
+ Move to Absolute Header Data unit. Move to the specified HDU
+ and read the header to initialize the table structure. Note that extnum
+ is one based, so the primary array is extnum = 1.
+*/
+{
+ int moveto, tstatus;
+ char message[FLEN_ERRMSG];
+ LONGLONG *ptr;
+
+ if (*status > 0)
+ return(*status);
+ else if (hdunum < 1 )
+ return(*status = BAD_HDU_NUM);
+ else if (hdunum >= (fptr->Fptr)->MAXHDU )
+ {
+ /* allocate more space for the headstart array */
+ ptr = (LONGLONG*) realloc( (fptr->Fptr)->headstart,
+ (hdunum + 1001) * sizeof(LONGLONG) );
+
+ if (ptr == NULL)
+ return (*status = MEMORY_ALLOCATION);
+ else {
+ (fptr->Fptr)->MAXHDU = hdunum + 1000;
+ (fptr->Fptr)->headstart = ptr;
+ }
+ }
+
+ /* set logical HDU position to the actual position, in case they differ */
+ fptr->HDUposition = (fptr->Fptr)->curhdu;
+
+ while( ((fptr->Fptr)->curhdu) + 1 != hdunum) /* at the correct HDU? */
+ {
+ /* move directly to the extension if we know that it exists,
+ otherwise move to the highest known extension. */
+
+ moveto = minvalue(hdunum - 1, ((fptr->Fptr)->maxhdu) + 1);
+
+ /* test if HDU exists */
+ if ((fptr->Fptr)->headstart[moveto] < (fptr->Fptr)->logfilesize )
+ {
+ if (ffchdu(fptr, status) <= 0) /* close out the current HDU */
+ {
+ if (ffgext(fptr, moveto, exttype, status) > 0)
+ { /* failed to get the requested extension */
+
+ tstatus = 0;
+ ffrhdu(fptr, exttype, &tstatus); /* restore the CHDU */
+ }
+ }
+ }
+ else
+ *status = END_OF_FILE;
+
+ if (*status > 0)
+ {
+ if (*status != END_OF_FILE)
+ {
+ /* don't clutter up the message stack in the common case of */
+ /* simply hitting the end of file (often an expected error) */
+
+ sprintf(message,
+ "Failed to move to HDU number %d (ffmahd).", hdunum);
+ ffpmsg(message);
+ }
+ return(*status);
+ }
+ }
+
+ /* return the type of HDU; tile compressed images which are stored */
+ /* in a binary table will return exttype = IMAGE_HDU, not BINARY_TBL */
+ if (exttype != NULL)
+ ffghdt(fptr, exttype, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmrhd(fitsfile *fptr, /* I - FITS file pointer */
+ int hdumov, /* I - rel. no. of HDUs to move by (+ or -) */
+ int *exttype, /* O - type of extension, 0, 1, or 2 */
+ int *status) /* IO - error status */
+/*
+ Move a Relative number of Header Data units. Offset to the specified
+ extension and read the header to initialize the HDU structure.
+*/
+{
+ int extnum;
+
+ if (*status > 0)
+ return(*status);
+
+ extnum = fptr->HDUposition + 1 + hdumov; /* the absolute HDU number */
+ ffmahd(fptr, extnum, exttype, status); /* move to the HDU */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmnhd(fitsfile *fptr, /* I - FITS file pointer */
+ int exttype, /* I - desired extension type */
+ char *hduname, /* I - desired EXTNAME value for the HDU */
+ int hduver, /* I - desired EXTVERS value for the HDU */
+ int *status) /* IO - error status */
+/*
+ Move to the next HDU with a given extension type (IMAGE_HDU, ASCII_TBL,
+ BINARY_TBL, or ANY_HDU), extension name (EXTNAME or HDUNAME keyword),
+ and EXTVERS keyword values. If hduvers = 0, then move to the first HDU
+ with the given type and name regardless of EXTVERS value. If no matching
+ HDU is found in the file, then the current open HDU will remain unchanged.
+*/
+{
+ char extname[FLEN_VALUE];
+ int ii, hdutype, alttype, extnum, tstatus, match, exact;
+ int slen, putback = 0, chopped = 0;
+ long extver;
+
+ if (*status > 0)
+ return(*status);
+
+ extnum = fptr->HDUposition + 1; /* save the current HDU number */
+
+ /*
+ This is a kludge to deal with a special case where the
+ user specified a hduname that ended with a # character, which
+ CFITSIO previously interpreted as a flag to mean "don't copy any
+ other HDUs in the file into the virtual file in memory. If the
+ remaining hduname does not end with a # character (meaning that
+ the user originally entered a hduname ending in 2 # characters)
+ then there is the possibility that the # character should be
+ treated literally, if the actual EXTNAME also ends with a #.
+ Setting putback = 1 means that we need to test for this case later on.
+ */
+
+ if ((fptr->Fptr)->only_one) { /* if true, name orignally ended with a # */
+ slen = strlen(hduname);
+ if (hduname[slen - 1] != '#') /* This will fail if real EXTNAME value */
+ putback = 1; /* ends with 2 # characters. */
+ }
+
+ for (ii=1; 1; ii++) /* loop over all HDUs until EOF */
+ {
+ tstatus = 0;
+ if (ffmahd(fptr, ii, &hdutype, &tstatus)) /* move to next HDU */
+ {
+ ffmahd(fptr, extnum, 0, status); /* restore original file position */
+ return(*status = BAD_HDU_NUM); /* couldn't find desired HDU */
+ }
+
+ alttype = -1;
+ if (fits_is_compressed_image(fptr, status))
+ alttype = BINARY_TBL;
+
+ /* Does this HDU have a matching type? */
+ if (exttype == ANY_HDU || hdutype == exttype || hdutype == alttype)
+ {
+ ffmaky(fptr, 2, status); /* reset to the 2nd keyword in the header */
+ if (ffgkys(fptr, "EXTNAME", extname, 0, &tstatus) <= 0) /* get keyword */
+ {
+ if (putback) { /* more of the kludge */
+ /* test if the EXTNAME value ends with a #; if so, chop it */
+ /* off before comparing the strings */
+ chopped = 0;
+ slen = strlen(extname);
+ if (extname[slen - 1] == '#') {
+ extname[slen - 1] = '\0';
+ chopped = 1;
+ }
+ }
+
+ /* see if the strings are an exact match */
+ ffcmps(extname, hduname, CASEINSEN, &match, &exact);
+ }
+
+ /* if EXTNAME keyword doesn't exist, or it does not match, then try HDUNAME */
+ if (tstatus || !exact)
+ {
+ tstatus = 0;
+ if (ffgkys(fptr, "HDUNAME", extname, 0, &tstatus) <= 0)
+ {
+ if (putback) { /* more of the kludge */
+ chopped = 0;
+ slen = strlen(extname);
+ if (extname[slen - 1] == '#') {
+ extname[slen - 1] = '\0'; /* chop off the # */
+ chopped = 1;
+ }
+ }
+
+ /* see if the strings are an exact match */
+ ffcmps(extname, hduname, CASEINSEN, &match, &exact);
+ }
+ }
+
+ if (!tstatus && exact) /* found a matching name */
+ {
+ if (hduver) /* need to check if version numbers match? */
+ {
+ if (ffgkyj(fptr, "EXTVER", &extver, 0, &tstatus) > 0)
+ extver = 1; /* assume default EXTVER value */
+
+ if ( (int) extver == hduver)
+ {
+ if (chopped) {
+ /* The # was literally part of the name, not a flag */
+ (fptr->Fptr)->only_one = 0;
+ }
+ return(*status); /* found matching name and vers */
+ }
+ }
+ else
+ {
+ if (chopped) {
+ /* The # was literally part of the name, not a flag */
+ (fptr->Fptr)->only_one = 0;
+ }
+ return(*status); /* found matching name */
+ }
+ } /* end of !tstatus && exact */
+
+ } /* end of matching HDU type */
+ } /* end of loop over HDUs */
+}
+/*--------------------------------------------------------------------------*/
+int ffthdu(fitsfile *fptr, /* I - FITS file pointer */
+ int *nhdu, /* O - number of HDUs in the file */
+ int *status) /* IO - error status */
+/*
+ Return the number of HDUs that currently exist in the file.
+*/
+{
+ int ii, extnum, tstatus;
+
+ if (*status > 0)
+ return(*status);
+
+ extnum = fptr->HDUposition + 1; /* save the current HDU number */
+ *nhdu = extnum - 1;
+
+ /* if the CHDU is empty or not completely defined, just return */
+ if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ return(*status);
+
+ tstatus = 0;
+
+ /* loop until EOF */
+ for (ii=extnum; ffmahd(fptr, ii, 0, &tstatus) <= 0; ii++)
+ {
+ *nhdu = ii;
+ }
+
+ ffmahd(fptr, extnum, 0, status); /* restore orig file position */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgext(fitsfile *fptr, /* I - FITS file pointer */
+ int hdunum, /* I - no. of HDU to move get (0 based) */
+ int *exttype, /* O - type of extension, 0, 1, or 2 */
+ int *status) /* IO - error status */
+/*
+ Get Extension. Move to the specified extension and initialize the
+ HDU structure.
+*/
+{
+ int xcurhdu, xmaxhdu;
+ LONGLONG xheadend;
+
+ if (*status > 0)
+ return(*status);
+
+ if (ffmbyt(fptr, (fptr->Fptr)->headstart[hdunum], REPORT_EOF, status) <= 0)
+ {
+ /* temporarily save current values, in case of error */
+ xcurhdu = (fptr->Fptr)->curhdu;
+ xmaxhdu = (fptr->Fptr)->maxhdu;
+ xheadend = (fptr->Fptr)->headend;
+
+ /* set new parameter values */
+ (fptr->Fptr)->curhdu = hdunum;
+ fptr->HDUposition = hdunum;
+ (fptr->Fptr)->maxhdu = maxvalue((fptr->Fptr)->maxhdu, hdunum);
+ (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize; /* set max size */
+
+ if (ffrhdu(fptr, exttype, status) > 0)
+ { /* failed to get the new HDU, so restore previous values */
+ (fptr->Fptr)->curhdu = xcurhdu;
+ fptr->HDUposition = xcurhdu;
+ (fptr->Fptr)->maxhdu = xmaxhdu;
+ (fptr->Fptr)->headend = xheadend;
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffiblk(fitsfile *fptr, /* I - FITS file pointer */
+ long nblock, /* I - no. of blocks to insert */
+ int headdata, /* I - insert where? 0=header, 1=data */
+ /* -1=beginning of file */
+ int *status) /* IO - error status */
+/*
+ insert 2880-byte blocks at the end of the current header or data unit
+*/
+{
+ int tstatus, savehdu, typhdu;
+ LONGLONG insertpt, jpoint;
+ long ii, nshift;
+ char charfill;
+ char buff1[2880], buff2[2880];
+ char *inbuff, *outbuff, *tmpbuff;
+ char card[FLEN_CARD];
+
+ if (*status > 0 || nblock <= 0)
+ return(*status);
+
+ tstatus = *status;
+
+ if (headdata == 0 || (fptr->Fptr)->hdutype == ASCII_TBL)
+ charfill = 32; /* headers and ASCII tables have space (32) fill */
+ else
+ charfill = 0; /* images and binary tables have zero fill */
+
+ if (headdata == 0)
+ insertpt = (fptr->Fptr)->datastart; /* insert just before data, or */
+ else if (headdata == -1)
+ {
+ insertpt = 0;
+ strcpy(card, "XTENSION= 'IMAGE ' / IMAGE extension");
+ }
+ else /* at end of data, */
+ {
+ insertpt = (fptr->Fptr)->datastart +
+ (fptr->Fptr)->heapstart +
+ (fptr->Fptr)->heapsize;
+ insertpt = ((insertpt + 2879) / 2880) * 2880; /* start of block */
+
+ /* the following formula is wrong because the current data unit
+ may have been extended without updating the headstart value
+ of the following HDU.
+ */
+ /* insertpt = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu + 1]; */
+ }
+
+ inbuff = buff1; /* set pointers to input and output buffers */
+ outbuff = buff2;
+
+ memset(outbuff, charfill, 2880); /* initialize buffer with fill */
+
+ if (nblock == 1) /* insert one block */
+ {
+ if (headdata == -1)
+ ffmrec(fptr, 1, card, status); /* change SIMPLE -> XTENSION */
+
+ ffmbyt(fptr, insertpt, REPORT_EOF, status); /* move to 1st point */
+ ffgbyt(fptr, 2880, inbuff, status); /* read first block of bytes */
+
+ while (*status <= 0)
+ {
+ ffmbyt(fptr, insertpt, REPORT_EOF, status); /* insert point */
+ ffpbyt(fptr, 2880, outbuff, status); /* write the output buffer */
+
+ if (*status > 0)
+ return(*status);
+
+ tmpbuff = inbuff; /* swap input and output pointers */
+ inbuff = outbuff;
+ outbuff = tmpbuff;
+ insertpt += 2880; /* increment insert point by 1 block */
+
+ ffmbyt(fptr, insertpt, REPORT_EOF, status); /* move to next block */
+ ffgbyt(fptr, 2880, inbuff, status); /* read block of bytes */
+ }
+
+ *status = tstatus; /* reset status value */
+ ffmbyt(fptr, insertpt, IGNORE_EOF, status); /* move back to insert pt */
+ ffpbyt(fptr, 2880, outbuff, status); /* write the final block */
+ }
+
+ else /* inserting more than 1 block */
+
+ {
+ savehdu = (fptr->Fptr)->curhdu; /* save the current HDU number */
+ tstatus = *status;
+ while(*status <= 0) /* find the last HDU in file */
+ ffmrhd(fptr, 1, &typhdu, status);
+
+ if (*status == END_OF_FILE)
+ {
+ *status = tstatus;
+ }
+
+ ffmahd(fptr, savehdu + 1, &typhdu, status); /* move back to CHDU */
+ if (headdata == -1)
+ ffmrec(fptr, 1, card, status); /* NOW change SIMPLE -> XTENSION */
+
+ /* number of 2880-byte blocks that have to be shifted down */
+ nshift = (long) (((fptr->Fptr)->headstart[(fptr->Fptr)->maxhdu + 1] - insertpt)
+ / 2880);
+ /* position of last block in file to be shifted */
+ jpoint = (fptr->Fptr)->headstart[(fptr->Fptr)->maxhdu + 1] - 2880;
+
+ /* move all the blocks starting at end of file working backwards */
+ for (ii = 0; ii < nshift; ii++)
+ {
+ /* move to the read start position */
+ if (ffmbyt(fptr, jpoint, REPORT_EOF, status) > 0)
+ return(*status);
+
+ ffgbyt(fptr, 2880, inbuff,status); /* read one record */
+
+ /* move forward to the write postion */
+ ffmbyt(fptr, jpoint + ((LONGLONG) nblock * 2880), IGNORE_EOF, status);
+
+ ffpbyt(fptr, 2880, inbuff, status); /* write the record */
+
+ jpoint -= 2880;
+ }
+
+ /* move back to the write start postion (might be EOF) */
+ ffmbyt(fptr, insertpt, IGNORE_EOF, status);
+
+ for (ii = 0; ii < nblock; ii++) /* insert correct fill value */
+ ffpbyt(fptr, 2880, outbuff, status);
+ }
+
+ if (headdata == 0) /* update data start address */
+ (fptr->Fptr)->datastart += ((LONGLONG) nblock * 2880);
+
+ /* update following HDU addresses */
+ for (ii = (fptr->Fptr)->curhdu; ii <= (fptr->Fptr)->maxhdu; ii++)
+ (fptr->Fptr)->headstart[ii + 1] += ((LONGLONG) nblock * 2880);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkcl(char *tcard)
+
+/*
+ Return the type classification of the input header record
+
+ TYP_STRUC_KEY: SIMPLE, BITPIX, NAXIS, NAXISn, EXTEND, BLOCKED,
+ GROUPS, PCOUNT, GCOUNT, END
+ XTENSION, TFIELDS, TTYPEn, TBCOLn, TFORMn, THEAP,
+ and the first 4 COMMENT keywords in the primary array
+ that define the FITS format.
+
+ TYP_CMPRS_KEY:
+ The experimental keywords used in the compressed image format
+ ZIMAGE, ZCMPTYPE, ZNAMEn, ZVALn, ZTILEn,
+ ZBITPIX, ZNAXISn, ZSCALE, ZZERO, ZBLANK,
+ EXTNAME = 'COMPRESSED_IMAGE'
+ ZSIMPLE, ZTENSION, ZEXTEND, ZBLOCKED, ZPCOUNT, ZGCOUNT
+
+ TYP_SCAL_KEY: BSCALE, BZERO, TSCALn, TZEROn
+
+ TYP_NULL_KEY: BLANK, TNULLn
+
+ TYP_DIM_KEY: TDIMn
+
+ TYP_RANG_KEY: TLMINn, TLMAXn, TDMINn, TDMAXn, DATAMIN, DATAMAX
+
+ TYP_UNIT_KEY: BUNIT, TUNITn
+
+ TYP_DISP_KEY: TDISPn
+
+ TYP_HDUID_KEY: EXTNAME, EXTVER, EXTLEVEL, HDUNAME, HDUVER, HDULEVEL
+
+ TYP_CKSUM_KEY CHECKSUM, DATASUM
+
+ TYP_WCS_KEY:
+ Primary array:
+ WCAXES, CTYPEn, CUNITn, CRVALn, CRPIXn, CROTAn, CDELTn
+ CDj_is, PVj_ms, LONPOLEs, LATPOLEs
+
+ Pixel list:
+ TCTYPn, TCTYns, TCUNIn, TCUNns, TCRVLn, TCRVns, TCRPXn, TCRPks,
+ TCDn_k, TCn_ks, TPVn_m, TPn_ms, TCDLTn, TCROTn
+
+ Bintable vector:
+ jCTYPn, jCTYns, jCUNIn, jCUNns, jCRVLn, jCRVns, iCRPXn, iCRPns,
+ jiCDn, jiCDns, jPVn_m, jPn_ms, jCDLTn, jCROTn
+
+ TYP_REFSYS_KEY:
+ EQUINOXs, EPOCH, MJD-OBSs, RADECSYS, RADESYSs
+
+ TYP_COMM_KEY: COMMENT, HISTORY, (blank keyword)
+
+ TYP_CONT_KEY: CONTINUE
+
+ TYP_USER_KEY: all other keywords
+
+*/
+{
+ char card[20], *card1, *card5;
+
+ card[0] = '\0';
+ strncat(card, tcard, 8); /* copy the keyword name */
+ strcat(card, " "); /* append blanks to make at least 8 chars long */
+ ffupch(card); /* make sure it is in upper case */
+
+ card1 = card + 1; /* pointer to 2nd character */
+ card5 = card + 5; /* pointer to 6th character */
+
+ /* the strncmp function is slow, so try to be more efficient */
+ if (*card == 'Z')
+ {
+ if (FSTRNCMP (card1, "IMAGE ", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "CMPTYPE", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "NAME", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_CMPRS_KEY);
+ }
+ else if (FSTRNCMP (card1, "VAL", 3) == 0)
+ {
+ if (*(card + 4) >= '0' && *(card + 4) <= '9')
+ return (TYP_CMPRS_KEY);
+ }
+ else if (FSTRNCMP (card1, "TILE", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_CMPRS_KEY);
+ }
+ else if (FSTRNCMP (card1, "BITPIX ", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "NAXIS", 5) == 0)
+ {
+ if ( ( *(card + 6) >= '0' && *(card + 6) <= '9' )
+ || (*(card + 6) == ' ') )
+ return (TYP_CMPRS_KEY);
+ }
+ else if (FSTRNCMP (card1, "SCALE ", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "ZERO ", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "BLANK ", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "SIMPLE ", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "TENSION", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "EXTEND ", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "BLOCKED", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "PCOUNT ", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ else if (FSTRNCMP (card1, "GCOUNT ", 7) == 0)
+ return (TYP_CMPRS_KEY);
+ }
+ else if (*card == ' ')
+ {
+ return (TYP_COMM_KEY);
+ }
+ else if (*card == 'B')
+ {
+ if (FSTRNCMP (card1, "ITPIX ", 7) == 0)
+ return (TYP_STRUC_KEY);
+ if (FSTRNCMP (card1, "LOCKED ", 7) == 0)
+ return (TYP_STRUC_KEY);
+
+ if (FSTRNCMP (card1, "LANK ", 7) == 0)
+ return (TYP_NULL_KEY);
+
+ if (FSTRNCMP (card1, "SCALE ", 7) == 0)
+ return (TYP_SCAL_KEY);
+ if (FSTRNCMP (card1, "ZERO ", 7) == 0)
+ return (TYP_SCAL_KEY);
+
+ if (FSTRNCMP (card1, "UNIT ", 7) == 0)
+ return (TYP_UNIT_KEY);
+ }
+ else if (*card == 'C')
+ {
+ if (FSTRNCMP (card1, "OMMENT",6) == 0)
+ {
+ /* new comment string starting Oct 2001 */
+ if (FSTRNCMP (tcard, "COMMENT and Astrophysics', volume 376, page 3",
+ 47) == 0)
+ return (TYP_STRUC_KEY);
+
+ /* original COMMENT strings from 1993 - 2001 */
+ if (FSTRNCMP (tcard, "COMMENT FITS (Flexible Image Transport System",
+ 47) == 0)
+ return (TYP_STRUC_KEY);
+ if (FSTRNCMP (tcard, "COMMENT Astrophysics Supplement Series v44/p3",
+ 47) == 0)
+ return (TYP_STRUC_KEY);
+ if (FSTRNCMP (tcard, "COMMENT Contact the NASA Science Office of St",
+ 47) == 0)
+ return (TYP_STRUC_KEY);
+ if (FSTRNCMP (tcard, "COMMENT FITS Definition document #100 and oth",
+ 47) == 0)
+ return (TYP_STRUC_KEY);
+
+ if (*(card + 7) == ' ')
+ return (TYP_COMM_KEY);
+ else
+ return (TYP_USER_KEY);
+ }
+
+ if (FSTRNCMP (card1, "HECKSUM", 7) == 0)
+ return (TYP_CKSUM_KEY);
+
+ if (FSTRNCMP (card1, "ONTINUE", 7) == 0)
+ return (TYP_CONT_KEY);
+
+ if (FSTRNCMP (card1, "TYPE",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "UNIT",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "RVAL",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "RPIX",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "ROTA",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "RDER",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "SYER",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "DELT",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (*card1 == 'D')
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ }
+ else if (*card == 'D')
+ {
+ if (FSTRNCMP (card1, "ATASUM ", 7) == 0)
+ return (TYP_CKSUM_KEY);
+ if (FSTRNCMP (card1, "ATAMIN ", 7) == 0)
+ return (TYP_RANG_KEY);
+ if (FSTRNCMP (card1, "ATAMAX ", 7) == 0)
+ return (TYP_RANG_KEY);
+ if (FSTRNCMP (card1, "ATE-OBS", 7) == 0)
+ return (TYP_REFSYS_KEY); }
+ else if (*card == 'E')
+ {
+ if (FSTRNCMP (card1, "XTEND ", 7) == 0)
+ return (TYP_STRUC_KEY);
+ if (FSTRNCMP (card1, "ND ", 7) == 0)
+ return (TYP_STRUC_KEY);
+ if (FSTRNCMP (card1, "XTNAME ", 7) == 0)
+ {
+ /* check for special compressed image value */
+ if (FSTRNCMP(tcard, "EXTNAME = 'COMPRESSED_IMAGE'", 28) == 0)
+ return (TYP_CMPRS_KEY);
+ else
+ return (TYP_HDUID_KEY);
+ }
+ if (FSTRNCMP (card1, "XTVER ", 7) == 0)
+ return (TYP_HDUID_KEY);
+ if (FSTRNCMP (card1, "XTLEVEL", 7) == 0)
+ return (TYP_HDUID_KEY);
+
+ if (FSTRNCMP (card1, "QUINOX", 6) == 0)
+ return (TYP_REFSYS_KEY);
+ if (FSTRNCMP (card1, "QUI",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_REFSYS_KEY);
+ }
+ if (FSTRNCMP (card1, "POCH ", 7) == 0)
+ return (TYP_REFSYS_KEY);
+ }
+ else if (*card == 'G')
+ {
+ if (FSTRNCMP (card1, "COUNT ", 7) == 0)
+ return (TYP_STRUC_KEY);
+ if (FSTRNCMP (card1, "ROUPS ", 7) == 0)
+ return (TYP_STRUC_KEY);
+ }
+ else if (*card == 'H')
+ {
+ if (FSTRNCMP (card1, "DUNAME ", 7) == 0)
+ return (TYP_HDUID_KEY);
+ if (FSTRNCMP (card1, "DUVER ", 7) == 0)
+ return (TYP_HDUID_KEY);
+ if (FSTRNCMP (card1, "DULEVEL", 7) == 0)
+ return (TYP_HDUID_KEY);
+
+ if (FSTRNCMP (card1, "ISTORY",6) == 0)
+ {
+ if (*(card + 7) == ' ')
+ return (TYP_COMM_KEY);
+ else
+ return (TYP_USER_KEY);
+ }
+ }
+ else if (*card == 'L')
+ {
+ if (FSTRNCMP (card1, "ONPOLE",6) == 0)
+ return (TYP_WCS_KEY);
+ if (FSTRNCMP (card1, "ATPOLE",6) == 0)
+ return (TYP_WCS_KEY);
+ if (FSTRNCMP (card1, "ONP",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "ATP",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ }
+ else if (*card == 'M')
+ {
+ if (FSTRNCMP (card1, "JD-OBS ", 7) == 0)
+ return (TYP_REFSYS_KEY);
+ if (FSTRNCMP (card1, "JDOB",4) == 0)
+ {
+ if (*(card+5) >= '0' && *(card+5) <= '9')
+ return (TYP_REFSYS_KEY);
+ }
+ }
+ else if (*card == 'N')
+ {
+ if (FSTRNCMP (card1, "AXIS", 4) == 0)
+ {
+ if ((*card5 >= '0' && *card5 <= '9')
+ || (*card5 == ' '))
+ return (TYP_STRUC_KEY);
+ }
+ }
+ else if (*card == 'P')
+ {
+ if (FSTRNCMP (card1, "COUNT ", 7) == 0)
+ return (TYP_STRUC_KEY);
+ if (*card1 == 'C')
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (*card1 == 'V')
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (*card1 == 'S')
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ }
+ else if (*card == 'R')
+ {
+ if (FSTRNCMP (card1, "ADECSYS", 7) == 0)
+ return (TYP_REFSYS_KEY);
+ if (FSTRNCMP (card1, "ADESYS", 6) == 0)
+ return (TYP_REFSYS_KEY);
+ if (FSTRNCMP (card1, "ADE",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_REFSYS_KEY);
+ }
+ }
+ else if (*card == 'S')
+ {
+ if (FSTRNCMP (card1, "IMPLE ", 7) == 0)
+ return (TYP_STRUC_KEY);
+ }
+ else if (*card == 'T')
+ {
+ if (FSTRNCMP (card1, "TYPE", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_STRUC_KEY);
+ }
+ else if (FSTRNCMP (card1, "FORM", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_STRUC_KEY);
+ }
+ else if (FSTRNCMP (card1, "BCOL", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_STRUC_KEY);
+ }
+ else if (FSTRNCMP (card1, "FIELDS ", 7) == 0)
+ return (TYP_STRUC_KEY);
+ else if (FSTRNCMP (card1, "HEAP ", 7) == 0)
+ return (TYP_STRUC_KEY);
+
+ else if (FSTRNCMP (card1, "NULL", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_NULL_KEY);
+ }
+
+ else if (FSTRNCMP (card1, "DIM", 3) == 0)
+ {
+ if (*(card + 4) >= '0' && *(card + 4) <= '9')
+ return (TYP_DIM_KEY);
+ }
+
+ else if (FSTRNCMP (card1, "UNIT", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_UNIT_KEY);
+ }
+
+ else if (FSTRNCMP (card1, "DISP", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_DISP_KEY);
+ }
+
+ else if (FSTRNCMP (card1, "SCAL", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_SCAL_KEY);
+ }
+ else if (FSTRNCMP (card1, "ZERO", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_SCAL_KEY);
+ }
+
+ else if (FSTRNCMP (card1, "LMIN", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_RANG_KEY);
+ }
+ else if (FSTRNCMP (card1, "LMAX", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_RANG_KEY);
+ }
+ else if (FSTRNCMP (card1, "DMIN", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_RANG_KEY);
+ }
+ else if (FSTRNCMP (card1, "DMAX", 4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_RANG_KEY);
+ }
+
+ else if (FSTRNCMP (card1, "CTYP",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CTY",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CUNI",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CUN",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRVL",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRV",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRPX",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRP",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CROT",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CDLT",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CDE",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRD",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CSY",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "WCS",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "C",1) == 0)
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "P",1) == 0)
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "V",1) == 0)
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "S",1) == 0)
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ }
+ else if (*card == 'X')
+ {
+ if (FSTRNCMP (card1, "TENSION", 7) == 0)
+ return (TYP_STRUC_KEY);
+ }
+ else if (*card == 'W')
+ {
+ if (FSTRNCMP (card1, "CSAXES", 6) == 0)
+ return (TYP_WCS_KEY);
+ if (FSTRNCMP (card1, "CSNAME", 6) == 0)
+ return (TYP_WCS_KEY);
+ if (FSTRNCMP (card1, "CAX", 3) == 0)
+ {
+ if (*(card + 4) >= '0' && *(card + 4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CSN", 3) == 0)
+ {
+ if (*(card + 4) >= '0' && *(card + 4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ }
+
+ else if (*card >= '0' && *card <= '9')
+ {
+ if (*card1 == 'C')
+ {
+ if (FSTRNCMP (card1, "CTYP",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CTY",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CUNI",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CUN",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRVL",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRV",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRPX",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRP",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CROT",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CDLT",4) == 0)
+ {
+ if (*card5 >= '0' && *card5 <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CDE",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CRD",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "CSY",3) == 0)
+ {
+ if (*(card+4) >= '0' && *(card+4) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ }
+ else if (FSTRNCMP (card1, "V",1) == 0)
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (FSTRNCMP (card1, "S",1) == 0)
+ {
+ if (*(card + 2) >= '0' && *(card + 2) <= '9')
+ return (TYP_WCS_KEY);
+ }
+ else if (*card1 >= '0' && *card1 <= '9')
+ { /* 2 digits at beginning of keyword */
+
+ if ( (*(card + 2) == 'P') && (*(card + 3) == 'C') )
+ {
+ if (*(card + 4) >= '0' && *(card + 4) <= '9')
+ return (TYP_WCS_KEY); /* ijPCn keyword */
+ }
+ else if ( (*(card + 2) == 'C') && (*(card + 3) == 'D') )
+ {
+ if (*(card + 4) >= '0' && *(card + 4) <= '9')
+ return (TYP_WCS_KEY); /* ijCDn keyword */
+ }
+ }
+
+ }
+
+ return (TYP_USER_KEY); /* by default all others are user keywords */
+}
+/*--------------------------------------------------------------------------*/
+int ffdtyp(char *cval, /* I - formatted string representation of the value */
+ char *dtype, /* O - datatype code: C, L, F, I, or X */
+ int *status) /* IO - error status */
+/*
+ determine implicit datatype of input string.
+ This assumes that the string conforms to the FITS standard
+ for keyword values, so may not detect all invalid formats.
+*/
+{
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (cval[0] == '\0')
+ return(*status = VALUE_UNDEFINED);
+ else if (cval[0] == '\'')
+ *dtype = 'C'; /* character string starts with a quote */
+ else if (cval[0] == 'T' || cval[0] == 'F')
+ *dtype = 'L'; /* logical = T or F character */
+ else if (cval[0] == '(')
+ *dtype = 'X'; /* complex datatype "(1.2, -3.4)" */
+ else if (strchr(cval,'.'))
+ *dtype = 'F'; /* float usualy contains a decimal point */
+ else if (strchr(cval,'E') || strchr(cval,'D') )
+ *dtype = 'F'; /* exponential contains a E or D */
+ else
+ *dtype = 'I'; /* if none of the above assume it is integer */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffinttyp(char *cval, /* I - formatted string representation of the integer */
+ int *dtype, /* O - datatype code: TBYTE, TSHORT, TUSHORT, etc */
+ int *negative, /* O - is cval negative? */
+ int *status) /* IO - error status */
+/*
+ determine implicit datatype of input integer string.
+ This assumes that the string conforms to the FITS standard
+ for integer keyword value, so may not detect all invalid formats.
+*/
+{
+ int ii, len;
+ char *p;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ *dtype = 0; /* initialize to NULL */
+ p = cval;
+
+ if (*p == '+') {
+ p++; /* ignore leading + sign */
+ } else if (*p == '-') {
+ p++;
+ *negative = 1; /* this is a negative number */
+ }
+
+ if (*p == '0') {
+ while (*p == '0') p++; /* skip leading zeros */
+
+ if (*p == 0) { /* the value is a string of 1 or more zeros */
+ *dtype = TSBYTE;
+ return(*status);
+ }
+ }
+
+ len = strlen(p);
+ for (ii = 0; ii < len; ii++) {
+ if (!isdigit(*(p+ii))) {
+ *status = BAD_INTKEY;
+ return(*status);
+ }
+ }
+
+ /* check for unambiguous cases, based on length of the string */
+ if (len == 0) {
+ *status = VALUE_UNDEFINED;
+ } else if (len < 3) {
+ *dtype = TSBYTE;
+ } else if (len == 4) {
+ *dtype = TSHORT;
+ } else if (len > 5 && len < 10) {
+ *dtype = TINT;
+ } else if (len > 10 && len < 19) {
+ *dtype = TLONGLONG;
+ } else if (len > 19) {
+ *status = BAD_INTKEY;
+ } else {
+
+ if (!(*negative)) { /* positive integers */
+ if (len == 3) {
+ if (strcmp(p,"127") <= 0 ) {
+ *dtype = TSBYTE;
+ } else if (strcmp(p,"255") <= 0 ) {
+ *dtype = TBYTE;
+ } else {
+ *dtype = TSHORT;
+ }
+ } else if (len == 5) {
+ if (strcmp(p,"32767") <= 0 ) {
+ *dtype = TSHORT;
+ } else if (strcmp(p,"65535") <= 0 ) {
+ *dtype = TUSHORT;
+ } else {
+ *dtype = TINT;
+ }
+ } else if (len == 10) {
+ if (strcmp(p,"2147483647") <= 0 ) {
+ *dtype = TINT;
+ } else if (strcmp(p,"4294967295") <= 0 ) {
+ *dtype = TUINT;
+ } else {
+ *dtype = TLONGLONG;
+ }
+ } else if (len == 19) {
+ if (strcmp(p,"9223372036854775807") <= 0 ) {
+ *dtype = TLONGLONG;
+ } else {
+ *status = BAD_INTKEY;
+ }
+ }
+
+ } else { /* negative integers */
+ if (len == 3) {
+ if (strcmp(p,"128") <= 0 ) {
+ *dtype = TSBYTE;
+ } else {
+ *dtype = TSHORT;
+ }
+ } else if (len == 5) {
+ if (strcmp(p,"32768") <= 0 ) {
+ *dtype = TSHORT;
+ } else {
+ *dtype = TINT;
+ }
+ } else if (len == 10) {
+ if (strcmp(p,"2147483648") <= 0 ) {
+ *dtype = TINT;
+ } else {
+ *dtype = TLONGLONG;
+ }
+ } else if (len == 19) {
+ if (strcmp(p,"9223372036854775808") <= 0 ) {
+ *dtype = TLONGLONG;
+ } else {
+ *status = BAD_INTKEY;
+ }
+ }
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2x(char *cval, /* I - formatted string representation of the value */
+ char *dtype, /* O - datatype code: C, L, F, I or X */
+
+ /* Only one of the following will be defined, depending on datatype */
+ long *ival, /* O - integer value */
+ int *lval, /* O - logical value */
+ char *sval, /* O - string value */
+ double *dval, /* O - double value */
+
+ int *status) /* IO - error status */
+/*
+ high level routine to convert formatted character string to its
+ intrinsic data type
+*/
+{
+ ffdtyp(cval, dtype, status); /* determine the datatype */
+
+ if (*dtype == 'I')
+ ffc2ii(cval, ival, status);
+ else if (*dtype == 'F')
+ ffc2dd(cval, dval, status);
+ else if (*dtype == 'L')
+ ffc2ll(cval, lval, status);
+ else
+ ffc2s(cval, sval, status); /* C and X formats */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2xx(char *cval, /* I - formatted string representation of the value */
+ char *dtype, /* O - datatype code: C, L, F, I or X */
+
+ /* Only one of the following will be defined, depending on datatype */
+ LONGLONG *ival, /* O - integer value */
+ int *lval, /* O - logical value */
+ char *sval, /* O - string value */
+ double *dval, /* O - double value */
+
+ int *status) /* IO - error status */
+/*
+ high level routine to convert formatted character string to its
+ intrinsic data type
+*/
+{
+ ffdtyp(cval, dtype, status); /* determine the datatype */
+
+ if (*dtype == 'I')
+ ffc2jj(cval, ival, status);
+ else if (*dtype == 'F')
+ ffc2dd(cval, dval, status);
+ else if (*dtype == 'L')
+ ffc2ll(cval, lval, status);
+ else
+ ffc2s(cval, sval, status); /* C and X formats */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2i(char *cval, /* I - string representation of the value */
+ long *ival, /* O - numerical value of the input string */
+ int *status) /* IO - error status */
+/*
+ convert formatted string to an integer value, doing implicit
+ datatype conversion if necessary.
+*/
+{
+ char dtype, sval[81], msg[81];
+ int lval;
+ double dval;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (cval[0] == '\0')
+ return(*status = VALUE_UNDEFINED); /* null value string */
+
+ /* convert the keyword to its native datatype */
+ ffc2x(cval, &dtype, ival, &lval, sval, &dval, status);
+
+ if (dtype == 'X' )
+ {
+ *status = BAD_INTKEY;
+ }
+ else if (dtype == 'C')
+ {
+ /* try reading the string as a number */
+ if (ffc2dd(sval, &dval, status) <= 0)
+ {
+ if (dval > (double) LONG_MAX || dval < (double) LONG_MIN)
+ *status = NUM_OVERFLOW;
+ else
+ *ival = (long) dval;
+ }
+ }
+ else if (dtype == 'F')
+ {
+ if (dval > (double) LONG_MAX || dval < (double) LONG_MIN)
+ *status = NUM_OVERFLOW;
+ else
+ *ival = (long) dval;
+ }
+ else if (dtype == 'L')
+ {
+ *ival = (long) lval;
+ }
+
+ if (*status > 0)
+ {
+ *ival = 0;
+ strcpy(msg,"Error in ffc2i evaluating string as an integer: ");
+ strncat(msg,cval,30);
+ ffpmsg(msg);
+ return(*status);
+ }
+
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2j(char *cval, /* I - string representation of the value */
+ LONGLONG *ival, /* O - numerical value of the input string */
+ int *status) /* IO - error status */
+/*
+ convert formatted string to a LONGLONG integer value, doing implicit
+ datatype conversion if necessary.
+*/
+{
+ char dtype, sval[81], msg[81];
+ int lval;
+ double dval;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (cval[0] == '\0')
+ return(*status = VALUE_UNDEFINED); /* null value string */
+
+ /* convert the keyword to its native datatype */
+ ffc2xx(cval, &dtype, ival, &lval, sval, &dval, status);
+
+ if (dtype == 'X' )
+ {
+ *status = BAD_INTKEY;
+ }
+ else if (dtype == 'C')
+ {
+ /* try reading the string as a number */
+ if (ffc2dd(sval, &dval, status) <= 0)
+ {
+ if (dval > (double) LONGLONG_MAX || dval < (double) LONGLONG_MIN)
+ *status = NUM_OVERFLOW;
+ else
+ *ival = (LONGLONG) dval;
+ }
+ }
+ else if (dtype == 'F')
+ {
+ if (dval > (double) LONGLONG_MAX || dval < (double) LONGLONG_MIN)
+ *status = NUM_OVERFLOW;
+ else
+ *ival = (LONGLONG) dval;
+ }
+ else if (dtype == 'L')
+ {
+ *ival = (LONGLONG) lval;
+ }
+
+ if (*status > 0)
+ {
+ *ival = 0;
+ strcpy(msg,"Error in ffc2j evaluating string as a long integer: ");
+ strncat(msg,cval,30);
+ ffpmsg(msg);
+ return(*status);
+ }
+
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2l(char *cval, /* I - string representation of the value */
+ int *lval, /* O - numerical value of the input string */
+ int *status) /* IO - error status */
+/*
+ convert formatted string to a logical value, doing implicit
+ datatype conversion if necessary
+*/
+{
+ char dtype, sval[81], msg[81];
+ long ival;
+ double dval;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (cval[0] == '\0')
+ return(*status = VALUE_UNDEFINED); /* null value string */
+
+ /* convert the keyword to its native datatype */
+ ffc2x(cval, &dtype, &ival, lval, sval, &dval, status);
+
+ if (dtype == 'C' || dtype == 'X' )
+ *status = BAD_LOGICALKEY;
+
+ if (*status > 0)
+ {
+ *lval = 0;
+ strcpy(msg,"Error in ffc2l evaluating string as a logical: ");
+ strncat(msg,cval,30);
+ ffpmsg(msg);
+ return(*status);
+ }
+
+ if (dtype == 'I')
+ {
+ if (ival)
+ *lval = 1;
+ else
+ *lval = 0;
+ }
+ else if (dtype == 'F')
+ {
+ if (dval)
+ *lval = 1;
+ else
+ *lval = 0;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2r(char *cval, /* I - string representation of the value */
+ float *fval, /* O - numerical value of the input string */
+ int *status) /* IO - error status */
+/*
+ convert formatted string to a real float value, doing implicit
+ datatype conversion if necessary
+*/
+{
+ char dtype, sval[81], msg[81];
+ int lval;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (cval[0] == '\0')
+ return(*status = VALUE_UNDEFINED); /* null value string */
+
+ ffdtyp(cval, &dtype, status); /* determine the datatype */
+
+ if (dtype == 'I' || dtype == 'F')
+ ffc2rr(cval, fval, status);
+ else if (dtype == 'L')
+ {
+ ffc2ll(cval, &lval, status);
+ *fval = (float) lval;
+ }
+ else if (dtype == 'C')
+ {
+ /* try reading the string as a number */
+ ffc2s(cval, sval, status);
+ ffc2rr(sval, fval, status);
+ }
+ else
+ *status = BAD_FLOATKEY;
+
+ if (*status > 0)
+ {
+ *fval = 0.;
+ strcpy(msg,"Error in ffc2r evaluating string as a float: ");
+ strncat(msg,cval,30);
+ ffpmsg(msg);
+ return(*status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2d(char *cval, /* I - string representation of the value */
+ double *dval, /* O - numerical value of the input string */
+ int *status) /* IO - error status */
+/*
+ convert formatted string to a double value, doing implicit
+ datatype conversion if necessary
+*/
+{
+ char dtype, sval[81], msg[81];
+ int lval;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (cval[0] == '\0')
+ return(*status = VALUE_UNDEFINED); /* null value string */
+
+ ffdtyp(cval, &dtype, status); /* determine the datatype */
+
+ if (dtype == 'I' || dtype == 'F')
+ ffc2dd(cval, dval, status);
+ else if (dtype == 'L')
+ {
+ ffc2ll(cval, &lval, status);
+ *dval = (double) lval;
+ }
+ else if (dtype == 'C')
+ {
+ /* try reading the string as a number */
+ ffc2s(cval, sval, status);
+ ffc2dd(sval, dval, status);
+ }
+ else
+ *status = BAD_DOUBLEKEY;
+
+ if (*status > 0)
+ {
+ *dval = 0.;
+ strcpy(msg,"Error in ffc2d evaluating string as a double: ");
+ strncat(msg,cval,30);
+ ffpmsg(msg);
+ return(*status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2ii(char *cval, /* I - string representation of the value */
+ long *ival, /* O - numerical value of the input string */
+ int *status) /* IO - error status */
+/*
+ convert null-terminated formatted string to an integer value
+*/
+{
+ char *loc, msg[81];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ errno = 0;
+ *ival = 0;
+ *ival = strtol(cval, &loc, 10); /* read the string as an integer */
+
+ /* check for read error, or junk following the integer */
+ if (*loc != '\0' && *loc != ' ' )
+ *status = BAD_C2I;
+
+ if (errno == ERANGE)
+ {
+ strcpy(msg,"Range Error in ffc2ii converting string to long int: ");
+ strncat(msg,cval,25);
+ ffpmsg(msg);
+
+ *status = NUM_OVERFLOW;
+ errno = 0;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2jj(char *cval, /* I - string representation of the value */
+ LONGLONG *ival, /* O - numerical value of the input string */
+ int *status) /* IO - error status */
+/*
+ convert null-terminated formatted string to an long long integer value
+*/
+{
+ char *loc, msg[81];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ errno = 0;
+ *ival = 0;
+
+#if defined(_MSC_VER)
+
+ /* Microsoft Visual C++ 6.0 does not have the strtoll function */
+ *ival = _atoi64(cval);
+ loc = cval;
+ while (*loc == ' ') loc++; /* skip spaces */
+ if (*loc == '-') loc++; /* skip minus sign */
+ if (*loc == '+') loc++; /* skip plus sign */
+ while (isdigit(*loc)) loc++; /* skip digits */
+
+#elif (USE_LL_SUFFIX == 1)
+ *ival = strtoll(cval, &loc, 10); /* read the string as an integer */
+#else
+ *ival = strtol(cval, &loc, 10); /* read the string as an integer */
+#endif
+
+ /* check for read error, or junk following the integer */
+ if (*loc != '\0' && *loc != ' ' )
+ *status = BAD_C2I;
+
+ if (errno == ERANGE)
+ {
+ strcpy(msg,"Range Error in ffc2jj converting string to longlong int: ");
+ strncat(msg,cval,25);
+ ffpmsg(msg);
+
+ *status = NUM_OVERFLOW;
+ errno = 0;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2ll(char *cval, /* I - string representation of the value: T or F */
+ int *lval, /* O - numerical value of the input string: 1 or 0 */
+ int *status) /* IO - error status */
+/*
+ convert null-terminated formatted string to a logical value
+*/
+{
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (cval[0] == 'T')
+ *lval = 1;
+ else
+ *lval = 0; /* any character besides T is considered false */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2s(char *instr, /* I - null terminated quoted input string */
+ char *outstr, /* O - null terminated output string without quotes */
+ int *status) /* IO - error status */
+/*
+ convert an input quoted string to an unquoted string by removing
+ the leading and trailing quote character. Also, replace any
+ pairs of single quote characters with just a single quote
+ character (FITS used a pair of single quotes to represent
+ a literal quote character within the string).
+*/
+{
+ int jj;
+ size_t len, ii;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (instr[0] != '\'')
+ {
+ strcpy(outstr, instr); /* no leading quote, so return input string */
+ return(*status);
+ }
+
+ len = strlen(instr);
+
+ for (ii=1, jj=0; ii < len; ii++, jj++)
+ {
+ if (instr[ii] == '\'') /* is this the closing quote? */
+ {
+ if (instr[ii+1] == '\'') /* 2 successive quotes? */
+ ii++; /* copy only one of the quotes */
+ else
+ break; /* found the closing quote, so exit this loop */
+ }
+ outstr[jj] = instr[ii]; /* copy the next character to the output */
+ }
+
+ outstr[jj] = '\0'; /* terminate the output string */
+
+ if (ii == len)
+ {
+ ffpmsg("This string value has no closing quote (ffc2s):");
+ ffpmsg(instr);
+ return(*status = 205);
+ }
+
+ for (jj--; jj >= 0; jj--) /* replace trailing blanks with nulls */
+ {
+ if (outstr[jj] == ' ')
+ outstr[jj] = 0;
+ else
+ break;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2rr(char *cval, /* I - string representation of the value */
+ float *fval, /* O - numerical value of the input string */
+ int *status) /* IO - error status */
+/*
+ convert null-terminated formatted string to a float value
+*/
+{
+ char *loc, msg[81], tval[73];
+ struct lconv *lcc = 0;
+ static char decimalpt = 0;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (!decimalpt) { /* only do this once for efficiency */
+ lcc = localeconv(); /* set structure containing local decimal point symbol */
+ decimalpt = *(lcc->decimal_point);
+ }
+
+ errno = 0;
+ *fval = 0.;
+
+ if (strchr(cval, 'D') || decimalpt == ',') {
+ /* strtod expects a comma, not a period, as the decimal point */
+ strcpy(tval, cval);
+
+ /* The C language does not support a 'D'; replace with 'E' */
+ if (loc = strchr(tval, 'D')) *loc = 'E';
+
+ if (decimalpt == ',') {
+ /* strtod expects a comma, not a period, as the decimal point */
+ if (loc = strchr(tval, '.')) *loc = ',';
+ }
+
+ *fval = (float) strtod(tval, &loc); /* read the string as an float */
+ } else {
+ *fval = (float) strtod(cval, &loc);
+ }
+
+ /* check for read error, or junk following the value */
+ if (*loc != '\0' && *loc != ' ' )
+ {
+ strcpy(msg,"Error in ffc2rr converting string to float: ");
+ strncat(msg,cval,30);
+ ffpmsg(msg);
+
+ *status = BAD_C2F;
+ }
+
+ if (errno == ERANGE)
+ {
+ strcpy(msg,"Error in ffc2rr converting string to float: ");
+ strncat(msg,cval,30);
+ ffpmsg(msg);
+
+ *status = NUM_OVERFLOW;
+ errno = 0;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffc2dd(char *cval, /* I - string representation of the value */
+ double *dval, /* O - numerical value of the input string */
+ int *status) /* IO - error status */
+/*
+ convert null-terminated formatted string to a double value
+*/
+{
+ char *loc, msg[81], tval[73];
+ struct lconv *lcc = 0;
+ static char decimalpt = 0;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (!decimalpt) { /* only do this once for efficiency */
+ lcc = localeconv(); /* set structure containing local decimal point symbol */
+ decimalpt = *(lcc->decimal_point);
+ }
+
+ errno = 0;
+ *dval = 0.;
+
+ if (strchr(cval, 'D') || decimalpt == ',') {
+ /* need to modify a temporary copy of the string before parsing it */
+ strcpy(tval, cval);
+ /* The C language does not support a 'D'; replace with 'E' */
+ if (loc = strchr(tval, 'D')) *loc = 'E';
+
+ if (decimalpt == ',') {
+ /* strtod expects a comma, not a period, as the decimal point */
+ if (loc = strchr(tval, '.')) *loc = ',';
+ }
+
+ *dval = strtod(tval, &loc); /* read the string as an double */
+ } else {
+ *dval = strtod(cval, &loc);
+ }
+
+ /* check for read error, or junk following the value */
+ if (*loc != '\0' && *loc != ' ' )
+ {
+ strcpy(msg,"Error in ffc2dd converting string to double: ");
+ strncat(msg,cval,30);
+ ffpmsg(msg);
+
+ *status = BAD_C2D;
+ }
+
+ if (errno == ERANGE)
+ {
+ strcpy(msg,"Error in ffc2dd converting string to double: ");
+ strncat(msg,cval,30);
+ ffpmsg(msg);
+
+ *status = NUM_OVERFLOW;
+ errno = 0;
+ }
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/fitsio.h b/src/plugins/cfitsio/fitsio.h
new file mode 100644
index 0000000..9425630
--- /dev/null
+++ b/src/plugins/cfitsio/fitsio.h
@@ -0,0 +1,1930 @@
+/* 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. */
+/*
+
+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."
+
+*/
+
+#ifndef _FITSIO_H
+#define _FITSIO_H
+
+#define CFITSIO_VERSION 3.30
+#define CFITSIO_MINOR 30
+#define CFITSIO_MAJOR 3
+
+#include <stdio.h>
+
+/* the following was provided by Michael Greason (GSFC) to fix a */
+/* C/Fortran compatibility problem on an SGI Altix system running */
+/* SGI ProPack 4 [this is a Novell SuSE Enterprise 9 derivative] */
+/* and using the Intel C++ and Fortran compilers (version 9.1) */
+#if defined(__INTEL_COMPILER) && defined(__itanium__)
+# define mipsFortran 1
+# define _MIPS_SZLONG 64
+#endif
+
+#if defined(linux) || defined(__APPLE__) || defined(__sgi)
+# include <sys/types.h> /* apparently needed on debian linux systems */
+#endif /* to define off_t */
+
+#include <stdlib.h> /* apparently needed to define size_t with gcc 2.8.1 */
+#include <limits.h> /* needed for LLONG_MAX and INT64_MAX definitions */
+
+/* Define the datatype for variables which store file offset values. */
+/* The newer 'off_t' datatype should be used for this purpose, but some */
+/* older compilers do not recognize this type, in which case we use 'long' */
+/* instead. Note that _OFF_T is defined (or not) in stdio.h depending */
+/* on whether _LARGEFILE_SOURCE is defined in sys/feature_tests.h */
+/* (at least on Solaris platforms using cc) */
+
+/* Debian systems require the 2nd test, below, */
+/* i.e, "(defined(linux) && defined(__off_t_defined))" */
+#if defined(_OFF_T) || (defined(linux) && defined(__off_t_defined)) || defined(_MIPS_SZLONG) || defined(__APPLE__) || defined(_AIX)
+# define OFF_T off_t
+#elif defined(_MSC_VER) && (_MSC_VER>= 1400)
+# define OFF_T long long
+#else
+# define OFF_T long
+#endif
+
+/* this block determines if the the string function name is
+ strtol or strtoll, and whether to use %ld or %lld in printf statements */
+
+/*
+ The following 2 cases for that Athon64 were removed on 4 Jan 2006;
+ they appear to be incorrect now that LONGLONG is always typedef'ed
+ to 'long long'
+ || defined(__ia64__) \
+ || defined(__x86_64__) \
+*/
+#if (defined(__alpha) && ( defined(__unix__) || defined(__NetBSD__) )) \
+ || defined(__sparcv9) || (defined(__sparc__) && defined(__arch64__)) \
+ || defined(__powerpc64__) || defined(__64BIT__) \
+ || (defined(_MIPS_SZLONG) && _MIPS_SZLONG == 64) \
+ || defined( _MSC_VER)|| defined(__BORLANDC__)
+
+# define USE_LL_SUFFIX 0
+#else
+# define USE_LL_SUFFIX 1
+#endif
+
+/*
+ Determine what 8-byte integer data type is available.
+ 'long long' is now supported by most compilers, but
+ older MS Visual C++ compilers before V7.0 use '__int64' instead.
+*/
+
+#ifndef LONGLONG_TYPE /* this may have been previously defined */
+#if defined(_MSC_VER) /* Microsoft Visual C++ */
+
+#if (_MSC_VER < 1300) /* versions earlier than V7.0 do not have 'long long' */
+ typedef __int64 LONGLONG;
+#else /* newer versions do support 'long long' */
+ typedef long long LONGLONG;
+#endif
+
+#elif defined( __BORLANDC__) /* for the Borland 5.5 compiler, in particular */
+ typedef __int64 LONGLONG;
+#else
+ typedef long long LONGLONG;
+#endif
+
+#define LONGLONG_TYPE
+#endif
+
+#ifndef LONGLONG_MAX
+
+#ifdef LLONG_MAX
+/* Linux and Solaris definition */
+#define LONGLONG_MAX LLONG_MAX
+#define LONGLONG_MIN LLONG_MIN
+
+#elif defined(LONG_LONG_MAX)
+#define LONGLONG_MAX LONG_LONG_MAX
+#define LONGLONG_MIN LONG_LONG_MIN
+
+#elif defined(__LONG_LONG_MAX__)
+/* Mac OS X & CYGWIN defintion */
+#define LONGLONG_MAX __LONG_LONG_MAX__
+#define LONGLONG_MIN (-LONGLONG_MAX -1LL)
+
+#elif defined(INT64_MAX)
+/* windows definition */
+#define LONGLONG_MAX INT64_MAX
+#define LONGLONG_MIN INT64_MIN
+
+#elif defined(_I64_MAX)
+/* windows definition */
+#define LONGLONG_MAX _I64_MAX
+#define LONGLONG_MIN _I64_MIN
+
+#elif (defined(__alpha) && ( defined(__unix__) || defined(__NetBSD__) )) \
+ || defined(__sparcv9) \
+ || defined(__ia64__) \
+ || defined(__x86_64__) \
+ || defined(_SX) \
+ || defined(__powerpc64__) || defined(__64BIT__) \
+ || (defined(_MIPS_SZLONG) && _MIPS_SZLONG == 64)
+/* sizeof(long) = 64 */
+#define LONGLONG_MAX 9223372036854775807L /* max 64-bit integer */
+#define LONGLONG_MIN (-LONGLONG_MAX -1L) /* min 64-bit integer */
+
+#else
+/* define a default value, even if it is never used */
+#define LONGLONG_MAX 9223372036854775807LL /* max 64-bit integer */
+#define LONGLONG_MIN (-LONGLONG_MAX -1LL) /* min 64-bit integer */
+
+#endif
+#endif /* end of ndef LONGLONG_MAX section */
+
+
+/* ================================================================= */
+
+
+/* The following exclusion if __CINT__ is defined is needed for ROOT */
+#ifndef __CINT__
+#include "longnam.h"
+#endif
+
+#define NIOBUF 40 /* number of IO buffers to create (default = 40) */
+ /* !! Significantly increasing NIOBUF may degrade performance !! */
+
+#define IOBUFLEN 2880 /* size in bytes of each IO buffer (DONT CHANGE!) */
+
+/* global variables */
+
+#define FLEN_FILENAME 1025 /* max length of a filename */
+#define FLEN_KEYWORD 72 /* max length of a keyword (HIERARCH convention) */
+#define FLEN_CARD 81 /* length of a FITS header card */
+#define FLEN_VALUE 71 /* max length of a keyword value string */
+#define FLEN_COMMENT 73 /* max length of a keyword comment string */
+#define FLEN_ERRMSG 81 /* max length of a FITSIO error message */
+#define FLEN_STATUS 31 /* max length of a FITSIO status text string */
+
+#define TBIT 1 /* codes for FITS table data types */
+#define TBYTE 11
+#define TSBYTE 12
+#define TLOGICAL 14
+#define TSTRING 16
+#define TUSHORT 20
+#define TSHORT 21
+#define TUINT 30
+#define TINT 31
+#define TULONG 40
+#define TLONG 41
+#define TINT32BIT 41 /* used when returning datatype of a column */
+#define TFLOAT 42
+#define TLONGLONG 81
+#define TDOUBLE 82
+#define TCOMPLEX 83
+#define TDBLCOMPLEX 163
+
+#define TYP_STRUC_KEY 10
+#define TYP_CMPRS_KEY 20
+#define TYP_SCAL_KEY 30
+#define TYP_NULL_KEY 40
+#define TYP_DIM_KEY 50
+#define TYP_RANG_KEY 60
+#define TYP_UNIT_KEY 70
+#define TYP_DISP_KEY 80
+#define TYP_HDUID_KEY 90
+#define TYP_CKSUM_KEY 100
+#define TYP_WCS_KEY 110
+#define TYP_REFSYS_KEY 120
+#define TYP_COMM_KEY 130
+#define TYP_CONT_KEY 140
+#define TYP_USER_KEY 150
+
+
+#define INT32BIT int /* 32-bit integer datatype. Currently this */
+ /* datatype is an 'int' on all useful platforms */
+ /* however, it is possible that that are cases */
+ /* where 'int' is a 2-byte integer, in which case */
+ /* INT32BIT would need to be defined as 'long'. */
+
+#define BYTE_IMG 8 /* BITPIX code values for FITS image types */
+#define SHORT_IMG 16
+#define LONG_IMG 32
+#define LONGLONG_IMG 64
+#define FLOAT_IMG -32
+#define DOUBLE_IMG -64
+ /* The following 2 codes are not true FITS */
+ /* datatypes; these codes are only used internally */
+ /* within cfitsio to make it easier for users */
+ /* to deal with unsigned integers. */
+#define SBYTE_IMG 10
+#define USHORT_IMG 20
+#define ULONG_IMG 40
+
+#define IMAGE_HDU 0 /* Primary Array or IMAGE HDU */
+#define ASCII_TBL 1 /* ASCII table HDU */
+#define BINARY_TBL 2 /* Binary table HDU */
+#define ANY_HDU -1 /* matches any HDU type */
+
+#define READONLY 0 /* options when opening a file */
+#define READWRITE 1
+
+/* adopt a hopefully obscure number to use as a null value flag */
+/* could be problems if the FITS files contain data with these values */
+#define FLOATNULLVALUE -9.11912E-36F
+#define DOUBLENULLVALUE -9.1191291391491E-36
+
+/* compression algorithm type codes */
+#define SUBTRACTIVE_DITHER_1 1
+#define MAX_COMPRESS_DIM 6
+#define RICE_1 11
+#define GZIP_1 21
+#define GZIP_2 22
+#define PLIO_1 31
+#define HCOMPRESS_1 41
+#define BZIP2_1 51 /* not publicly supported; only for test purposes */
+#define NOCOMPRESS 0
+
+#ifndef TRUE
+#define TRUE 1
+#endif
+
+#ifndef FALSE
+#define FALSE 0
+#endif
+
+#define CASESEN 1 /* do case-sensitive string match */
+#define CASEINSEN 0 /* do case-insensitive string match */
+
+#define GT_ID_ALL_URI 0 /* hierarchical grouping parameters */
+#define GT_ID_REF 1
+#define GT_ID_POS 2
+#define GT_ID_ALL 3
+#define GT_ID_REF_URI 11
+#define GT_ID_POS_URI 12
+
+#define OPT_RM_GPT 0
+#define OPT_RM_ENTRY 1
+#define OPT_RM_MBR 2
+#define OPT_RM_ALL 3
+
+#define OPT_GCP_GPT 0
+#define OPT_GCP_MBR 1
+#define OPT_GCP_ALL 2
+
+#define OPT_MCP_ADD 0
+#define OPT_MCP_NADD 1
+#define OPT_MCP_REPL 2
+#define OPT_MCP_MOV 3
+
+#define OPT_MRG_COPY 0
+#define OPT_MRG_MOV 1
+
+#define OPT_CMT_MBR 1
+#define OPT_CMT_MBR_DEL 11
+
+typedef struct /* structure used to store table column information */
+{
+ char ttype[70]; /* column name = FITS TTYPEn keyword; */
+ LONGLONG tbcol; /* offset in row to first byte of each column */
+ int tdatatype; /* datatype code of each column */
+ LONGLONG trepeat; /* repeat count of column; number of elements */
+ double tscale; /* FITS TSCALn linear scaling factor */
+ double tzero; /* FITS TZEROn linear scaling zero point */
+ LONGLONG tnull; /* FITS null value for int image or binary table cols */
+ char strnull[20]; /* FITS null value string for ASCII table columns */
+ char tform[10]; /* FITS tform keyword value */
+ long twidth; /* width of each ASCII table column */
+}tcolumn;
+
+#define VALIDSTRUC 555 /* magic value used to identify if structure is valid */
+
+typedef struct /* structure used to store basic FITS file information */
+{
+ int filehandle; /* handle returned by the file open function */
+ int driver; /* defines which set of I/O drivers should be used */
+ int open_count; /* number of opened 'fitsfiles' using this structure */
+ char *filename; /* file name */
+ int validcode; /* magic value used to verify that structure is valid */
+ int only_one; /* flag meaning only copy the specified extension */
+ LONGLONG filesize; /* current size of the physical disk file in bytes */
+ LONGLONG logfilesize; /* logical size of file, including unflushed buffers */
+ int lasthdu; /* is this the last HDU in the file? 0 = no, else yes */
+ LONGLONG bytepos; /* current logical I/O pointer position in file */
+ LONGLONG io_pos; /* current I/O pointer position in the physical file */
+ int curbuf; /* number of I/O buffer currently in use */
+ int curhdu; /* current HDU number; 0 = primary array */
+ int hdutype; /* 0 = primary array, 1 = ASCII table, 2 = binary table */
+ int writemode; /* 0 = readonly, 1 = readwrite */
+ int maxhdu; /* highest numbered HDU known to exist in the file */
+ int MAXHDU; /* dynamically allocated dimension of headstart array */
+ LONGLONG *headstart; /* byte offset in file to start of each HDU */
+ LONGLONG headend; /* byte offest in file to end of the current HDU header */
+ LONGLONG ENDpos; /* byte offest to where the END keyword was last written */
+ LONGLONG nextkey; /* byte offset in file to beginning of next keyword */
+ LONGLONG datastart; /* byte offset in file to start of the current data unit */
+ int imgdim; /* dimension of image; cached for fast access */
+ LONGLONG imgnaxis[99]; /* length of each axis; cached for fast access */
+ int tfield; /* number of fields in the table (primary array has 2 */
+ LONGLONG origrows; /* original number of rows (value of NAXIS2 keyword) */
+ LONGLONG numrows; /* number of rows in the table (dynamically updated) */
+ LONGLONG rowlength; /* length of a table row or image size (bytes) */
+ tcolumn *tableptr; /* pointer to the table structure */
+ LONGLONG heapstart; /* heap start byte relative to start of data unit */
+ LONGLONG heapsize; /* size of the heap, in bytes */
+
+ /* the following elements are related to compressed images */
+ int request_compress_type; /* requested image compression algorithm */
+ long request_tilesize[MAX_COMPRESS_DIM]; /* requested tiling size */
+
+ float request_hcomp_scale; /* requested HCOMPRESS scale factor */
+ int request_hcomp_smooth; /* requested HCOMPRESS smooth parameter */
+ int request_quantize_dither ; /* requested dithering mode when quantizing */
+ /* floating point images to integer */
+ int request_dither_offset; /* starting offset into the array of random dithering */
+ int request_lossy_int_compress; /* lossy compress integer image as if float image? */
+
+ int compressimg; /* 1 if HDU contains a compressed image, else 0 */
+ int quantize_dither; /* floating point pixel quantization algorithm */
+ char zcmptype[12]; /* compression type string */
+ int compress_type; /* type of compression algorithm */
+ int zbitpix; /* FITS data type of image (BITPIX) */
+ int zndim; /* dimension of image */
+ long znaxis[MAX_COMPRESS_DIM]; /* length of each axis */
+ long tilesize[MAX_COMPRESS_DIM]; /* size of compression tiles */
+ long maxtilelen; /* max number of pixels in each image tile */
+ long maxelem; /* maximum byte length of tile compressed arrays */
+
+ int cn_compressed; /* column number for COMPRESSED_DATA column */
+ int cn_uncompressed; /* column number for UNCOMPRESSED_DATA column */
+ int cn_gzip_data; /* column number for GZIP2 lossless compressed data */
+ int cn_zscale; /* column number for ZSCALE column */
+ int cn_zzero; /* column number for ZZERO column */
+ int cn_zblank; /* column number for the ZBLANK column */
+
+ double zscale; /* scaling value, if same for all tiles */
+ double zzero; /* zero pt, if same for all tiles */
+ double cn_bscale; /* value of the BSCALE keyword in header */
+ double cn_bzero; /* value of the BZERO keyword (may be reset) */
+ double cn_actual_bzero; /* actual value of the BZERO keyword */
+ int zblank; /* value for null pixels, if not a column */
+
+ int rice_blocksize; /* first compression parameter: pixels/block */
+ int rice_bytepix; /* 2nd compression parameter: bytes/pixel */
+ float quantize_level; /* floating point quantization level */
+ int dither_offset; /* starting offset into the array of random dithering */
+ float hcomp_scale; /* 1st hcompress compression parameter */
+ int hcomp_smooth; /* 2nd hcompress compression parameter */
+
+ int tilerow; /* row number of the uncompressed tiledata */
+ long tiledatasize; /* length of the tile data in bytes */
+ int tiletype; /* datatype of the tile (TINT, TSHORT, etc) */
+ void *tiledata; /* uncompressed tile of data, for row tilerow */
+ char *tilenullarray; /* optional array of null value flags */
+ int tileanynull; /* anynulls in this tile? */
+
+ char *iobuffer; /* pointer to FITS file I/O buffers */
+ long bufrecnum[NIOBUF]; /* file record number of each of the buffers */
+ int dirty[NIOBUF]; /* has the corresponding buffer been modified? */
+ int ageindex[NIOBUF]; /* relative age of each buffer */
+} FITSfile;
+
+typedef struct /* structure used to store basic HDU information */
+{
+ int HDUposition; /* HDU position in file; 0 = first HDU */
+ FITSfile *Fptr; /* pointer to FITS file structure */
+}fitsfile;
+
+typedef struct /* structure for the iterator function column information */
+{
+ /* elements required as input to fits_iterate_data: */
+
+ fitsfile *fptr; /* pointer to the HDU containing the column */
+ int colnum; /* column number in the table (use name if < 1) */
+ char colname[70]; /* name (= TTYPEn value) of the column (optional) */
+ int datatype; /* output datatype (converted if necessary */
+ int iotype; /* = InputCol, InputOutputCol, or OutputCol */
+
+ /* output elements that may be useful for the work function: */
+
+ void *array; /* pointer to the array (and the null value) */
+ long repeat; /* binary table vector repeat value */
+ long tlmin; /* legal minimum data value */
+ long tlmax; /* legal maximum data value */
+ char tunit[70]; /* physical unit string */
+ char tdisp[70]; /* suggested display format */
+
+} iteratorCol;
+
+#define InputCol 0 /* flag for input only iterator column */
+#define InputOutputCol 1 /* flag for input and output iterator column */
+#define OutputCol 2 /* flag for output only iterator column */
+
+/*=============================================================================
+*
+* The following wtbarr typedef is used in the fits_read_wcstab() routine,
+* which is intended for use with the WCSLIB library written by Mark
+* Calabretta, http://www.atnf.csiro.au/~mcalabre/index.html
+*
+* In order to maintain WCSLIB and CFITSIO as independent libraries it
+* was not permissible for any CFITSIO library code to include WCSLIB
+* header files, or vice versa. However, the CFITSIO function
+* fits_read_wcstab() accepts an array of structs defined by wcs.h within
+* WCSLIB. The problem then was to define this struct within fitsio.h
+* without including wcs.h, especially noting that wcs.h will often (but
+* not always) be included together with fitsio.h in an applications
+* program that uses fits_read_wcstab().
+*
+* Of the various possibilities, the solution adopted was for WCSLIB to
+* define "struct wtbarr" while fitsio.h defines "typedef wtbarr", a
+* untagged struct with identical members. This allows both wcs.h and
+* fitsio.h to define a wtbarr data type without conflict by virtue of
+* the fact that structure tags and typedef names share different
+* namespaces in C. Therefore, declarations within WCSLIB look like
+*
+* struct wtbarr *w;
+*
+* while within CFITSIO they are simply
+*
+* wtbarr *w;
+*
+* but as suggested by the commonality of the names, these are really the
+* same aggregate data type. However, in passing a (struct wtbarr *) to
+* fits_read_wcstab() a cast to (wtbarr *) is formally required.
+*===========================================================================*/
+
+#ifndef WCSLIB_GETWCSTAB
+#define WCSLIB_GETWCSTAB
+
+typedef struct {
+ int i; /* Image axis number. */
+ int m; /* Array axis number for index vectors. */
+ int kind; /* Array type, 'c' (coord) or 'i' (index). */
+ char extnam[72]; /* EXTNAME of binary table extension. */
+ int extver; /* EXTVER of binary table extension. */
+ int extlev; /* EXTLEV of binary table extension. */
+ char ttype[72]; /* TTYPEn of column containing the array. */
+ long row; /* Table row number. */
+ int ndim; /* Expected array dimensionality. */
+ int *dimlen; /* Where to write the array axis lengths. */
+ double **arrayp; /* Where to write the address of the array */
+ /* allocated to store the array. */
+} wtbarr;
+
+int fits_read_wcstab(fitsfile *fptr, int nwtb, wtbarr *wtb, int *status);
+
+#endif /* WCSLIB_GETWCSTAB */
+
+/* error status codes */
+
+#define CREATE_DISK_FILE -106 /* create disk file, without extended filename syntax */
+#define OPEN_DISK_FILE -105 /* open disk file, without extended filename syntax */
+#define SKIP_TABLE -104 /* move to 1st image when opening file */
+#define SKIP_IMAGE -103 /* move to 1st table when opening file */
+#define SKIP_NULL_PRIMARY -102 /* skip null primary array when opening file */
+#define USE_MEM_BUFF -101 /* use memory buffer when opening file */
+#define OVERFLOW_ERR -11 /* overflow during datatype conversion */
+#define PREPEND_PRIMARY -9 /* used in ffiimg to insert new primary array */
+#define SAME_FILE 101 /* input and output files are the same */
+#define TOO_MANY_FILES 103 /* tried to open too many FITS files */
+#define FILE_NOT_OPENED 104 /* could not open the named file */
+#define FILE_NOT_CREATED 105 /* could not create the named file */
+#define WRITE_ERROR 106 /* error writing to FITS file */
+#define END_OF_FILE 107 /* tried to move past end of file */
+#define READ_ERROR 108 /* error reading from FITS file */
+#define FILE_NOT_CLOSED 110 /* could not close the file */
+#define ARRAY_TOO_BIG 111 /* array dimensions exceed internal limit */
+#define READONLY_FILE 112 /* Cannot write to readonly file */
+#define MEMORY_ALLOCATION 113 /* Could not allocate memory */
+#define BAD_FILEPTR 114 /* invalid fitsfile pointer */
+#define NULL_INPUT_PTR 115 /* NULL input pointer to routine */
+#define SEEK_ERROR 116 /* error seeking position in file */
+
+#define BAD_URL_PREFIX 121 /* invalid URL prefix on file name */
+#define TOO_MANY_DRIVERS 122 /* tried to register too many IO drivers */
+#define DRIVER_INIT_FAILED 123 /* driver initialization failed */
+#define NO_MATCHING_DRIVER 124 /* matching driver is not registered */
+#define URL_PARSE_ERROR 125 /* failed to parse input file URL */
+#define RANGE_PARSE_ERROR 126 /* failed to parse input file URL */
+
+#define SHARED_ERRBASE (150)
+#define SHARED_BADARG (SHARED_ERRBASE + 1)
+#define SHARED_NULPTR (SHARED_ERRBASE + 2)
+#define SHARED_TABFULL (SHARED_ERRBASE + 3)
+#define SHARED_NOTINIT (SHARED_ERRBASE + 4)
+#define SHARED_IPCERR (SHARED_ERRBASE + 5)
+#define SHARED_NOMEM (SHARED_ERRBASE + 6)
+#define SHARED_AGAIN (SHARED_ERRBASE + 7)
+#define SHARED_NOFILE (SHARED_ERRBASE + 8)
+#define SHARED_NORESIZE (SHARED_ERRBASE + 9)
+
+#define HEADER_NOT_EMPTY 201 /* header already contains keywords */
+#define KEY_NO_EXIST 202 /* keyword not found in header */
+#define KEY_OUT_BOUNDS 203 /* keyword record number is out of bounds */
+#define VALUE_UNDEFINED 204 /* keyword value field is blank */
+#define NO_QUOTE 205 /* string is missing the closing quote */
+#define BAD_INDEX_KEY 206 /* illegal indexed keyword name */
+#define BAD_KEYCHAR 207 /* illegal character in keyword name or card */
+#define BAD_ORDER 208 /* required keywords out of order */
+#define NOT_POS_INT 209 /* keyword value is not a positive integer */
+#define NO_END 210 /* couldn't find END keyword */
+#define BAD_BITPIX 211 /* illegal BITPIX keyword value*/
+#define BAD_NAXIS 212 /* illegal NAXIS keyword value */
+#define BAD_NAXES 213 /* illegal NAXISn keyword value */
+#define BAD_PCOUNT 214 /* illegal PCOUNT keyword value */
+#define BAD_GCOUNT 215 /* illegal GCOUNT keyword value */
+#define BAD_TFIELDS 216 /* illegal TFIELDS keyword value */
+#define NEG_WIDTH 217 /* negative table row size */
+#define NEG_ROWS 218 /* negative number of rows in table */
+#define COL_NOT_FOUND 219 /* column with this name not found in table */
+#define BAD_SIMPLE 220 /* illegal value of SIMPLE keyword */
+#define NO_SIMPLE 221 /* Primary array doesn't start with SIMPLE */
+#define NO_BITPIX 222 /* Second keyword not BITPIX */
+#define NO_NAXIS 223 /* Third keyword not NAXIS */
+#define NO_NAXES 224 /* Couldn't find all the NAXISn keywords */
+#define NO_XTENSION 225 /* HDU doesn't start with XTENSION keyword */
+#define NOT_ATABLE 226 /* the CHDU is not an ASCII table extension */
+#define NOT_BTABLE 227 /* the CHDU is not a binary table extension */
+#define NO_PCOUNT 228 /* couldn't find PCOUNT keyword */
+#define NO_GCOUNT 229 /* couldn't find GCOUNT keyword */
+#define NO_TFIELDS 230 /* couldn't find TFIELDS keyword */
+#define NO_TBCOL 231 /* couldn't find TBCOLn keyword */
+#define NO_TFORM 232 /* couldn't find TFORMn keyword */
+#define NOT_IMAGE 233 /* the CHDU is not an IMAGE extension */
+#define BAD_TBCOL 234 /* TBCOLn keyword value < 0 or > rowlength */
+#define NOT_TABLE 235 /* the CHDU is not a table */
+#define COL_TOO_WIDE 236 /* column is too wide to fit in table */
+#define COL_NOT_UNIQUE 237 /* more than 1 column name matches template */
+#define BAD_ROW_WIDTH 241 /* sum of column widths not = NAXIS1 */
+#define UNKNOWN_EXT 251 /* unrecognizable FITS extension type */
+#define UNKNOWN_REC 252 /* unrecognizable FITS record */
+#define END_JUNK 253 /* END keyword is not blank */
+#define BAD_HEADER_FILL 254 /* Header fill area not blank */
+#define BAD_DATA_FILL 255 /* Data fill area not blank or zero */
+#define BAD_TFORM 261 /* illegal TFORM format code */
+#define BAD_TFORM_DTYPE 262 /* unrecognizable TFORM datatype code */
+#define BAD_TDIM 263 /* illegal TDIMn keyword value */
+#define BAD_HEAP_PTR 264 /* invalid BINTABLE heap address */
+
+#define BAD_HDU_NUM 301 /* HDU number < 1 or > MAXHDU */
+#define BAD_COL_NUM 302 /* column number < 1 or > tfields */
+#define NEG_FILE_POS 304 /* tried to move before beginning of file */
+#define NEG_BYTES 306 /* tried to read or write negative bytes */
+#define BAD_ROW_NUM 307 /* illegal starting row number in table */
+#define BAD_ELEM_NUM 308 /* illegal starting element number in vector */
+#define NOT_ASCII_COL 309 /* this is not an ASCII string column */
+#define NOT_LOGICAL_COL 310 /* this is not a logical datatype column */
+#define BAD_ATABLE_FORMAT 311 /* ASCII table column has wrong format */
+#define BAD_BTABLE_FORMAT 312 /* Binary table column has wrong format */
+#define NO_NULL 314 /* null value has not been defined */
+#define NOT_VARI_LEN 317 /* this is not a variable length column */
+#define BAD_DIMEN 320 /* illegal number of dimensions in array */
+#define BAD_PIX_NUM 321 /* first pixel number greater than last pixel */
+#define ZERO_SCALE 322 /* illegal BSCALE or TSCALn keyword = 0 */
+#define NEG_AXIS 323 /* illegal axis length < 1 */
+
+#define NOT_GROUP_TABLE 340
+#define HDU_ALREADY_MEMBER 341
+#define MEMBER_NOT_FOUND 342
+#define GROUP_NOT_FOUND 343
+#define BAD_GROUP_ID 344
+#define TOO_MANY_HDUS_TRACKED 345
+#define HDU_ALREADY_TRACKED 346
+#define BAD_OPTION 347
+#define IDENTICAL_POINTERS 348
+#define BAD_GROUP_ATTACH 349
+#define BAD_GROUP_DETACH 350
+
+#define BAD_I2C 401 /* bad int to formatted string conversion */
+#define BAD_F2C 402 /* bad float to formatted string conversion */
+#define BAD_INTKEY 403 /* can't interprete keyword value as integer */
+#define BAD_LOGICALKEY 404 /* can't interprete keyword value as logical */
+#define BAD_FLOATKEY 405 /* can't interprete keyword value as float */
+#define BAD_DOUBLEKEY 406 /* can't interprete keyword value as double */
+#define BAD_C2I 407 /* bad formatted string to int conversion */
+#define BAD_C2F 408 /* bad formatted string to float conversion */
+#define BAD_C2D 409 /* bad formatted string to double conversion */
+#define BAD_DATATYPE 410 /* bad keyword datatype code */
+#define BAD_DECIM 411 /* bad number of decimal places specified */
+#define NUM_OVERFLOW 412 /* overflow during datatype conversion */
+
+# define DATA_COMPRESSION_ERR 413 /* error in imcompress routines */
+# define DATA_DECOMPRESSION_ERR 414 /* error in imcompress routines */
+# define NO_COMPRESSED_TILE 415 /* compressed tile doesn't exist */
+
+#define BAD_DATE 420 /* error in date or time conversion */
+
+#define PARSE_SYNTAX_ERR 431 /* syntax error in parser expression */
+#define PARSE_BAD_TYPE 432 /* expression did not evaluate to desired type */
+#define PARSE_LRG_VECTOR 433 /* vector result too large to return in array */
+#define PARSE_NO_OUTPUT 434 /* data parser failed not sent an out column */
+#define PARSE_BAD_COL 435 /* bad data encounter while parsing column */
+#define PARSE_BAD_OUTPUT 436 /* Output file not of proper type */
+
+#define ANGLE_TOO_BIG 501 /* celestial angle too large for projection */
+#define BAD_WCS_VAL 502 /* bad celestial coordinate or pixel value */
+#define WCS_ERROR 503 /* error in celestial coordinate calculation */
+#define BAD_WCS_PROJ 504 /* unsupported type of celestial projection */
+#define NO_WCS_KEY 505 /* celestial coordinate keywords not found */
+#define APPROX_WCS_KEY 506 /* approximate WCS keywords were calculated */
+
+#define NO_CLOSE_ERROR 999 /* special value used internally to switch off */
+ /* the error message from ffclos and ffchdu */
+
+/*------- following error codes are used in the grparser.c file -----------*/
+#define NGP_ERRBASE (360) /* base chosen so not to interfere with CFITSIO */
+#define NGP_OK (0)
+#define NGP_NO_MEMORY (NGP_ERRBASE + 0) /* malloc failed */
+#define NGP_READ_ERR (NGP_ERRBASE + 1) /* read error from file */
+#define NGP_NUL_PTR (NGP_ERRBASE + 2) /* null pointer passed as argument */
+#define NGP_EMPTY_CURLINE (NGP_ERRBASE + 3) /* line read seems to be empty */
+#define NGP_UNREAD_QUEUE_FULL (NGP_ERRBASE + 4) /* cannot unread more then 1 line (or single line twice) */
+#define NGP_INC_NESTING (NGP_ERRBASE + 5) /* too deep include file nesting (inf. loop ?) */
+#define NGP_ERR_FOPEN (NGP_ERRBASE + 6) /* fopen() failed, cannot open file */
+#define NGP_EOF (NGP_ERRBASE + 7) /* end of file encountered */
+#define NGP_BAD_ARG (NGP_ERRBASE + 8) /* bad arguments passed */
+#define NGP_TOKEN_NOT_EXPECT (NGP_ERRBASE + 9) /* token not expected here */
+
+/* The following exclusion if __CINT__ is defined is needed for ROOT */
+#ifndef __CINT__
+/* the following 3 lines are needed to support C++ compilers */
+#ifdef __cplusplus
+extern "C" {
+#endif
+#endif
+
+int CFITS2Unit( fitsfile *fptr );
+fitsfile* CUnit2FITS(int unit);
+
+/*---------------- FITS file URL parsing routines -------------*/
+int fits_get_token(char **ptr, char *delimiter, char *token, int *isanumber);
+char *fits_split_names(char *list);
+int ffiurl( char *url, char *urltype, char *infile,
+ char *outfile, char *extspec, char *rowfilter,
+ char *binspec, char *colspec, int *status);
+int ffifile (char *url, char *urltype, char *infile,
+ char *outfile, char *extspec, char *rowfilter,
+ char *binspec, char *colspec, char *pixfilter, int *status);
+int ffrtnm(char *url, char *rootname, int *status);
+int ffexist(const char *infile, int *exists, int *status);
+int ffexts(char *extspec, int *extnum, char *extname, int *extvers,
+ int *hdutype, char *colname, char *rowexpress, int *status);
+int ffextn(char *url, int *extension_num, int *status);
+int ffurlt(fitsfile *fptr, char *urlType, int *status);
+int ffbins(char *binspec, int *imagetype, int *haxis,
+ char colname[4][FLEN_VALUE], double *minin,
+ double *maxin, double *binsizein,
+ char minname[4][FLEN_VALUE], char maxname[4][FLEN_VALUE],
+ char binname[4][FLEN_VALUE], double *weight, char *wtname,
+ int *recip, int *status);
+int ffbinr(char **binspec, char *colname, double *minin,
+ double *maxin, double *binsizein, char *minname,
+ char *maxname, char *binname, int *status);
+int fits_copy_cell2image(fitsfile *fptr, fitsfile *newptr, char *colname,
+ long rownum, int *status);
+int fits_copy_image2cell(fitsfile *fptr, fitsfile *newptr, char *colname,
+ long rownum, int copykeyflag, int *status);
+int fits_copy_pixlist2image(fitsfile *infptr, fitsfile *outfptr, int firstkey, /* I - first HDU record number to start with */
+ int naxis, int *colnum, int *status);
+int ffimport_file( char *filename, char **contents, int *status );
+int ffrwrg( char *rowlist, LONGLONG maxrows, int maxranges, int *numranges,
+ long *minrow, long *maxrow, int *status);
+int ffrwrgll( char *rowlist, LONGLONG maxrows, int maxranges, int *numranges,
+ LONGLONG *minrow, LONGLONG *maxrow, int *status);
+/*---------------- FITS file I/O routines -------------*/
+int fits_init_cfitsio(void);
+int ffomem(fitsfile **fptr, const char *name, int mode, void **buffptr,
+ size_t *buffsize, size_t deltasize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ int *status);
+int ffopen(fitsfile **fptr, const char *filename, int iomode, int *status);
+int ffopentest(double version, fitsfile **fptr, const char *filename, int iomode, int *status);
+
+int ffdopn(fitsfile **fptr, const char *filename, int iomode, int *status);
+int fftopn(fitsfile **fptr, const char *filename, int iomode, int *status);
+int ffiopn(fitsfile **fptr, const char *filename, int iomode, int *status);
+int ffdkopn(fitsfile **fptr, const char *filename, int iomode, int *status);
+int ffreopen(fitsfile *openfptr, fitsfile **newfptr, int *status);
+int ffinit( fitsfile **fptr, const char *filename, int *status);
+int ffdkinit(fitsfile **fptr, const char *filename, int *status);
+int ffimem(fitsfile **fptr, void **buffptr,
+ size_t *buffsize, size_t deltasize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ int *status);
+int fftplt(fitsfile **fptr, const char *filename, const char *tempname,
+ int *status);
+int ffflus(fitsfile *fptr, int *status);
+int ffflsh(fitsfile *fptr, int clearbuf, int *status);
+int ffclos(fitsfile *fptr, int *status);
+int ffdelt(fitsfile *fptr, int *status);
+int ffflnm(fitsfile *fptr, char *filename, int *status);
+int ffflmd(fitsfile *fptr, int *filemode, int *status);
+int fits_delete_iraf_file(char *filename, int *status);
+
+/*---------------- utility routines -------------*/
+
+float ffvers(float *version);
+void ffupch(char *string);
+void ffgerr(int status, char *errtext);
+void ffpmsg(const char *err_message);
+void ffpmrk(void);
+int ffgmsg(char *err_message);
+void ffcmsg(void);
+void ffcmrk(void);
+void ffrprt(FILE *stream, int status);
+void ffcmps(char *templt, char *colname, int casesen, int *match,
+ int *exact);
+int fftkey(const char *keyword, int *status);
+int fftrec(char *card, int *status);
+int ffnchk(fitsfile *fptr, int *status);
+int ffkeyn(const char *keyroot, int value, char *keyname, int *status);
+int ffnkey(int value, char *keyroot, char *keyname, int *status);
+int ffgkcl(char *card);
+int ffdtyp(char *cval, char *dtype, int *status);
+int ffinttyp(char *cval, int *datatype, int *negative, int *status);
+int ffpsvc(char *card, char *value, char *comm, int *status);
+int ffgknm(char *card, char *name, int *length, int *status);
+int ffgthd(char *tmplt, char *card, int *hdtype, int *status);
+int fits_translate_keyword(char *inrec, char *outrec, char *patterns[][2],
+ int npat, int n_value, int n_offset, int n_range, int *pat_num,
+ int *i, int *j, int *m, int *n, int *status);
+int fits_translate_keywords(fitsfile *infptr, fitsfile *outfptr,
+ int firstkey, char *patterns[][2],
+ int npat, int n_value, int n_offset, int n_range, int *status);
+int ffasfm(char *tform, int *datacode, long *width, int *decim, int *status);
+int ffbnfm(char *tform, int *datacode, long *repeat, long *width, int *status);
+int ffbnfmll(char *tform, int *datacode, LONGLONG *repeat, long *width, int *status);
+int ffgabc(int tfields, char **tform, int space, long *rowlen, long *tbcol,
+ int *status);
+int fits_get_section_range(char **ptr,long *secmin,long *secmax,long *incre,
+ int *status);
+/* ffmbyt should not normally be used in application programs, but it is
+ defined here as a publicly available routine because there are a few
+ rare cases where it is needed
+*/
+int ffmbyt(fitsfile *fptr, LONGLONG bytpos, int ignore_err, int *status);
+/*----------------- write single keywords --------------*/
+int ffpky(fitsfile *fptr, int datatype, const char *keyname, void *value,
+ const char *comm, int *status);
+int ffprec(fitsfile *fptr, const char *card, int *status);
+int ffpcom(fitsfile *fptr, const char *comm, int *status);
+int ffpunt(fitsfile *fptr, const char *keyname, char *unit, int *status);
+int ffphis(fitsfile *fptr, const char *history, int *status);
+int ffpdat(fitsfile *fptr, int *status);
+int ffverifydate(int year, int month, int day, int *status);
+int ffgstm(char *timestr, int *timeref, int *status);
+int ffgsdt(int *day, int *month, int *year, int *status);
+int ffdt2s(int year, int month, int day, char *datestr, int *status);
+int fftm2s(int year, int month, int day, int hour, int minute, double second,
+ int decimals, char *datestr, int *status);
+int ffs2dt(char *datestr, int *year, int *month, int *day, int *status);
+int ffs2tm(char *datestr, int *year, int *month, int *day, int *hour,
+ int *minute, double *second, int *status);
+int ffpkyu(fitsfile *fptr, const char *keyname, const char *comm, int *status);
+int ffpkys(fitsfile *fptr, const char *keyname, char *value, const char *comm,int *status);
+int ffpkls(fitsfile *fptr, const char *keyname, const char *value, const char *comm,int *status);
+int ffplsw(fitsfile *fptr, int *status);
+int ffpkyl(fitsfile *fptr, const char *keyname, int value, const char *comm, int *status);
+int ffpkyj(fitsfile *fptr, const char *keyname, LONGLONG value, const char *comm, int *status);
+int ffpkyf(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm,
+ int *status);
+int ffpkye(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm,
+ int *status);
+int ffpkyg(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm,
+ int *status);
+int ffpkyd(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm,
+ int *status);
+int ffpkyc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm,
+ int *status);
+int ffpkym(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm,
+ int *status);
+int ffpkfc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm,
+ int *status);
+int ffpkfm(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm,
+ int *status);
+int ffpkyt(fitsfile *fptr, const char *keyname, long intval, double frac, const char *comm,
+ int *status);
+int ffptdm( fitsfile *fptr, int colnum, int naxis, long naxes[], int *status);
+int ffptdmll( fitsfile *fptr, int colnum, int naxis, LONGLONG naxes[], int *status);
+
+/*----------------- write array of keywords --------------*/
+int ffpkns(fitsfile *fptr, const char *keyroot, int nstart, int nkey, char *value[],
+ char *comm[], int *status);
+int ffpknl(fitsfile *fptr, const char *keyroot, int nstart, int nkey, int *value,
+ char *comm[], int *status);
+int ffpknj(fitsfile *fptr, const char *keyroot, int nstart, int nkey, long *value,
+ char *comm[], int *status);
+int ffpknjj(fitsfile *fptr, const char *keyroot, int nstart, int nkey, LONGLONG *value,
+ char *comm[], int *status);
+int ffpknf(fitsfile *fptr, const char *keyroot, int nstart, int nkey, float *value,
+ int decim, char *comm[], int *status);
+int ffpkne(fitsfile *fptr, const char *keyroot, int nstart, int nkey, float *value,
+ int decim, char *comm[], int *status);
+int ffpkng(fitsfile *fptr, const char *keyroot, int nstart, int nkey, double *value,
+ int decim, char *comm[], int *status);
+int ffpknd(fitsfile *fptr, const char *keyroot, int nstart, int nkey, double *value,
+ int decim, char *comm[], int *status);
+int ffcpky(fitsfile *infptr,fitsfile *outfptr,int incol,int outcol,
+ char *rootname, int *status);
+
+/*----------------- write required header keywords --------------*/
+int ffphps( fitsfile *fptr, int bitpix, int naxis, long naxes[], int *status);
+int ffphpsll( fitsfile *fptr, int bitpix, int naxis, LONGLONG naxes[], int *status);
+int ffphpr( fitsfile *fptr, int simple, int bitpix, int naxis, long naxes[],
+ LONGLONG pcount, LONGLONG gcount, int extend, int *status);
+int ffphprll( fitsfile *fptr, int simple, int bitpix, int naxis, LONGLONG naxes[],
+ LONGLONG pcount, LONGLONG gcount, int extend, int *status);
+int ffphtb(fitsfile *fptr, LONGLONG naxis1, LONGLONG naxis2, int tfields, char **ttype,
+ long *tbcol, char **tform, char **tunit, const char *extname, int *status);
+int ffphbn(fitsfile *fptr, LONGLONG naxis2, int tfields, char **ttype,
+ char **tform, char **tunit, const char *extname, LONGLONG pcount, int *status);
+int ffphext( fitsfile *fptr, const char *xtension, int bitpix, int naxis, long naxes[],
+ LONGLONG pcount, LONGLONG gcount, int *status);
+/*----------------- write template keywords --------------*/
+int ffpktp(fitsfile *fptr, const char *filename, int *status);
+
+/*------------------ get header information --------------*/
+int ffghsp(fitsfile *fptr, int *nexist, int *nmore, int *status);
+int ffghps(fitsfile *fptr, int *nexist, int *position, int *status);
+
+/*------------------ move position in header -------------*/
+int ffmaky(fitsfile *fptr, int nrec, int *status);
+int ffmrky(fitsfile *fptr, int nrec, int *status);
+
+/*------------------ read single keywords -----------------*/
+int ffgnxk(fitsfile *fptr, char **inclist, int ninc, char **exclist,
+ int nexc, char *card, int *status);
+int ffgrec(fitsfile *fptr, int nrec, char *card, int *status);
+int ffgcrd(fitsfile *fptr, const char *keyname, char *card, int *status);
+int ffgstr(fitsfile *fptr, const char *string, char *card, int *status);
+int ffgunt(fitsfile *fptr, const char *keyname, char *unit, int *status);
+int ffgkyn(fitsfile *fptr, int nkey, char *keyname, char *keyval, char *comm,
+ int *status);
+int ffgkey(fitsfile *fptr, const char *keyname, char *keyval, char *comm,
+ int *status);
+
+int ffgky( fitsfile *fptr, int datatype, const char *keyname, void *value,
+ char *comm, int *status);
+int ffgkys(fitsfile *fptr, const char *keyname, char *value, char *comm, int *status);
+int ffgkls(fitsfile *fptr, const char *keyname, char **value, char *comm, int *status);
+int fffkls(char *value, int *status);
+int ffgkyl(fitsfile *fptr, const char *keyname, int *value, char *comm, int *status);
+int ffgkyj(fitsfile *fptr, const char *keyname, long *value, char *comm, int *status);
+int ffgkyjj(fitsfile *fptr, const char *keyname, LONGLONG *value, char *comm, int *status);
+int ffgkye(fitsfile *fptr, const char *keyname, float *value, char *comm,int *status);
+int ffgkyd(fitsfile *fptr, const char *keyname, double *value,char *comm,int *status);
+int ffgkyc(fitsfile *fptr, const char *keyname, float *value, char *comm,int *status);
+int ffgkym(fitsfile *fptr, const char *keyname, double *value,char *comm,int *status);
+int ffgkyt(fitsfile *fptr, const char *keyname, long *ivalue, double *dvalue,
+ char *comm, int *status);
+int ffgtdm(fitsfile *fptr, int colnum, int maxdim, int *naxis, long naxes[],
+ int *status);
+int ffgtdmll(fitsfile *fptr, int colnum, int maxdim, int *naxis, LONGLONG naxes[],
+ int *status);
+int ffdtdm(fitsfile *fptr, char *tdimstr, int colnum, int maxdim,
+ int *naxis, long naxes[], int *status);
+int ffdtdmll(fitsfile *fptr, char *tdimstr, int colnum, int maxdim,
+ int *naxis, LONGLONG naxes[], int *status);
+
+/*------------------ read array of keywords -----------------*/
+int ffgkns(fitsfile *fptr, const char *keyname, int nstart, int nmax, char *value[],
+ int *nfound, int *status);
+int ffgknl(fitsfile *fptr, const char *keyname, int nstart, int nmax, int *value,
+ int *nfound, int *status);
+int ffgknj(fitsfile *fptr, const char *keyname, int nstart, int nmax, long *value,
+ int *nfound, int *status);
+int ffgknjj(fitsfile *fptr, const char *keyname, int nstart, int nmax, LONGLONG *value,
+ int *nfound, int *status);
+int ffgkne(fitsfile *fptr, const char *keyname, int nstart, int nmax, float *value,
+ int *nfound, int *status);
+int ffgknd(fitsfile *fptr, const char *keyname, int nstart, int nmax, double *value,
+ int *nfound, int *status);
+int ffh2st(fitsfile *fptr, char **header, int *status);
+int ffhdr2str( fitsfile *fptr, int exclude_comm, char **exclist,
+ int nexc, char **header, int *nkeys, int *status);
+int ffcnvthdr2str( fitsfile *fptr, int exclude_comm, char **exclist,
+ int nexc, char **header, int *nkeys, int *status);
+
+/*----------------- read required header keywords --------------*/
+int ffghpr(fitsfile *fptr, int maxdim, int *simple, int *bitpix, int *naxis,
+ long naxes[], long *pcount, long *gcount, int *extend, int *status);
+
+int ffghprll(fitsfile *fptr, int maxdim, int *simple, int *bitpix, int *naxis,
+ LONGLONG naxes[], long *pcount, long *gcount, int *extend, int *status);
+
+int ffghtb(fitsfile *fptr,int maxfield, long *naxis1, long *naxis2,
+ int *tfields, char **ttype, long *tbcol, char **tform, char **tunit,
+ char *extname, int *status);
+
+int ffghtbll(fitsfile *fptr,int maxfield, LONGLONG *naxis1, LONGLONG *naxis2,
+ int *tfields, char **ttype, LONGLONG *tbcol, char **tform, char **tunit,
+ char *extname, int *status);
+
+
+int ffghbn(fitsfile *fptr, int maxfield, long *naxis2, int *tfields,
+ char **ttype, char **tform, char **tunit, char *extname,
+ long *pcount, int *status);
+
+int ffghbnll(fitsfile *fptr, int maxfield, LONGLONG *naxis2, int *tfields,
+ char **ttype, char **tform, char **tunit, char *extname,
+ LONGLONG *pcount, int *status);
+
+/*--------------------- update keywords ---------------*/
+int ffuky(fitsfile *fptr, int datatype, const char *keyname, void *value,
+ char *comm, int *status);
+int ffucrd(fitsfile *fptr, const char *keyname, char *card, int *status);
+int ffukyu(fitsfile *fptr, const char *keyname, char *comm, int *status);
+int ffukys(fitsfile *fptr, const char *keyname, char *value, char *comm, int *status);
+int ffukls(fitsfile *fptr, const char *keyname, char *value, char *comm, int *status);
+int ffukyl(fitsfile *fptr, const char *keyname, int value, char *comm, int *status);
+int ffukyj(fitsfile *fptr, const char *keyname, LONGLONG value, char *comm, int *status);
+int ffukyf(fitsfile *fptr, const char *keyname, float value, int decim, char *comm,
+ int *status);
+int ffukye(fitsfile *fptr, const char *keyname, float value, int decim, char *comm,
+ int *status);
+int ffukyg(fitsfile *fptr, const char *keyname, double value, int decim, char *comm,
+ int *status);
+int ffukyd(fitsfile *fptr, const char *keyname, double value, int decim, char *comm,
+ int *status);
+int ffukyc(fitsfile *fptr, const char *keyname, float *value, int decim, char *comm,
+ int *status);
+int ffukym(fitsfile *fptr, const char *keyname, double *value, int decim, char *comm,
+ int *status);
+int ffukfc(fitsfile *fptr, const char *keyname, float *value, int decim, char *comm,
+ int *status);
+int ffukfm(fitsfile *fptr, const char *keyname, double *value, int decim, char *comm,
+ int *status);
+
+/*--------------------- modify keywords ---------------*/
+int ffmrec(fitsfile *fptr, int nkey, char *card, int *status);
+int ffmcrd(fitsfile *fptr, const char *keyname, char *card, int *status);
+int ffmnam(fitsfile *fptr, const char *oldname, const char *newname, int *status);
+int ffmcom(fitsfile *fptr, const char *keyname, char *comm, int *status);
+int ffmkyu(fitsfile *fptr, const char *keyname, char *comm, int *status);
+int ffmkys(fitsfile *fptr, const char *keyname, char *value, char *comm,int *status);
+int ffmkls(fitsfile *fptr, const char *keyname, char *value, char *comm,int *status);
+int ffmkyl(fitsfile *fptr, const char *keyname, int value, char *comm, int *status);
+int ffmkyj(fitsfile *fptr, const char *keyname, LONGLONG value, char *comm, int *status);
+int ffmkyf(fitsfile *fptr, const char *keyname, float value, int decim, char *comm,
+ int *status);
+int ffmkye(fitsfile *fptr, const char *keyname, float value, int decim, char *comm,
+ int *status);
+int ffmkyg(fitsfile *fptr, const char *keyname, double value, int decim, char *comm,
+ int *status);
+int ffmkyd(fitsfile *fptr, const char *keyname, double value, int decim, char *comm,
+ int *status);
+int ffmkyc(fitsfile *fptr, const char *keyname, float *value, int decim, char *comm,
+ int *status);
+int ffmkym(fitsfile *fptr, const char *keyname, double *value, int decim, char *comm,
+ int *status);
+int ffmkfc(fitsfile *fptr, const char *keyname, float *value, int decim, char *comm,
+ int *status);
+int ffmkfm(fitsfile *fptr, const char *keyname, double *value, int decim, char *comm,
+ int *status);
+
+/*--------------------- insert keywords ---------------*/
+int ffirec(fitsfile *fptr, int nkey, char *card, int *status);
+int ffikey(fitsfile *fptr, char *card, int *status);
+int ffikyu(fitsfile *fptr, const char *keyname, char *comm, int *status);
+int ffikys(fitsfile *fptr, const char *keyname, char *value, char *comm,int *status);
+int ffikls(fitsfile *fptr, const char *keyname, char *value, char *comm,int *status);
+int ffikyl(fitsfile *fptr, const char *keyname, int value, char *comm, int *status);
+int ffikyj(fitsfile *fptr, const char *keyname, LONGLONG value, char *comm, int *status);
+int ffikyf(fitsfile *fptr, const char *keyname, float value, int decim, char *comm,
+ int *status);
+int ffikye(fitsfile *fptr, const char *keyname, float value, int decim, char *comm,
+ int *status);
+int ffikyg(fitsfile *fptr, const char *keyname, double value, int decim, char *comm,
+ int *status);
+int ffikyd(fitsfile *fptr, const char *keyname, double value, int decim, char *comm,
+ int *status);
+int ffikyc(fitsfile *fptr, const char *keyname, float *value, int decim, char *comm,
+ int *status);
+int ffikym(fitsfile *fptr, const char *keyname, double *value, int decim, char *comm,
+ int *status);
+int ffikfc(fitsfile *fptr, const char *keyname, float *value, int decim, char *comm,
+ int *status);
+int ffikfm(fitsfile *fptr, const char *keyname, double *value, int decim, char *comm,
+ int *status);
+
+/*--------------------- delete keywords ---------------*/
+int ffdkey(fitsfile *fptr, const char *keyname, int *status);
+int ffdstr(fitsfile *fptr, const char *string, int *status);
+int ffdrec(fitsfile *fptr, int keypos, int *status);
+
+/*--------------------- get HDU information -------------*/
+int ffghdn(fitsfile *fptr, int *chdunum);
+int ffghdt(fitsfile *fptr, int *exttype, int *status);
+int ffghad(fitsfile *fptr, long *headstart, long *datastart, long *dataend,
+ int *status);
+int ffghadll(fitsfile *fptr, LONGLONG *headstart, LONGLONG *datastart,
+ LONGLONG *dataend, int *status);
+int ffghof(fitsfile *fptr, OFF_T *headstart, OFF_T *datastart, OFF_T *dataend,
+ int *status);
+int ffgipr(fitsfile *fptr, int maxaxis, int *imgtype, int *naxis,
+ long *naxes, int *status);
+int ffgiprll(fitsfile *fptr, int maxaxis, int *imgtype, int *naxis,
+ LONGLONG *naxes, int *status);
+int ffgidt(fitsfile *fptr, int *imgtype, int *status);
+int ffgiet(fitsfile *fptr, int *imgtype, int *status);
+int ffgidm(fitsfile *fptr, int *naxis, int *status);
+int ffgisz(fitsfile *fptr, int nlen, long *naxes, int *status);
+int ffgiszll(fitsfile *fptr, int nlen, LONGLONG *naxes, int *status);
+
+/*--------------------- HDU operations -------------*/
+int ffmahd(fitsfile *fptr, int hdunum, int *exttype, int *status);
+int ffmrhd(fitsfile *fptr, int hdumov, int *exttype, int *status);
+int ffmnhd(fitsfile *fptr, int exttype, char *hduname, int hduvers,
+ int *status);
+int ffthdu(fitsfile *fptr, int *nhdu, int *status);
+int ffcrhd(fitsfile *fptr, int *status);
+int ffcrim(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status);
+int ffcrimll(fitsfile *fptr, int bitpix, int naxis, LONGLONG *naxes, int *status);
+int ffcrtb(fitsfile *fptr, int tbltype, LONGLONG naxis2, int tfields, char **ttype,
+ char **tform, char **tunit, const char *extname, int *status);
+int ffiimg(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status);
+int ffiimgll(fitsfile *fptr, int bitpix, int naxis, LONGLONG *naxes, int *status);
+int ffitab(fitsfile *fptr, LONGLONG naxis1, LONGLONG naxis2, int tfields, char **ttype,
+ long *tbcol, char **tform, char **tunit, const char *extname, int *status);
+int ffibin(fitsfile *fptr, LONGLONG naxis2, int tfields, char **ttype, char **tform,
+ char **tunit, const char *extname, LONGLONG pcount, int *status);
+int ffrsim(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status);
+int ffrsimll(fitsfile *fptr, int bitpix, int naxis, LONGLONG *naxes, int *status);
+int ffdhdu(fitsfile *fptr, int *hdutype, int *status);
+int ffcopy(fitsfile *infptr, fitsfile *outfptr, int morekeys, int *status);
+int ffcpfl(fitsfile *infptr, fitsfile *outfptr, int prev, int cur, int follow,
+ int *status);
+int ffcphd(fitsfile *infptr, fitsfile *outfptr, int *status);
+int ffcpdt(fitsfile *infptr, fitsfile *outfptr, int *status);
+int ffchfl(fitsfile *fptr, int *status);
+int ffcdfl(fitsfile *fptr, int *status);
+int ffwrhdu(fitsfile *fptr, FILE *outstream, int *status);
+
+int ffrdef(fitsfile *fptr, int *status);
+int ffhdef(fitsfile *fptr, int morekeys, int *status);
+int ffpthp(fitsfile *fptr, long theap, int *status);
+
+int ffcsum(fitsfile *fptr, long nrec, unsigned long *sum, int *status);
+void ffesum(unsigned long sum, int complm, char *ascii);
+unsigned long ffdsum(char *ascii, int complm, unsigned long *sum);
+int ffpcks(fitsfile *fptr, int *status);
+int ffupck(fitsfile *fptr, int *status);
+int ffvcks(fitsfile *fptr, int *datastatus, int *hdustatus, int *status);
+int ffgcks(fitsfile *fptr, unsigned long *datasum, unsigned long *hdusum,
+ int *status);
+
+/*--------------------- define scaling or null values -------------*/
+int ffpscl(fitsfile *fptr, double scale, double zero, int *status);
+int ffpnul(fitsfile *fptr, LONGLONG nulvalue, int *status);
+int fftscl(fitsfile *fptr, int colnum, double scale, double zero, int *status);
+int fftnul(fitsfile *fptr, int colnum, LONGLONG nulvalue, int *status);
+int ffsnul(fitsfile *fptr, int colnum, char *nulstring, int *status);
+
+/*--------------------- get column information -------------*/
+int ffgcno(fitsfile *fptr, int casesen, char *templt, int *colnum,
+ int *status);
+int ffgcnn(fitsfile *fptr, int casesen, char *templt, char *colname,
+ int *colnum, int *status);
+
+int ffgtcl(fitsfile *fptr, int colnum, int *typecode, long *repeat,
+ long *width, int *status);
+int ffgtclll(fitsfile *fptr, int colnum, int *typecode, LONGLONG *repeat,
+ LONGLONG *width, int *status);
+int ffeqty(fitsfile *fptr, int colnum, int *typecode, long *repeat,
+ long *width, int *status);
+int ffeqtyll(fitsfile *fptr, int colnum, int *typecode, LONGLONG *repeat,
+ LONGLONG *width, int *status);
+int ffgncl(fitsfile *fptr, int *ncols, int *status);
+int ffgnrw(fitsfile *fptr, long *nrows, int *status);
+int ffgnrwll(fitsfile *fptr, LONGLONG *nrows, int *status);
+int ffgacl(fitsfile *fptr, int colnum, char *ttype, long *tbcol,
+ char *tunit, char *tform, double *tscal, double *tzero,
+ char *tnull, char *tdisp, int *status);
+int ffgbcl(fitsfile *fptr, int colnum, char *ttype, char *tunit,
+ char *dtype, long *repeat, double *tscal, double *tzero,
+ long *tnull, char *tdisp, int *status);
+int ffgbclll(fitsfile *fptr, int colnum, char *ttype, char *tunit,
+ char *dtype, LONGLONG *repeat, double *tscal, double *tzero,
+ LONGLONG *tnull, char *tdisp, int *status);
+int ffgrsz(fitsfile *fptr, long *nrows, int *status);
+int ffgcdw(fitsfile *fptr, int colnum, int *width, int *status);
+
+/*--------------------- read primary array or image elements -------------*/
+int ffgpxv(fitsfile *fptr, int datatype, long *firstpix, LONGLONG nelem,
+ void *nulval, void *array, int *anynul, int *status);
+int ffgpxvll(fitsfile *fptr, int datatype, LONGLONG *firstpix, LONGLONG nelem,
+ void *nulval, void *array, int *anynul, int *status);
+int ffgpxf(fitsfile *fptr, int datatype, long *firstpix, LONGLONG nelem,
+ void *array, char *nullarray, int *anynul, int *status);
+int ffgpxfll(fitsfile *fptr, int datatype, LONGLONG *firstpix, LONGLONG nelem,
+ void *array, char *nullarray, int *anynul, int *status);
+int ffgsv(fitsfile *fptr, int datatype, long *blc, long *trc, long *inc,
+ void *nulval, void *array, int *anynul, int *status);
+
+int ffgpv(fitsfile *fptr, int datatype, LONGLONG firstelem, LONGLONG nelem,
+ void *nulval, void *array, int *anynul, int *status);
+int ffgpf(fitsfile *fptr, int datatype, LONGLONG firstelem, LONGLONG nelem,
+ void *array, char *nullarray, int *anynul, int *status);
+int ffgpvb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, unsigned
+ char nulval, unsigned char *array, int *anynul, int *status);
+int ffgpvsb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, signed
+ char nulval, signed char *array, int *anynul, int *status);
+int ffgpvui(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned short nulval, unsigned short *array, int *anynul,
+ int *status);
+int ffgpvi(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ short nulval, short *array, int *anynul, int *status);
+int ffgpvuj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned long nulval, unsigned long *array, int *anynul,
+ int *status);
+int ffgpvj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ long nulval, long *array, int *anynul, int *status);
+int ffgpvjj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ LONGLONG nulval, LONGLONG *array, int *anynul, int *status);
+int ffgpvuk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned int nulval, unsigned int *array, int *anynul, int *status);
+int ffgpvk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ int nulval, int *array, int *anynul, int *status);
+int ffgpve(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ float nulval, float *array, int *anynul, int *status);
+int ffgpvd(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ double nulval, double *array, int *anynul, int *status);
+
+int ffgpfb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned char *array, char *nularray, int *anynul, int *status);
+int ffgpfsb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ signed char *array, char *nularray, int *anynul, int *status);
+int ffgpfui(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned short *array, char *nularray, int *anynul, int *status);
+int ffgpfi(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ short *array, char *nularray, int *anynul, int *status);
+int ffgpfuj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned long *array, char *nularray, int *anynul, int *status);
+int ffgpfj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ long *array, char *nularray, int *anynul, int *status);
+int ffgpfjj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ LONGLONG *array, char *nularray, int *anynul, int *status);
+int ffgpfuk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned int *array, char *nularray, int *anynul, int *status);
+int ffgpfk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ int *array, char *nularray, int *anynul, int *status);
+int ffgpfe(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ float *array, char *nularray, int *anynul, int *status);
+int ffgpfd(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ double *array, char *nularray, int *anynul, int *status);
+
+int ffg2db(fitsfile *fptr, long group, unsigned char nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, unsigned char *array,
+ int *anynul, int *status);
+int ffg2dsb(fitsfile *fptr, long group, signed char nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, signed char *array,
+ int *anynul, int *status);
+int ffg2dui(fitsfile *fptr, long group, unsigned short nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, unsigned short *array,
+ int *anynul, int *status);
+int ffg2di(fitsfile *fptr, long group, short nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, short *array,
+ int *anynul, int *status);
+int ffg2duj(fitsfile *fptr, long group, unsigned long nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, unsigned long *array,
+ int *anynul, int *status);
+int ffg2dj(fitsfile *fptr, long group, long nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, long *array,
+ int *anynul, int *status);
+int ffg2djj(fitsfile *fptr, long group, LONGLONG nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, LONGLONG *array,
+ int *anynul, int *status);
+int ffg2duk(fitsfile *fptr, long group, unsigned int nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, unsigned int *array,
+ int *anynul, int *status);
+int ffg2dk(fitsfile *fptr, long group, int nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, int *array,
+ int *anynul, int *status);
+int ffg2de(fitsfile *fptr, long group, float nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, float *array,
+ int *anynul, int *status);
+int ffg2dd(fitsfile *fptr, long group, double nulval, LONGLONG ncols,
+ LONGLONG naxis1, LONGLONG naxis2, double *array,
+ int *anynul, int *status);
+
+int ffg3db(fitsfile *fptr, long group, unsigned char nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ unsigned char *array, int *anynul, int *status);
+int ffg3dsb(fitsfile *fptr, long group, signed char nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ signed char *array, int *anynul, int *status);
+int ffg3dui(fitsfile *fptr, long group, unsigned short nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ unsigned short *array, int *anynul, int *status);
+int ffg3di(fitsfile *fptr, long group, short nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ short *array, int *anynul, int *status);
+int ffg3duj(fitsfile *fptr, long group, unsigned long nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ unsigned long *array, int *anynul, int *status);
+int ffg3dj(fitsfile *fptr, long group, long nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ long *array, int *anynul, int *status);
+int ffg3djj(fitsfile *fptr, long group, LONGLONG nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ LONGLONG *array, int *anynul, int *status);
+int ffg3duk(fitsfile *fptr, long group, unsigned int nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ unsigned int *array, int *anynul, int *status);
+int ffg3dk(fitsfile *fptr, long group, int nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ int *array, int *anynul, int *status);
+int ffg3de(fitsfile *fptr, long group, float nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ float *array, int *anynul, int *status);
+int ffg3dd(fitsfile *fptr, long group, double nulval, LONGLONG ncols,
+ LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3,
+ double *array, int *anynul, int *status);
+
+int ffgsvb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, unsigned char nulval, unsigned char *array,
+ int *anynul, int *status);
+int ffgsvsb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, signed char nulval, signed char *array,
+ int *anynul, int *status);
+int ffgsvui(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, unsigned short nulval, unsigned short *array,
+ int *anynul, int *status);
+int ffgsvi(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, short nulval, short *array, int *anynul, int *status);
+int ffgsvuj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, unsigned long nulval, unsigned long *array,
+ int *anynul, int *status);
+int ffgsvj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, long nulval, long *array, int *anynul, int *status);
+int ffgsvjj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, LONGLONG nulval, LONGLONG *array, int *anynul,
+ int *status);
+int ffgsvuk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, unsigned int nulval, unsigned int *array,
+ int *anynul, int *status);
+int ffgsvk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, int nulval, int *array, int *anynul, int *status);
+int ffgsve(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, float nulval, float *array, int *anynul, int *status);
+int ffgsvd(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, double nulval, double *array, int *anynul,
+ int *status);
+
+int ffgsfb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, unsigned char *array, char *flagval,
+ int *anynul, int *status);
+int ffgsfsb(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, signed char *array, char *flagval,
+ int *anynul, int *status);
+int ffgsfui(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, unsigned short *array, char *flagval, int *anynul,
+ int *status);
+int ffgsfi(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, short *array, char *flagval, int *anynul, int *status);
+int ffgsfuj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, unsigned long *array, char *flagval, int *anynul,
+ int *status);
+int ffgsfj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, long *array, char *flagval, int *anynul, int *status);
+int ffgsfjj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, LONGLONG *array, char *flagval, int *anynul,
+ int *status);
+int ffgsfuk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, unsigned int *array, char *flagval, int *anynul,
+ int *status);
+int ffgsfk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, int *array, char *flagval, int *anynul, int *status);
+int ffgsfe(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, float *array, char *flagval, int *anynul, int *status);
+int ffgsfd(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc,
+ long *trc, long *inc, double *array, char *flagval, int *anynul,
+ int *status);
+
+int ffggpb(fitsfile *fptr, long group, long firstelem, long nelem,
+ unsigned char *array, int *status);
+int ffggpsb(fitsfile *fptr, long group, long firstelem, long nelem,
+ signed char *array, int *status);
+int ffggpui(fitsfile *fptr, long group, long firstelem, long nelem,
+ unsigned short *array, int *status);
+int ffggpi(fitsfile *fptr, long group, long firstelem, long nelem,
+ short *array, int *status);
+int ffggpuj(fitsfile *fptr, long group, long firstelem, long nelem,
+ unsigned long *array, int *status);
+int ffggpj(fitsfile *fptr, long group, long firstelem, long nelem,
+ long *array, int *status);
+int ffggpjj(fitsfile *fptr, long group, long firstelem, long nelem,
+ LONGLONG *array, int *status);
+int ffggpuk(fitsfile *fptr, long group, long firstelem, long nelem,
+ unsigned int *array, int *status);
+int ffggpk(fitsfile *fptr, long group, long firstelem, long nelem,
+ int *array, int *status);
+int ffggpe(fitsfile *fptr, long group, long firstelem, long nelem,
+ float *array, int *status);
+int ffggpd(fitsfile *fptr, long group, long firstelem, long nelem,
+ double *array, int *status);
+
+/*--------------------- read column elements -------------*/
+int ffgcv( fitsfile *fptr, int datatype, int colnum, LONGLONG firstrow,
+ LONGLONG firstelem, LONGLONG nelem, void *nulval, void *array, int *anynul,
+ int *status);
+int ffgcf( fitsfile *fptr, int datatype, int colnum, LONGLONG firstrow,
+ LONGLONG firstelem, LONGLONG nelem, void *array, char *nullarray,
+ int *anynul, int *status);
+int ffgcvs(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, char *nulval, char **array, int *anynul, int *status);
+int ffgcl (fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, char *array, int *status);
+int ffgcvl (fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, char nulval, char *array, int *anynul, int *status);
+int ffgcvb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned char nulval, unsigned char *array,
+ int *anynul, int *status);
+int ffgcvsb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, signed char nulval, signed char *array,
+ int *anynul, int *status);
+int ffgcvui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned short nulval, unsigned short *array,
+ int *anynul, int *status);
+int ffgcvi(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, short nulval, short *array, int *anynul, int *status);
+int ffgcvuj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned long nulval, unsigned long *array, int *anynul,
+ int *status);
+int ffgcvj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long nulval, long *array, int *anynul, int *status);
+int ffgcvjj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, LONGLONG nulval, LONGLONG *array, int *anynul,
+ int *status);
+int ffgcvuk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned int nulval, unsigned int *array, int *anynul,
+ int *status);
+int ffgcvk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int nulval, int *array, int *anynul, int *status);
+int ffgcve(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, float nulval, float *array, int *anynul, int *status);
+int ffgcvd(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, double nulval, double *array, int *anynul, int *status);
+int ffgcvc(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, float nulval, float *array, int *anynul, int *status);
+int ffgcvm(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, double nulval, double *array, int *anynul, int *status);
+
+int ffgcx(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstbit,
+ LONGLONG nbits, char *larray, int *status);
+int ffgcxui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG nrows,
+ long firstbit, int nbits, unsigned short *array, int *status);
+int ffgcxuk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG nrows,
+ long firstbit, int nbits, unsigned int *array, int *status);
+
+int ffgcfs(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, char **array, char *nularray, int *anynul, int *status);
+int ffgcfl(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, char *array, char *nularray, int *anynul, int *status);
+int ffgcfb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned char *array, char *nularray, int *anynul, int *status);
+int ffgcfsb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, signed char *array, char *nularray, int *anynul, int *status);
+int ffgcfui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned short *array, char *nularray, int *anynul,
+ int *status);
+int ffgcfi(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, short *array, char *nularray, int *anynul, int *status);
+int ffgcfuj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned long *array, char *nularray, int *anynul,
+ int *status);
+int ffgcfj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long *array, char *nularray, int *anynul, int *status);
+int ffgcfjj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, LONGLONG *array, char *nularray, int *anynul, int *status);
+int ffgcfuk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned int *array, char *nularray, int *anynul,
+ int *status);
+int ffgcfk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int *array, char *nularray, int *anynul, int *status);
+int ffgcfe(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, float *array, char *nularray, int *anynul, int *status);
+int ffgcfd(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, double *array, char *nularray, int *anynul, int *status);
+int ffgcfc(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, float *array, char *nularray, int *anynul, int *status);
+int ffgcfm(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, double *array, char *nularray, int *anynul, int *status);
+
+int ffgdes(fitsfile *fptr, int colnum, LONGLONG rownum, long *length,
+ long *heapaddr, int *status);
+int ffgdesll(fitsfile *fptr, int colnum, LONGLONG rownum, LONGLONG *length,
+ LONGLONG *heapaddr, int *status);
+int ffgdess(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG nrows, long *length,
+ long *heapaddr, int *status);
+int ffgdessll(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG nrows, LONGLONG *length,
+ LONGLONG *heapaddr, int *status);
+int ffpdes(fitsfile *fptr, int colnum, LONGLONG rownum, LONGLONG length,
+ LONGLONG heapaddr, int *status);
+int fftheap(fitsfile *fptr, LONGLONG *heapsize, LONGLONG *unused, LONGLONG *overlap,
+ int *valid, int *status);
+int ffcmph(fitsfile *fptr, int *status);
+
+int ffgtbb(fitsfile *fptr, LONGLONG firstrow, LONGLONG firstchar, LONGLONG nchars,
+ unsigned char *values, int *status);
+
+int ffgextn(fitsfile *fptr, LONGLONG offset, LONGLONG nelem, void *array, int *status);
+int ffpextn(fitsfile *fptr, LONGLONG offset, LONGLONG nelem, void *array, int *status);
+
+/*------------ write primary array or image elements -------------*/
+int ffppx(fitsfile *fptr, int datatype, long *firstpix, LONGLONG nelem,
+ void *array, int *status);
+int ffppxll(fitsfile *fptr, int datatype, LONGLONG *firstpix, LONGLONG nelem,
+ void *array, int *status);
+int ffppxn(fitsfile *fptr, int datatype, long *firstpix, LONGLONG nelem,
+ void *array, void *nulval, int *status);
+int ffppxnll(fitsfile *fptr, int datatype, LONGLONG *firstpix, LONGLONG nelem,
+ void *array, void *nulval, int *status);
+int ffppr(fitsfile *fptr, int datatype, LONGLONG firstelem,
+ LONGLONG nelem, void *array, int *status);
+int ffpprb(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, unsigned char *array, int *status);
+int ffpprsb(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, signed char *array, int *status);
+int ffpprui(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, unsigned short *array, int *status);
+int ffppri(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, short *array, int *status);
+int ffppruj(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, unsigned long *array, int *status);
+int ffpprj(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, long *array, int *status);
+int ffppruk(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, unsigned int *array, int *status);
+int ffpprk(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, int *array, int *status);
+int ffppre(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, float *array, int *status);
+int ffpprd(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, double *array, int *status);
+int ffpprjj(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, LONGLONG *array, int *status);
+
+int ffppru(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ int *status);
+int ffpprn(fitsfile *fptr, LONGLONG firstelem, LONGLONG nelem, int *status);
+
+int ffppn(fitsfile *fptr, int datatype, LONGLONG firstelem, LONGLONG nelem,
+ void *array, void *nulval, int *status);
+int ffppnb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned char *array, unsigned char nulval, int *status);
+int ffppnsb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ signed char *array, signed char nulval, int *status);
+int ffppnui(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, unsigned short *array, unsigned short nulval,
+ int *status);
+int ffppni(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, short *array, short nulval, int *status);
+int ffppnj(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, long *array, long nulval, int *status);
+int ffppnuj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned long *array, unsigned long nulval, int *status);
+int ffppnuk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem,
+ unsigned int *array, unsigned int nulval, int *status);
+int ffppnk(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, int *array, int nulval, int *status);
+int ffppne(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, float *array, float nulval, int *status);
+int ffppnd(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, double *array, double nulval, int *status);
+int ffppnjj(fitsfile *fptr, long group, LONGLONG firstelem,
+ LONGLONG nelem, LONGLONG *array, LONGLONG nulval, int *status);
+
+int ffp2db(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, unsigned char *array, int *status);
+int ffp2dsb(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, signed char *array, int *status);
+int ffp2dui(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, unsigned short *array, int *status);
+int ffp2di(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, short *array, int *status);
+int ffp2duj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, unsigned long *array, int *status);
+int ffp2dj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, long *array, int *status);
+int ffp2duk(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, unsigned int *array, int *status);
+int ffp2dk(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, int *array, int *status);
+int ffp2de(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, float *array, int *status);
+int ffp2dd(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, double *array, int *status);
+int ffp2djj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG *array, int *status);
+
+int ffp3db(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, unsigned char *array, int *status);
+int ffp3dsb(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, signed char *array, int *status);
+int ffp3dui(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, unsigned short *array, int *status);
+int ffp3di(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, short *array, int *status);
+int ffp3duj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, unsigned long *array, int *status);
+int ffp3dj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, long *array, int *status);
+int ffp3duk(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, unsigned int *array, int *status);
+int ffp3dk(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, int *array, int *status);
+int ffp3de(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, float *array, int *status);
+int ffp3dd(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, double *array, int *status);
+int ffp3djj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1,
+ LONGLONG naxis2, LONGLONG naxis3, LONGLONG *array, int *status);
+
+int ffpss(fitsfile *fptr, int datatype,
+ long *fpixel, long *lpixel, void *array, int *status);
+int ffpssb(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, unsigned char *array, int *status);
+int ffpsssb(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, signed char *array, int *status);
+int ffpssui(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, unsigned short *array, int *status);
+int ffpssi(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, short *array, int *status);
+int ffpssuj(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, unsigned long *array, int *status);
+int ffpssj(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, long *array, int *status);
+int ffpssuk(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, unsigned int *array, int *status);
+int ffpssk(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, int *array, int *status);
+int ffpsse(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, float *array, int *status);
+int ffpssd(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, double *array, int *status);
+int ffpssjj(fitsfile *fptr, long group, long naxis, long *naxes,
+ long *fpixel, long *lpixel, LONGLONG *array, int *status);
+
+int ffpgpb(fitsfile *fptr, long group, long firstelem,
+ long nelem, unsigned char *array, int *status);
+int ffpgpsb(fitsfile *fptr, long group, long firstelem,
+ long nelem, signed char *array, int *status);
+int ffpgpui(fitsfile *fptr, long group, long firstelem,
+ long nelem, unsigned short *array, int *status);
+int ffpgpi(fitsfile *fptr, long group, long firstelem,
+ long nelem, short *array, int *status);
+int ffpgpuj(fitsfile *fptr, long group, long firstelem,
+ long nelem, unsigned long *array, int *status);
+int ffpgpj(fitsfile *fptr, long group, long firstelem,
+ long nelem, long *array, int *status);
+int ffpgpuk(fitsfile *fptr, long group, long firstelem,
+ long nelem, unsigned int *array, int *status);
+int ffpgpk(fitsfile *fptr, long group, long firstelem,
+ long nelem, int *array, int *status);
+int ffpgpe(fitsfile *fptr, long group, long firstelem,
+ long nelem, float *array, int *status);
+int ffpgpd(fitsfile *fptr, long group, long firstelem,
+ long nelem, double *array, int *status);
+int ffpgpjj(fitsfile *fptr, long group, long firstelem,
+ long nelem, LONGLONG *array, int *status);
+
+/*--------------------- iterator functions -------------*/
+int fits_iter_set_by_name(iteratorCol *col, fitsfile *fptr, char *colname,
+ int datatype, int iotype);
+int fits_iter_set_by_num(iteratorCol *col, fitsfile *fptr, int colnum,
+ int datatype, int iotype);
+int fits_iter_set_file(iteratorCol *col, fitsfile *fptr);
+int fits_iter_set_colname(iteratorCol *col, char *colname);
+int fits_iter_set_colnum(iteratorCol *col, int colnum);
+int fits_iter_set_datatype(iteratorCol *col, int datatype);
+int fits_iter_set_iotype(iteratorCol *col, int iotype);
+
+fitsfile * fits_iter_get_file(iteratorCol *col);
+char * fits_iter_get_colname(iteratorCol *col);
+int fits_iter_get_colnum(iteratorCol *col);
+int fits_iter_get_datatype(iteratorCol *col);
+int fits_iter_get_iotype(iteratorCol *col);
+void * fits_iter_get_array(iteratorCol *col);
+long fits_iter_get_tlmin(iteratorCol *col);
+long fits_iter_get_tlmax(iteratorCol *col);
+long fits_iter_get_repeat(iteratorCol *col);
+char * fits_iter_get_tunit(iteratorCol *col);
+char * fits_iter_get_tdisp(iteratorCol *col);
+
+int ffiter(int ncols, iteratorCol *data, long offset, long nPerLoop,
+ int (*workFn)( long totaln, long offset, long firstn,
+ long nvalues, int narrays, iteratorCol *data, void *userPointer),
+ void *userPointer, int *status);
+
+/*--------------------- write column elements -------------*/
+int ffpcl(fitsfile *fptr, int datatype, int colnum, LONGLONG firstrow,
+ LONGLONG firstelem, LONGLONG nelem, void *array, int *status);
+int ffpcls(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, char **array, int *status);
+int ffpcll(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, char *array, int *status);
+int ffpclb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned char *array, int *status);
+int ffpclsb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, signed char *array, int *status);
+int ffpclui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned short *array, int *status);
+int ffpcli(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, short *array, int *status);
+int ffpcluj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned long *array, int *status);
+int ffpclj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long *array, int *status);
+int ffpcluk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned int *array, int *status);
+int ffpclk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int *array, int *status);
+int ffpcle(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, float *array, int *status);
+int ffpcld(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, double *array, int *status);
+int ffpclc(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, float *array, int *status);
+int ffpclm(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, double *array, int *status);
+int ffpclu(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int *status);
+int ffprwu(fitsfile *fptr, LONGLONG firstrow, LONGLONG nrows, int *status);
+int ffpcljj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, LONGLONG *array, int *status);
+int ffpclx(fitsfile *fptr, int colnum, LONGLONG frow, long fbit, long nbit,
+ char *larray, int *status);
+
+int ffpcn(fitsfile *fptr, int datatype, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, void *array, void *nulval, int *status);
+int ffpcns( fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, char **array, char *nulvalue, int *status);
+int ffpcnl( fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, char *array, char nulvalue, int *status);
+int ffpcnb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned char *array, unsigned char nulvalue,
+ int *status);
+int ffpcnsb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, signed char *array, signed char nulvalue,
+ int *status);
+int ffpcnui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned short *array, unsigned short nulvalue,
+ int *status);
+int ffpcni(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, short *array, short nulvalue, int *status);
+int ffpcnuj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned long *array, unsigned long nulvalue,
+ int *status);
+int ffpcnj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long *array, long nulvalue, int *status);
+int ffpcnuk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, unsigned int *array, unsigned int nulvalue,
+ int *status);
+int ffpcnk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int *array, int nulvalue, int *status);
+int ffpcne(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, float *array, float nulvalue, int *status);
+int ffpcnd(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, double *array, double nulvalue, int *status);
+int ffpcnjj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, LONGLONG *array, LONGLONG nulvalue, int *status);
+int ffptbb(fitsfile *fptr, LONGLONG firstrow, LONGLONG firstchar, LONGLONG nchars,
+ unsigned char *values, int *status);
+
+int ffirow(fitsfile *fptr, LONGLONG firstrow, LONGLONG nrows, int *status);
+int ffdrow(fitsfile *fptr, LONGLONG firstrow, LONGLONG nrows, int *status);
+int ffdrrg(fitsfile *fptr, char *ranges, int *status);
+int ffdrws(fitsfile *fptr, long *rownum, long nrows, int *status);
+int ffdrwsll(fitsfile *fptr, LONGLONG *rownum, LONGLONG nrows, int *status);
+int fficol(fitsfile *fptr, int numcol, char *ttype, char *tform, int *status);
+int fficls(fitsfile *fptr, int firstcol, int ncols, char **ttype,
+ char **tform, int *status);
+int ffmvec(fitsfile *fptr, int colnum, LONGLONG newveclen, int *status);
+int ffdcol(fitsfile *fptr, int numcol, int *status);
+int ffcpcl(fitsfile *infptr, fitsfile *outfptr, int incol, int outcol,
+ int create_col, int *status);
+int ffcprw(fitsfile *infptr, fitsfile *outfptr, LONGLONG firstrow,
+ LONGLONG nrows, int *status);
+
+/*--------------------- WCS Utilities ------------------*/
+int ffgics(fitsfile *fptr, double *xrval, double *yrval, double *xrpix,
+ double *yrpix, double *xinc, double *yinc, double *rot,
+ char *type, int *status);
+int ffgicsa(fitsfile *fptr, char version, double *xrval, double *yrval, double *xrpix,
+ double *yrpix, double *xinc, double *yinc, double *rot,
+ char *type, int *status);
+int ffgtcs(fitsfile *fptr, int xcol, int ycol, double *xrval,
+ double *yrval, double *xrpix, double *yrpix, double *xinc,
+ double *yinc, double *rot, char *type, int *status);
+int ffwldp(double xpix, double ypix, double xref, double yref,
+ double xrefpix, double yrefpix, double xinc, double yinc,
+ double rot, char *type, double *xpos, double *ypos, int *status);
+int ffxypx(double xpos, double ypos, double xref, double yref,
+ double xrefpix, double yrefpix, double xinc, double yinc,
+ double rot, char *type, double *xpix, double *ypix, int *status);
+
+/* WCS support routines (provide interface to Doug Mink's WCS library */
+int ffgiwcs(fitsfile *fptr, char **header, int *status);
+int ffgtwcs(fitsfile *fptr, int xcol, int ycol, char **header, int *status);
+
+/*--------------------- lexical parsing routines ------------------*/
+int fftexp( fitsfile *fptr, char *expr, int maxdim,
+ int *datatype, long *nelem, int *naxis,
+ long *naxes, int *status );
+
+int fffrow( fitsfile *infptr, char *expr,
+ long firstrow, long nrows,
+ long *n_good_rows, char *row_status, int *status);
+
+int ffffrw( fitsfile *fptr, char *expr, long *rownum, int *status);
+
+int fffrwc( fitsfile *fptr, char *expr, char *timeCol,
+ char *parCol, char *valCol, long ntimes,
+ double *times, char *time_status, int *status );
+
+int ffsrow( fitsfile *infptr, fitsfile *outfptr, char *expr,
+ int *status);
+
+int ffcrow( fitsfile *fptr, int datatype, char *expr,
+ long firstrow, long nelements, void *nulval,
+ void *array, int *anynul, int *status );
+
+int ffcalc_rng( fitsfile *infptr, char *expr, fitsfile *outfptr,
+ char *parName, char *parInfo, int nRngs,
+ long *start, long *end, int *status );
+
+int ffcalc( fitsfile *infptr, char *expr, fitsfile *outfptr,
+ char *parName, char *parInfo, int *status );
+
+ /* ffhist is not really intended as a user-callable routine */
+ /* but it may be useful for some specialized applications */
+ /* ffhist2 is a newer version which is strongly recommended instead of ffhist */
+
+int ffhist(fitsfile **fptr, char *outfile, int imagetype, int naxis,
+ char colname[4][FLEN_VALUE],
+ double *minin, double *maxin, double *binsizein,
+ char minname[4][FLEN_VALUE], char maxname[4][FLEN_VALUE],
+ char binname[4][FLEN_VALUE],
+ double weightin, char wtcol[FLEN_VALUE],
+ int recip, char *rowselect, int *status);
+int ffhist2(fitsfile **fptr, char *outfile, int imagetype, int naxis,
+ char colname[4][FLEN_VALUE],
+ double *minin, double *maxin, double *binsizein,
+ char minname[4][FLEN_VALUE], char maxname[4][FLEN_VALUE],
+ char binname[4][FLEN_VALUE],
+ double weightin, char wtcol[FLEN_VALUE],
+ int recip, char *rowselect, int *status);
+
+int fits_select_image_section(fitsfile **fptr, char *outfile,
+ char *imagesection, int *status);
+int fits_copy_image_section(fitsfile *infptr, fitsfile *outfile,
+ char *imagesection, int *status);
+
+int fits_calc_binning(fitsfile *fptr, int naxis, char colname[4][FLEN_VALUE],
+ double *minin, double *maxin, double *binsizein,
+ char minname[4][FLEN_VALUE], char maxname[4][FLEN_VALUE],
+ char binname[4][FLEN_VALUE], int *colnum, long *haxes, float *amin,
+ float *amax, float *binsize, int *status);
+
+int fits_write_keys_histo(fitsfile *fptr, fitsfile *histptr,
+ int naxis, int *colnum, int *status);
+int fits_rebin_wcs( fitsfile *fptr, int naxis, float *amin, float *binsize,
+ int *status);
+int fits_make_hist(fitsfile *fptr, fitsfile *histptr, int bitpix,int naxis,
+ long *naxes, int *colnum, float *amin, float *amax, float *binsize,
+ float weight, int wtcolnum, int recip, char *selectrow, int *status);
+
+typedef struct
+{
+ /* input(s) */
+ int count;
+ char ** path;
+ char ** tag;
+ fitsfile ** ifptr;
+
+ char * expression;
+
+ /* output control */
+ int bitpix;
+ long blank;
+ fitsfile * ofptr;
+ char keyword[FLEN_KEYWORD];
+ char comment[FLEN_COMMENT];
+} PixelFilter;
+
+
+int fits_pixel_filter (PixelFilter * filter, int * status);
+
+
+/*--------------------- grouping routines ------------------*/
+
+int ffgtcr(fitsfile *fptr, char *grpname, int grouptype, int *status);
+int ffgtis(fitsfile *fptr, char *grpname, int grouptype, int *status);
+int ffgtch(fitsfile *gfptr, int grouptype, int *status);
+int ffgtrm(fitsfile *gfptr, int rmopt, int *status);
+int ffgtcp(fitsfile *infptr, fitsfile *outfptr, int cpopt, int *status);
+int ffgtmg(fitsfile *infptr, fitsfile *outfptr, int mgopt, int *status);
+int ffgtcm(fitsfile *gfptr, int cmopt, int *status);
+int ffgtvf(fitsfile *gfptr, long *firstfailed, int *status);
+int ffgtop(fitsfile *mfptr,int group,fitsfile **gfptr,int *status);
+int ffgtam(fitsfile *gfptr, fitsfile *mfptr, int hdupos, int *status);
+int ffgtnm(fitsfile *gfptr, long *nmembers, int *status);
+int ffgmng(fitsfile *mfptr, long *nmembers, int *status);
+int ffgmop(fitsfile *gfptr, long member, fitsfile **mfptr, int *status);
+int ffgmcp(fitsfile *gfptr, fitsfile *mfptr, long member, int cpopt,
+ int *status);
+int ffgmtf(fitsfile *infptr, fitsfile *outfptr, long member, int tfopt,
+ int *status);
+int ffgmrm(fitsfile *fptr, long member, int rmopt, int *status);
+
+/*--------------------- group template parser routines ------------------*/
+
+int fits_execute_template(fitsfile *ff, char *ngp_template, int *status);
+
+int fits_img_stats_short(short *array,long nx, long ny, int nullcheck,
+ short nullvalue,long *ngoodpix, short *minvalue, short *maxvalue, double *mean,
+ double *sigma, double *noise1, double *noise2, double *noise3, double *noise5, int *status);
+int fits_img_stats_int(int *array,long nx, long ny, int nullcheck,
+ int nullvalue,long *ngoodpix, int *minvalue, int *maxvalue, double *mean,
+ double *sigma, double *noise1, double *noise2, double *noise3, double *noise5, int *status);
+int fits_img_stats_float(float *array, long nx, long ny, int nullcheck,
+ float nullvalue,long *ngoodpix, float *minvalue, float *maxvalue, double *mean,
+ double *sigma, double *noise1, double *noise2, double *noise3, double *noise5, int *status);
+
+/*--------------------- image compression routines ------------------*/
+
+int fits_set_compression_type(fitsfile *fptr, int ctype, int *status);
+int fits_set_tile_dim(fitsfile *fptr, int ndim, long *dims, int *status);
+int fits_set_noise_bits(fitsfile *fptr, int noisebits, int *status);
+int fits_set_quantize_level(fitsfile *fptr, float qlevel, int *status);
+int fits_set_hcomp_scale(fitsfile *fptr, float scale, int *status);
+int fits_set_hcomp_smooth(fitsfile *fptr, int smooth, int *status);
+int fits_set_quantize_dither(fitsfile *fptr, int dither, int *status);
+int fits_set_dither_offset(fitsfile *fptr, int offset, int *status);
+int fits_set_lossy_int(fitsfile *fptr, int lossy_int, int *status);
+
+int fits_get_compression_type(fitsfile *fptr, int *ctype, int *status);
+int fits_get_tile_dim(fitsfile *fptr, int ndim, long *dims, int *status);
+int fits_get_quantize_level(fitsfile *fptr, float *qlevel, int *status);
+int fits_get_noise_bits(fitsfile *fptr, int *noisebits, int *status);
+int fits_get_hcomp_scale(fitsfile *fptr, float *scale, int *status);
+int fits_get_hcomp_smooth(fitsfile *fptr, int *smooth, int *status);
+int fits_get_dither_offset(fitsfile *fptr, int *offset, int *status);
+
+int fits_img_compress(fitsfile *infptr, fitsfile *outfptr, int *status);
+int fits_compress_img(fitsfile *infptr, fitsfile *outfptr, int compress_type,
+ long *tilesize, int parm1, int parm2, int *status);
+int fits_is_compressed_image(fitsfile *fptr, int *status);
+int fits_is_reentrant(void);
+int fits_decompress_img (fitsfile *infptr, fitsfile *outfptr, int *status);
+int fits_img_decompress_header(fitsfile *infptr, fitsfile *outfptr, int *status);
+int fits_img_decompress (fitsfile *infptr, fitsfile *outfptr, int *status);
+
+/* H-compress routines */
+int fits_hcompress(int *a, int nx, int ny, int scale, char *output,
+ long *nbytes, int *status);
+int fits_hcompress64(LONGLONG *a, int nx, int ny, int scale, char *output,
+ long *nbytes, int *status);
+int fits_hdecompress(unsigned char *input, int smooth, int *a, int *nx,
+ int *ny, int *scale, int *status);
+int fits_hdecompress64(unsigned char *input, int smooth, LONGLONG *a, int *nx,
+ int *ny, int *scale, int *status);
+
+int fits_transpose_table(fitsfile *infptr, fitsfile *outfptr, int *status);
+int fits_compress_table_fast(fitsfile *infptr, fitsfile *outfptr, int *status);
+int fits_compress_table_best(fitsfile *infptr, fitsfile *outfptr, int *status);
+int fits_compress_table_rice(fitsfile *infptr, fitsfile *outfptr, int *status);
+int fits_uncompress_table(fitsfile *infptr, fitsfile *outfptr, int *status);
+int fits_gzip_datablocks(fitsfile *fptr, size_t *size, int *status);
+
+/* The following exclusion if __CINT__ is defined is needed for ROOT */
+#ifndef __CINT__
+#ifdef __cplusplus
+}
+#endif
+#endif
+
+#endif
+
diff --git a/src/plugins/cfitsio/fitsio2.h b/src/plugins/cfitsio/fitsio2.h
new file mode 100644
index 0000000..b6fd66c
--- /dev/null
+++ b/src/plugins/cfitsio/fitsio2.h
@@ -0,0 +1,1205 @@
+#ifndef _FITSIO2_H
+#define _FITSIO2_H
+
+#include "fitsio.h"
+
+/*
+ Threading support using POSIX threads programming interface
+ (supplied by Bruce O'Neel)
+
+ All threaded programs MUST have the
+
+ -D_REENTRANT
+
+ on the compile line and must link with -lpthread. This means that
+ when one builds cfitsio for threads you must have -D_REENTRANT on the
+ gcc or cc command line.
+*/
+
+#ifdef _REENTRANT
+#include <pthread.h>
+#include <assert.h>
+extern pthread_mutex_t Fitsio_Lock;
+extern int Fitsio_Pthread_Status;
+
+#define FFLOCK1(lockname) (assert(!(Fitsio_Pthread_Status = pthread_mutex_lock(&lockname))))
+#define FFUNLOCK1(lockname) (assert(!(Fitsio_Pthread_Status = pthread_mutex_unlock(&lockname))))
+#define FFLOCK FFLOCK1(Fitsio_Lock)
+#define FFUNLOCK FFUNLOCK1(Fitsio_Lock)
+
+#else
+#define FFLOCK
+#define FFUNLOCK
+#endif
+
+/*
+ If REPLACE_LINKS is defined, then whenever CFITSIO fails to open
+ a file with write access because it is a soft link to a file that
+ only has read access, then CFITSIO will attempt to replace
+ the link with a local copy of the file, with write access. This
+ feature was originally added to support the ftools in the Hera
+ environment, where many of the user's data file are soft links.
+*/
+#if defined(BUILD_HERA)
+#define REPLACE_LINKS 1
+#endif
+
+#define USE_LARGE_VALUE -99 /* flag used when writing images */
+
+#define DBUFFSIZE 28800 /* size of data buffer in bytes */
+
+#define NMAXFILES 300 /* maximum number of FITS files that can be opened */
+ /* CFITSIO will allocate (NMAXFILES * 80) bytes of memory */
+
+#define MINDIRECT 8640 /* minimum size for direct reads and writes */
+ /* MINDIRECT must have a value >= 8640 */
+
+/* it is useful to identify certain specific types of machines */
+#define NATIVE 0 /* machine that uses non-byteswapped IEEE formats */
+#define OTHERTYPE 1 /* any other type of machine */
+#define VAXVMS 3 /* uses an odd floating point format */
+#define ALPHAVMS 4 /* uses an odd floating point format */
+#define IBMPC 5 /* used in drvrfile.c to work around a bug on PCs */
+#define CRAY 6 /* requires a special NaN test algorithm */
+
+#define GFLOAT 1 /* used for VMS */
+#define IEEEFLOAT 2 /* used for VMS */
+
+/* ======================================================================= */
+/* The following logic is used to determine the type machine, */
+/* whether the bytes are swapped, and the number of bits in a long value */
+/* ======================================================================= */
+
+/* The following platforms have sizeof(long) == 8 */
+/* This block of code should match a similar block in fitsio.h */
+/* and the block of code at the beginning of f77_wrap.h */
+
+#if defined(__alpha) && ( defined(__unix__) || defined(__NetBSD__) )
+ /* old Dec Alpha platforms running OSF */
+#define BYTESWAPPED TRUE
+#define LONGSIZE 64
+
+#elif defined(__sparcv9) || (defined(__sparc__) && defined(__arch64__))
+ /* SUN Solaris7 in 64-bit mode */
+#define BYTESWAPPED FALSE
+#define MACHINE NATIVE
+#define LONGSIZE 64
+
+ /* IBM System z mainframe support */
+#elif defined(__s390x__)
+#define BYTESWAPPED FALSE
+#define LONGSIZE 64
+
+#elif defined(__s390__)
+#define BYTESWAPPED FALSE
+#define LONGSIZE 32
+
+#elif defined(__ia64__) || defined(__x86_64__)
+ /* Intel itanium 64-bit PC, or AMD opteron 64-bit PC */
+#define BYTESWAPPED TRUE
+#define LONGSIZE 64
+
+#elif defined(_SX) /* Nec SuperUx */
+
+#define BYTESWAPPED FALSE
+#define MACHINE NATIVE
+#define LONGSIZE 64
+
+#elif defined(__powerpc64__) || defined(__64BIT__) /* IBM 64-bit AIX powerpc*/
+ /* could also test for __ppc64__ or __PPC64 */
+#define BYTESWAPPED FALSE
+#define MACHINE NATIVE
+#define LONGSIZE 64
+
+#elif defined(_MIPS_SZLONG)
+
+# if defined(MIPSEL)
+# define BYTESWAPPED TRUE
+# else
+# define BYTESWAPPED FALSE
+# define MACHINE NATIVE
+# endif
+
+# if _MIPS_SZLONG == 32
+# define LONGSIZE 32
+# elif _MIPS_SZLONG == 64
+# define LONGSIZE 64
+# else
+# error "can't handle long size given by _MIPS_SZLONG"
+# endif
+
+/* ============================================================== */
+/* the following are all 32-bit byteswapped platforms */
+
+#elif defined(vax) && defined(VMS)
+
+#define MACHINE VAXVMS
+#define BYTESWAPPED TRUE
+
+#elif defined(__alpha) && defined(__VMS)
+
+#if (__D_FLOAT == TRUE)
+
+/* this float option is the same as for VAX/VMS machines. */
+#define MACHINE VAXVMS
+#define BYTESWAPPED TRUE
+
+#elif (__G_FLOAT == TRUE)
+
+/* G_FLOAT is the default for ALPHA VMS systems */
+#define MACHINE ALPHAVMS
+#define BYTESWAPPED TRUE
+#define FLOATTYPE GFLOAT
+
+#elif (__IEEE_FLOAT == TRUE)
+
+#define MACHINE ALPHAVMS
+#define BYTESWAPPED TRUE
+#define FLOATTYPE IEEEFLOAT
+
+#endif /* end of alpha VMS case */
+
+#elif defined(ultrix) && defined(unix)
+ /* old Dec ultrix machines */
+#define BYTESWAPPED TRUE
+
+#elif defined(__i386) || defined(__i386__) || defined(__i486__) || defined(__i586__) \
+ || defined(_MSC_VER) || defined(__BORLANDC__) || defined(__TURBOC__) \
+ || defined(_NI_mswin_) || defined(__EMX__)
+
+/* generic 32-bit IBM PC */
+#define MACHINE IBMPC
+#define BYTESWAPPED TRUE
+
+#elif defined(__arm__)
+
+/* This assumes all ARM are little endian. In the future, it might be */
+/* necessary to use "if defined(__ARMEL__)" to distinguish little from big. */
+/* (__ARMEL__ would be defined on little-endian, but not on big-endian). */
+
+#define BYTESWAPPED TRUE
+
+#elif defined(__tile__)
+
+/* 64-core 8x8-architecture Tile64 platform */
+
+#define BYTESWAPPED TRUE
+
+#elif defined(__sh__)
+
+/* SuperH CPU can be used in both little and big endian modes */
+
+#if defined(__LITTLE_ENDIAN__)
+#define BYTESWAPPED TRUE
+#else
+#define BYTESWAPPED FALSE
+#endif
+
+#else
+
+/* assume all other machine uses the same IEEE formats as used in FITS files */
+/* e.g., Macs fall into this category */
+
+#define MACHINE NATIVE
+#define BYTESWAPPED FALSE
+
+#endif
+
+#ifndef MACHINE
+#define MACHINE OTHERTYPE
+#endif
+
+/* assume longs are 4 bytes long, unless previously set otherwise */
+#ifndef LONGSIZE
+#define LONGSIZE 32
+#endif
+
+/* end of block that determine long size and byte swapping */
+/* ==================================================================== */
+
+#define IGNORE_EOF 1
+#define REPORT_EOF 0
+#define DATA_UNDEFINED -1
+#define NULL_UNDEFINED 1234554321
+#define ASCII_NULL_UNDEFINED 1 /* indicate no defined null value */
+
+#define maxvalue(A,B) ((A) > (B) ? (A) : (B))
+#define minvalue(A,B) ((A) < (B) ? (A) : (B))
+
+/* faster string comparison macros */
+#define FSTRCMP(a,b) ((a)[0]<(b)[0]? -1:(a)[0]>(b)[0]?1:strcmp((a),(b)))
+#define FSTRNCMP(a,b,n) ((a)[0]<(b)[0]?-1:(a)[0]>(b)[0]?1:strncmp((a),(b),(n)))
+
+#if defined(__VMS) || defined(VMS)
+
+#define FNANMASK 0xFFFF /* mask all bits */
+#define DNANMASK 0xFFFF /* mask all bits */
+
+#else
+
+#define FNANMASK 0x7F80 /* mask bits 1 - 8; all set on NaNs */
+ /* all 0 on underflow or 0. */
+
+#define DNANMASK 0x7FF0 /* mask bits 1 - 11; all set on NaNs */
+ /* all 0 on underflow or 0. */
+
+#endif
+
+#if MACHINE == CRAY
+ /*
+ Cray machines: the large negative integer corresponds
+ to the 3 most sig digits set to 1. If these
+ 3 bits are set in a floating point number (64 bits), then it represents
+ a reserved value (i.e., a NaN)
+ */
+#define fnan(L) ( (L) >= 0xE000000000000000 ? 1 : 0) )
+
+#else
+ /* these functions work for both big and little endian machines */
+ /* that use the IEEE floating point format for internal numbers */
+
+ /* These functions tests whether the float value is a reserved IEEE */
+ /* value such as a Not-a-Number (NaN), or underflow, overflow, or */
+ /* infinity. The functions returns 1 if the value is a NaN, overflow */
+ /* or infinity; it returns 2 if the value is an denormalized underflow */
+ /* value; otherwise it returns 0. fnan tests floats, dnan tests doubles */
+
+#define fnan(L) \
+ ( (L & FNANMASK) == FNANMASK ? 1 : (L & FNANMASK) == 0 ? 2 : 0)
+
+#define dnan(L) \
+ ( (L & DNANMASK) == DNANMASK ? 1 : (L & DNANMASK) == 0 ? 2 : 0)
+
+#endif
+
+#define DSCHAR_MAX 127.49 /* max double value that fits in an signed char */
+#define DSCHAR_MIN -128.49 /* min double value that fits in an signed char */
+#define DUCHAR_MAX 255.49 /* max double value that fits in an unsigned char */
+#define DUCHAR_MIN -0.49 /* min double value that fits in an unsigned char */
+#define DUSHRT_MAX 65535.49 /* max double value that fits in a unsigned short*/
+#define DUSHRT_MIN -0.49 /* min double value that fits in an unsigned short */
+#define DSHRT_MAX 32767.49 /* max double value that fits in a short */
+#define DSHRT_MIN -32768.49 /* min double value that fits in a short */
+
+#if LONGSIZE == 32
+# define DLONG_MAX 2147483647.49 /* max double value that fits in a long */
+# define DLONG_MIN -2147483648.49 /* min double value that fits in a long */
+# define DULONG_MAX 4294967295.49 /* max double that fits in a unsigned long */
+#else
+# define DLONG_MAX 9.2233720368547752E18 /* max double value long */
+# define DLONG_MIN -9.2233720368547752E18 /* min double value long */
+# define DULONG_MAX 1.84467440737095504E19 /* max double value ulong */
+#endif
+
+#define DULONG_MIN -0.49 /* min double value that fits in an unsigned long */
+#define DLONGLONG_MAX 9.2233720368547755807E18 /* max double value longlong */
+#define DLONGLONG_MIN -9.2233720368547755808E18 /* min double value longlong */
+#define DUINT_MAX 4294967295.49 /* max dbl that fits in a unsigned 4-byte int */
+#define DUINT_MIN -0.49 /* min dbl that fits in an unsigned 4-byte int */
+#define DINT_MAX 2147483647.49 /* max double value that fits in a 4-byte int */
+#define DINT_MIN -2147483648.49 /* min double value that fits in a 4-byte int */
+
+#ifndef UINT32_MAX
+#define UINT32_MAX 4294967295U /* max unsigned 32-bit integer */
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX 2147483647 /* max 32-bit integer */
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN (-INT32_MAX -1) /* min 32-bit integer */
+#endif
+
+
+#define COMPRESS_NULL_VALUE -2147483647
+#define N_RANDOM 10000 /* DO NOT CHANGE THIS; used when quantizing real numbers */
+
+int ffmkky(const char *keyname, char *keyval, const char *comm, char *card, int *status);
+int ffgnky(fitsfile *fptr, char *card, int *status);
+void ffcfmt(char *tform, char *cform);
+void ffcdsp(char *tform, char *cform);
+void ffswap2(short *values, long nvalues);
+void ffswap4(INT32BIT *values, long nvalues);
+void ffswap8(double *values, long nvalues);
+int ffi2c(LONGLONG ival, char *cval, int *status);
+int ffl2c(int lval, char *cval, int *status);
+int ffs2c(char *instr, char *outstr, int *status);
+int ffr2f(float fval, int decim, char *cval, int *status);
+int ffr2e(float fval, int decim, char *cval, int *status);
+int ffd2f(double dval, int decim, char *cval, int *status);
+int ffd2e(double dval, int decim, char *cval, int *status);
+int ffc2ii(char *cval, long *ival, int *status);
+int ffc2jj(char *cval, LONGLONG *ival, int *status);
+int ffc2ll(char *cval, int *lval, int *status);
+int ffc2rr(char *cval, float *fval, int *status);
+int ffc2dd(char *cval, double *dval, int *status);
+int ffc2x(char *cval, char *dtype, long *ival, int *lval, char *sval,
+ double *dval, int *status);
+int ffc2s(char *instr, char *outstr, int *status);
+int ffc2i(char *cval, long *ival, int *status);
+int ffc2j(char *cval, LONGLONG *ival, int *status);
+int ffc2r(char *cval, float *fval, int *status);
+int ffc2d(char *cval, double *dval, int *status);
+int ffc2l(char *cval, int *lval, int *status);
+void ffxmsg(int action, char *err_message);
+int ffgcnt(fitsfile *fptr, char *value, int *status);
+int ffgtkn(fitsfile *fptr, int numkey, char *keyname, long *value, int *status);
+int ffgtknjj(fitsfile *fptr, int numkey, char *keyname, LONGLONG *value, int *status);
+int fftkyn(fitsfile *fptr, int numkey, char *keyname, char *value, int *status);
+int ffgphd(fitsfile *fptr, int maxdim, int *simple, int *bitpix, int *naxis,
+ LONGLONG naxes[], long *pcount, long *gcount, int *extend, double *bscale,
+ double *bzero, LONGLONG *blank, int *nspace, int *status);
+int ffgttb(fitsfile *fptr, LONGLONG *rowlen, LONGLONG *nrows, LONGLONG *pcount,
+ long *tfield, int *status);
+
+int ffmkey(fitsfile *fptr, char *card, int *status);
+
+/* ffmbyt has been moved to fitsio.h */
+int ffgbyt(fitsfile *fptr, LONGLONG nbytes, void *buffer, int *status);
+int ffpbyt(fitsfile *fptr, LONGLONG nbytes, void *buffer, int *status);
+int ffgbytoff(fitsfile *fptr, long gsize, long ngroups, long offset,
+ void *buffer, int *status);
+int ffpbytoff(fitsfile *fptr, long gsize, long ngroups, long offset,
+ void *buffer, int *status);
+int ffldrc(fitsfile *fptr, long record, int err_mode, int *status);
+int ffwhbf(fitsfile *fptr, int *nbuff);
+int ffbfeof(fitsfile *fptr, int *status);
+int ffbfwt(FITSfile *Fptr, int nbuff, int *status);
+int ffpxsz(int datatype);
+
+int ffourl(char *url, char *urltype, char *outfile, char *tmplfile,
+ char *compspec, int *status);
+int ffparsecompspec(fitsfile *fptr, char *compspec, int *status);
+int ffoptplt(fitsfile *fptr, const char *tempname, int *status);
+int fits_is_this_a_copy(char *urltype);
+int fits_store_Fptr(FITSfile *Fptr, int *status);
+int fits_clear_Fptr(FITSfile *Fptr, int *status);
+int fits_already_open(fitsfile **fptr, char *url,
+ char *urltype, char *infile, char *extspec, char *rowfilter,
+ char *binspec, char *colspec, int mode,int *isopen, int *status);
+int ffedit_columns(fitsfile **fptr, char *outfile, char *expr, int *status);
+int fits_get_col_minmax(fitsfile *fptr, int colnum, float *datamin,
+ float *datamax, int *status);
+int ffwritehisto(long totaln, long offset, long firstn, long nvalues,
+ int narrays, iteratorCol *imagepars, void *userPointer);
+int ffcalchist(long totalrows, long offset, long firstrow, long nrows,
+ int ncols, iteratorCol *colpars, void *userPointer);
+int ffrhdu(fitsfile *fptr, int *hdutype, int *status);
+int ffpinit(fitsfile *fptr, int *status);
+int ffainit(fitsfile *fptr, int *status);
+int ffbinit(fitsfile *fptr, int *status);
+int ffchdu(fitsfile *fptr, int *status);
+int ffwend(fitsfile *fptr, int *status);
+int ffpdfl(fitsfile *fptr, int *status);
+int ffuptf(fitsfile *fptr, int *status);
+
+int ffdblk(fitsfile *fptr, long nblocks, int *status);
+int ffgext(fitsfile *fptr, int moveto, int *exttype, int *status);
+int ffgtbc(fitsfile *fptr, LONGLONG *totalwidth, int *status);
+int ffgtbp(fitsfile *fptr, char *name, char *value, int *status);
+int ffiblk(fitsfile *fptr, long nblock, int headdata, int *status);
+int ffshft(fitsfile *fptr, LONGLONG firstbyte, LONGLONG nbytes, LONGLONG nshift,
+ int *status);
+
+ int ffgcprll(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int writemode, double *scale, double *zero, char *tform,
+ long *twidth, int *tcode, int *maxelem, LONGLONG *startpos,
+ LONGLONG *elemnum, long *incre, LONGLONG *repeat, LONGLONG *rowlen,
+ int *hdutype, LONGLONG *tnull, char *snull, int *status);
+
+int ffflushx(FITSfile *fptr);
+int ffseek(FITSfile *fptr, LONGLONG position);
+int ffread(FITSfile *fptr, long nbytes, void *buffer,
+ int *status);
+int ffwrite(FITSfile *fptr, long nbytes, void *buffer,
+ int *status);
+int fftrun(fitsfile *fptr, LONGLONG filesize, int *status);
+
+int ffpcluc(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int *status);
+
+int ffgcll(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int nultyp, char nulval, char *array, char *nularray,
+ int *anynul, int *status);
+int ffgcls(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int nultyp, char *nulval,
+ char **array, char *nularray, int *anynul, int *status);
+int ffgcls2(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, int nultyp, char *nulval,
+ char **array, char *nularray, int *anynul, int *status);
+int ffgclb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, unsigned char nulval,
+ unsigned char *array, char *nularray, int *anynul, int *status);
+int ffgclsb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, signed char nulval,
+ signed char *array, char *nularray, int *anynul, int *status);
+int ffgclui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, unsigned short nulval,
+ unsigned short *array, char *nularray, int *anynul, int *status);
+int ffgcli(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, short nulval,
+ short *array, char *nularray, int *anynul, int *status);
+int ffgcluj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, unsigned long nulval,
+ unsigned long *array, char *nularray, int *anynul, int *status);
+int ffgcljj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, LONGLONG nulval,
+ LONGLONG *array, char *nularray, int *anynul, int *status);
+int ffgclj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, long nulval, long *array,
+ char *nularray, int *anynul, int *status);
+int ffgcluk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, unsigned int nulval,
+ unsigned int *array, char *nularray, int *anynul, int *status);
+int ffgclk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, int nulval, int *array,
+ char *nularray, int *anynul, int *status);
+int ffgcle(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, float nulval, float *array,
+ char *nularray, int *anynul, int *status);
+int ffgcld(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem,
+ LONGLONG nelem, long elemincre, int nultyp, double nulval,
+ double *array, char *nularray, int *anynul, int *status);
+
+int ffpi1b(fitsfile *fptr, long nelem, long incre, unsigned char *buffer,
+ int *status);
+int ffpi2b(fitsfile *fptr, long nelem, long incre, short *buffer, int *status);
+int ffpi4b(fitsfile *fptr, long nelem, long incre, INT32BIT *buffer,
+ int *status);
+int ffpi8b(fitsfile *fptr, long nelem, long incre, long *buffer, int *status);
+int ffpr4b(fitsfile *fptr, long nelem, long incre, float *buffer, int *status);
+int ffpr8b(fitsfile *fptr, long nelem, long incre, double *buffer, int *status);
+
+int ffgi1b(fitsfile *fptr, LONGLONG pos, long nelem, long incre,
+ unsigned char *buffer, int *status);
+int ffgi2b(fitsfile *fptr, LONGLONG pos, long nelem, long incre, short *buffer,
+ int *status);
+int ffgi4b(fitsfile *fptr, LONGLONG pos, long nelem, long incre, INT32BIT *buffer,
+ int *status);
+int ffgi8b(fitsfile *fptr, LONGLONG pos, long nelem, long incre, long *buffer,
+ int *status);
+int ffgr4b(fitsfile *fptr, LONGLONG pos, long nelem, long incre, float *buffer,
+ int *status);
+int ffgr8b(fitsfile *fptr, LONGLONG pos, long nelem, long incre, double *buffer,
+ int *status);
+
+int ffcins(fitsfile *fptr, LONGLONG naxis1, LONGLONG naxis2, LONGLONG nbytes,
+ LONGLONG bytepos, int *status);
+int ffcdel(fitsfile *fptr, LONGLONG naxis1, LONGLONG naxis2, LONGLONG nbytes,
+ LONGLONG bytepos, int *status);
+int ffkshf(fitsfile *fptr, int firstcol, int tfields, int nshift, int *status);
+
+int fffi1i1(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, unsigned char nullval, char
+ *nullarray, int *anynull, unsigned char *output, int *status);
+int fffi2i1(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, unsigned char nullval, char *nullarray,
+ int *anynull, unsigned char *output, int *status);
+int fffi4i1(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, unsigned char nullval, char *nullarray,
+ int *anynull, unsigned char *output, int *status);
+int fffi8i1(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, unsigned char nullval, char *nullarray,
+ int *anynull, unsigned char *output, int *status);
+int fffr4i1(float *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char nullval, char *nullarray,
+ int *anynull, unsigned char *output, int *status);
+int fffr8i1(double *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char nullval, char *nullarray,
+ int *anynull, unsigned char *output, int *status);
+int fffstri1(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ unsigned char nullval, char *nullarray, int *anynull,
+ unsigned char *output, int *status);
+
+int fffi1s1(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, signed char nullval, char
+ *nullarray, int *anynull, signed char *output, int *status);
+int fffi2s1(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, signed char nullval, char *nullarray,
+ int *anynull, signed char *output, int *status);
+int fffi4s1(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, signed char nullval, char *nullarray,
+ int *anynull, signed char *output, int *status);
+int fffi8s1(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, signed char nullval, char *nullarray,
+ int *anynull, signed char *output, int *status);
+int fffr4s1(float *input, long ntodo, double scale, double zero,
+ int nullcheck, signed char nullval, char *nullarray,
+ int *anynull, signed char *output, int *status);
+int fffr8s1(double *input, long ntodo, double scale, double zero,
+ int nullcheck, signed char nullval, char *nullarray,
+ int *anynull, signed char *output, int *status);
+int fffstrs1(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ signed char nullval, char *nullarray, int *anynull,
+ signed char *output, int *status);
+
+int fffi1u2(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, unsigned short nullval,
+ char *nullarray,
+ int *anynull, unsigned short *output, int *status);
+int fffi2u2(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, unsigned short nullval, char *nullarray,
+ int *anynull, unsigned short *output, int *status);
+int fffi4u2(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, unsigned short nullval, char *nullarray,
+ int *anynull, unsigned short *output, int *status);
+int fffi8u2(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, unsigned short nullval, char *nullarray,
+ int *anynull, unsigned short *output, int *status);
+int fffr4u2(float *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned short nullval, char *nullarray,
+ int *anynull, unsigned short *output, int *status);
+int fffr8u2(double *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned short nullval, char *nullarray,
+ int *anynull, unsigned short *output, int *status);
+int fffstru2(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ unsigned short nullval, char *nullarray, int *anynull,
+ unsigned short *output, int *status);
+
+int fffi1i2(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, short nullval, char *nullarray,
+ int *anynull, short *output, int *status);
+int fffi2i2(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, short nullval, char *nullarray,
+ int *anynull, short *output, int *status);
+int fffi4i2(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, short nullval, char *nullarray,
+ int *anynull, short *output, int *status);
+int fffi8i2(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, short nullval, char *nullarray,
+ int *anynull, short *output, int *status);
+int fffr4i2(float *input, long ntodo, double scale, double zero,
+ int nullcheck, short nullval, char *nullarray,
+ int *anynull, short *output, int *status);
+int fffr8i2(double *input, long ntodo, double scale, double zero,
+ int nullcheck, short nullval, char *nullarray,
+ int *anynull, short *output, int *status);
+int fffstri2(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ short nullval, char *nullarray, int *anynull, short *output,
+ int *status);
+
+int fffi1u4(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, unsigned long nullval,
+ char *nullarray,
+ int *anynull, unsigned long *output, int *status);
+int fffi2u4(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, unsigned long nullval, char *nullarray,
+ int *anynull, unsigned long *output, int *status);
+int fffi4u4(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, unsigned long nullval, char *nullarray,
+ int *anynull, unsigned long *output, int *status);
+int fffi8u4(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, unsigned long nullval, char *nullarray,
+ int *anynull, unsigned long *output, int *status);
+int fffr4u4(float *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned long nullval, char *nullarray,
+ int *anynull, unsigned long *output, int *status);
+int fffr8u4(double *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned long nullval, char *nullarray,
+ int *anynull, unsigned long *output, int *status);
+int fffstru4(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ unsigned long nullval, char *nullarray, int *anynull,
+ unsigned long *output, int *status);
+
+int fffi1i4(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, long nullval, char *nullarray,
+ int *anynull, long *output, int *status);
+int fffi2i4(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, long nullval, char *nullarray,
+ int *anynull, long *output, int *status);
+int fffi4i4(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, long nullval, char *nullarray,
+ int *anynull, long *output, int *status);
+int fffi8i4(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, long nullval, char *nullarray,
+ int *anynull, long *output, int *status);
+int fffr4i4(float *input, long ntodo, double scale, double zero,
+ int nullcheck, long nullval, char *nullarray,
+ int *anynull, long *output, int *status);
+int fffr8i4(double *input, long ntodo, double scale, double zero,
+ int nullcheck, long nullval, char *nullarray,
+ int *anynull, long *output, int *status);
+int fffstri4(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ long nullval, char *nullarray, int *anynull, long *output,
+ int *status);
+
+int fffi1int(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, int nullval, char *nullarray,
+ int *anynull, int *output, int *status);
+int fffi2int(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, int nullval, char *nullarray,
+ int *anynull, int *output, int *status);
+int fffi4int(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, int nullval, char *nullarray,
+ int *anynull, int *output, int *status);
+int fffi8int(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, int nullval, char *nullarray,
+ int *anynull, int *output, int *status);
+int fffr4int(float *input, long ntodo, double scale, double zero,
+ int nullcheck, int nullval, char *nullarray,
+ int *anynull, int *output, int *status);
+int fffr8int(double *input, long ntodo, double scale, double zero,
+ int nullcheck, int nullval, char *nullarray,
+ int *anynull, int *output, int *status);
+int fffstrint(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ int nullval, char *nullarray, int *anynull, int *output,
+ int *status);
+
+int fffi1uint(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, unsigned int nullval,
+ char *nullarray, int *anynull, unsigned int *output, int *status);
+int fffi2uint(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, unsigned int nullval, char *nullarray,
+ int *anynull, unsigned int *output, int *status);
+int fffi4uint(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, unsigned int nullval, char *nullarray,
+ int *anynull, unsigned int *output, int *status);
+int fffi8uint(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, unsigned int nullval, char *nullarray,
+ int *anynull, unsigned int *output, int *status);
+int fffr4uint(float *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned int nullval, char *nullarray,
+ int *anynull, unsigned int *output, int *status);
+int fffr8uint(double *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned int nullval, char *nullarray,
+ int *anynull, unsigned int *output, int *status);
+int fffstruint(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ unsigned int nullval, char *nullarray, int *anynull,
+ unsigned int *output, int *status);
+
+int fffi1i8(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, LONGLONG nullval,
+ char *nullarray, int *anynull, LONGLONG *output, int *status);
+int fffi2i8(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, LONGLONG nullval, char *nullarray,
+ int *anynull, LONGLONG *output, int *status);
+int fffi4i8(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, LONGLONG nullval, char *nullarray,
+ int *anynull, LONGLONG *output, int *status);
+int fffi8i8(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, LONGLONG nullval, char *nullarray,
+ int *anynull, LONGLONG *output, int *status);
+int fffr4i8(float *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG nullval, char *nullarray,
+ int *anynull, LONGLONG *output, int *status);
+int fffr8i8(double *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG nullval, char *nullarray,
+ int *anynull, LONGLONG *output, int *status);
+int fffstri8(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ LONGLONG nullval, char *nullarray, int *anynull, LONGLONG *output,
+ int *status);
+
+int fffi1r4(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, float nullval, char *nullarray,
+ int *anynull, float *output, int *status);
+int fffi2r4(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, float nullval, char *nullarray,
+ int *anynull, float *output, int *status);
+int fffi4r4(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, float nullval, char *nullarray,
+ int *anynull, float *output, int *status);
+int fffi8r4(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, float nullval, char *nullarray,
+ int *anynull, float *output, int *status);
+int fffr4r4(float *input, long ntodo, double scale, double zero,
+ int nullcheck, float nullval, char *nullarray,
+ int *anynull, float *output, int *status);
+int fffr8r4(double *input, long ntodo, double scale, double zero,
+ int nullcheck, float nullval, char *nullarray,
+ int *anynull, float *output, int *status);
+int fffstrr4(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ float nullval, char *nullarray, int *anynull, float *output,
+ int *status);
+
+int fffi1r8(unsigned char *input, long ntodo, double scale, double zero,
+ int nullcheck, unsigned char tnull, double nullval, char *nullarray,
+ int *anynull, double *output, int *status);
+int fffi2r8(short *input, long ntodo, double scale, double zero,
+ int nullcheck, short tnull, double nullval, char *nullarray,
+ int *anynull, double *output, int *status);
+int fffi4r8(INT32BIT *input, long ntodo, double scale, double zero,
+ int nullcheck, INT32BIT tnull, double nullval, char *nullarray,
+ int *anynull, double *output, int *status);
+int fffi8r8(LONGLONG *input, long ntodo, double scale, double zero,
+ int nullcheck, LONGLONG tnull, double nullval, char *nullarray,
+ int *anynull, double *output, int *status);
+int fffr4r8(float *input, long ntodo, double scale, double zero,
+ int nullcheck, double nullval, char *nullarray,
+ int *anynull, double *output, int *status);
+int fffr8r8(double *input, long ntodo, double scale, double zero,
+ int nullcheck, double nullval, char *nullarray,
+ int *anynull, double *output, int *status);
+int fffstrr8(char *input, long ntodo, double scale, double zero,
+ long twidth, double power, int nullcheck, char *snull,
+ double nullval, char *nullarray, int *anynull, double *output,
+ int *status);
+
+int ffi1fi1(unsigned char *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffs1fi1(signed char *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffu2fi1(unsigned short *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffi2fi1(short *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffu4fi1(unsigned long *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffi4fi1(long *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffi8fi1(LONGLONG *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffuintfi1(unsigned int *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffintfi1(int *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffr4fi1(float *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+int ffr8fi1(double *array, long ntodo, double scale, double zero,
+ unsigned char *buffer, int *status);
+
+int ffi1fi2(unsigned char *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffs1fi2(signed char *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffu2fi2(unsigned short *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffi2fi2(short *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffu4fi2(unsigned long *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffi4fi2(long *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffi8fi2(LONGLONG *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffuintfi2(unsigned int *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffintfi2(int *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffr4fi2(float *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+int ffr8fi2(double *array, long ntodo, double scale, double zero,
+ short *buffer, int *status);
+
+int ffi1fi4(unsigned char *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffs1fi4(signed char *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffu2fi4(unsigned short *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffi2fi4(short *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffu4fi4(unsigned long *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffi4fi4(long *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffi8fi4(LONGLONG *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffuintfi4(unsigned int *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffintfi4(int *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffr4fi4(float *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+int ffr8fi4(double *array, long ntodo, double scale, double zero,
+ INT32BIT *buffer, int *status);
+
+int fflongfi8(long *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffi8fi8(LONGLONG *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffi2fi8(short *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffi1fi8(unsigned char *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffs1fi8(signed char *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffr4fi8(float *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffr8fi8(double *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffintfi8(int *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffu2fi8(unsigned short *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffu4fi8(unsigned long *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+int ffuintfi8(unsigned int *array, long ntodo, double scale, double zero,
+ LONGLONG *buffer, int *status);
+
+int ffi1fr4(unsigned char *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffs1fr4(signed char *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffu2fr4(unsigned short *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffi2fr4(short *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffu4fr4(unsigned long *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffi4fr4(long *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffi8fr4(LONGLONG *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffuintfr4(unsigned int *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffintfr4(int *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffr4fr4(float *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+int ffr8fr4(double *array, long ntodo, double scale, double zero,
+ float *buffer, int *status);
+
+int ffi1fr8(unsigned char *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffs1fr8(signed char *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffu2fr8(unsigned short *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffi2fr8(short *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffu4fr8(unsigned long *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffi4fr8(long *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffi8fr8(LONGLONG *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffuintfr8(unsigned int *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffintfr8(int *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffr4fr8(float *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+int ffr8fr8(double *array, long ntodo, double scale, double zero,
+ double *buffer, int *status);
+
+int ffi1fstr(unsigned char *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffs1fstr(signed char *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffu2fstr(unsigned short *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffi2fstr(short *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffu4fstr(unsigned long *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffi4fstr(long *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffi8fstr(LONGLONG *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffintfstr(int *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffuintfstr(unsigned int *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffr4fstr(float *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+int ffr8fstr(double *input, long ntodo, double scale, double zero,
+ char *cform, long twidth, char *output, int *status);
+
+/* the following 4 routines are VMS macros used on VAX or Alpha VMS */
+void ieevpd(double *inarray, double *outarray, long *nvals);
+void ieevud(double *inarray, double *outarray, long *nvals);
+void ieevpr(float *inarray, float *outarray, long *nvals);
+void ieevur(float *inarray, float *outarray, long *nvals);
+
+/* routines related to the lexical parser */
+int ffselect_table(fitsfile **fptr, char *outfile, char *expr, int *status);
+int ffiprs( fitsfile *fptr, int compressed, char *expr, int maxdim,
+ int *datatype, long *nelem, int *naxis, long *naxes,
+ int *status );
+void ffcprs( void );
+int ffcvtn( int inputType, void *input, char *undef, long ntodo,
+ int outputType, void *nulval, void *output,
+ int *anynull, int *status );
+int parse_data( long totalrows, long offset, long firstrow,
+ long nrows, int nCols, iteratorCol *colData,
+ void *userPtr );
+int uncompress_hkdata( fitsfile *fptr, long ntimes,
+ double *times, int *status );
+int ffffrw_work( long totalrows, long offset, long firstrow,
+ long nrows, int nCols, iteratorCol *colData,
+ void *userPtr );
+
+int fits_translate_pixkeyword(char *inrec, char *outrec,char *patterns[][2],
+ int npat, int naxis, int *colnum, int *pat_num, int *i,
+ int *j, int *n, int *m, int *l, int *status);
+
+/* image compression routines */
+int fits_write_compressed_img(fitsfile *fptr,
+ int datatype, long *fpixel, long *lpixel,
+ int nullcheck, void *array, void *nulval,
+ int *status);
+int fits_write_compressed_pixels(fitsfile *fptr,
+ int datatype, LONGLONG fpixel, LONGLONG npixels,
+ int nullcheck, void *array, void *nulval,
+ int *status);
+int fits_write_compressed_img_plane(fitsfile *fptr, int datatype,
+ int bytesperpixel, long nplane, long *firstcoord, long *lastcoord,
+ long *naxes, int nullcheck,
+ void *array, void *nullval, long *nread, int *status);
+
+int imcomp_init_table(fitsfile *outfptr,
+ int bitpix, int naxis,long *naxes, int writebitpix, int *status);
+int imcomp_calc_max_elem (int comptype, int nx, int zbitpix, int blocksize);
+int imcomp_copy_imheader(fitsfile *infptr, fitsfile *outfptr,
+ int *status);
+int imcomp_copy_img2comp(fitsfile *infptr, fitsfile *outfptr, int *status);
+int imcomp_copy_comp2img(fitsfile *infptr, fitsfile *outfptr,
+ int norec, int *status);
+int imcomp_copy_prime2img(fitsfile *infptr, fitsfile *outfptr, int *status);
+int imcomp_compress_image (fitsfile *infptr, fitsfile *outfptr,
+ int *status);
+int imcomp_compress_tile (fitsfile *outfptr, long row,
+ int datatype, void *tiledata, long tilelen, long nx, long ny,
+ int nullcheck, void *nullval, int *status);
+int imcomp_nullscale(int *idata, long tilelen, int nullflagval, int nullval,
+ double scale, double zero, int * status);
+int imcomp_nullvalues(int *idata, long tilelen, int nullflagval, int nullval,
+ int * status);
+int imcomp_scalevalues(int *idata, long tilelen, double scale, double zero,
+ int * status);
+int imcomp_nullscalefloats(float *fdata, long tilelen, int *idata,
+ double scale, double zero, int nullcheck, float nullflagval, int nullval,
+ int *status);
+int imcomp_nullfloats(float *fdata, long tilelen, int *idata, int nullcheck,
+ float nullflagval, int nullval, int *status);
+int imcomp_nullscaledoubles(double *fdata, long tilelen, int *idata,
+ double scale, double zero, int nullcheck, double nullflagval, int nullval,
+ int *status);
+int imcomp_nulldoubles(double *fdata, long tilelen, int *idata, int nullcheck,
+ double nullflagval, int nullval, int *status);
+
+
+/* image decompression routines */
+int fits_read_compressed_img(fitsfile *fptr,
+ int datatype, LONGLONG *fpixel,LONGLONG *lpixel,long *inc,
+ int nullcheck, void *nulval, void *array, char *nullarray,
+ int *anynul, int *status);
+int fits_read_compressed_pixels(fitsfile *fptr,
+ int datatype, LONGLONG fpixel, LONGLONG npixels,
+ int nullcheck, void *nulval, void *array, char *nullarray,
+ int *anynul, int *status);
+int fits_read_compressed_img_plane(fitsfile *fptr, int datatype,
+ int bytesperpixel, long nplane, LONGLONG *firstcoord, LONGLONG *lastcoord,
+ long *inc, long *naxes, int nullcheck, void *nullval,
+ void *array, char *nullarray, int *anynul, long *nread, int *status);
+
+int imcomp_get_compressed_image_par(fitsfile *infptr, int *status);
+int imcomp_decompress_tile (fitsfile *infptr,
+ int nrow, int tilesize, int datatype, int nullcheck,
+ void *nulval, void *buffer, char *bnullarray, int *anynul,
+ int *status);
+int imcomp_copy_overlap (char *tile, int pixlen, int ndim,
+ long *tfpixel, long *tlpixel, char *bnullarray, char *image,
+ long *fpixel, long *lpixel, long *inc, int nullcheck, char *nullarray,
+ int *status);
+int imcomp_merge_overlap (char *tile, int pixlen, int ndim,
+ long *tfpixel, long *tlpixel, char *bnullarray, char *image,
+ long *fpixel, long *lpixel, int nullcheck, int *status);
+int imcomp_decompress_img(fitsfile *infptr, fitsfile *outfptr, int datatype,
+ int *status);
+int fits_quantize_float (long row, float fdata[], long nx, long ny, int nullcheck,
+ float in_null_value,
+ float quantize_level, int idata[], double *bscale, double *bzero,
+ int *iminval, int *imaxval);
+int fits_quantize_double (long row, double fdata[], long nx, long ny, int nullcheck,
+ double in_null_value,
+ float quantize_level, int idata[], double *bscale, double *bzero,
+ int *iminval, int *imaxval);
+int fits_rcomp(int a[], int nx, unsigned char *c, int clen,int nblock);
+int fits_rcomp_short(short a[], int nx, unsigned char *c, int clen,int nblock);
+int fits_rcomp_byte(signed char a[], int nx, unsigned char *c, int clen,int nblock);
+int fits_rdecomp (unsigned char *c, int clen, unsigned int array[], int nx,
+ int nblock);
+int fits_rdecomp_short (unsigned char *c, int clen, unsigned short array[], int nx,
+ int nblock);
+int fits_rdecomp_byte (unsigned char *c, int clen, unsigned char array[], int nx,
+ int nblock);
+int pl_p2li (int *pxsrc, int xs, short *lldst, int npix);
+int pl_l2pi (short *ll_src, int xs, int *px_dst, int npix);
+int fits_init_randoms(void);
+
+int fitsio_init_lock(void);
+
+/* general driver routines */
+
+int urltype2driver(char *urltype, int *driver);
+
+int fits_register_driver( char *prefix,
+ int (*init)(void),
+ int (*fitsshutdown)(void),
+ int (*setoptions)(int option),
+ int (*getoptions)(int *options),
+ int (*getversion)(int *version),
+ int (*checkfile) (char *urltype, char *infile, char *outfile),
+ int (*fitsopen)(char *filename, int rwmode, int *driverhandle),
+ int (*fitscreate)(char *filename, int *driverhandle),
+ int (*fitstruncate)(int driverhandle, LONGLONG filesize),
+ int (*fitsclose)(int driverhandle),
+ int (*fremove)(char *filename),
+ int (*size)(int driverhandle, LONGLONG *size),
+ int (*flush)(int driverhandle),
+ int (*seek)(int driverhandle, LONGLONG offset),
+ int (*fitsread) (int driverhandle, void *buffer, long nbytes),
+ int (*fitswrite)(int driverhandle, void *buffer, long nbytes));
+
+/* file driver I/O routines */
+
+int file_init(void);
+int file_setoptions(int options);
+int file_getoptions(int *options);
+int file_getversion(int *version);
+int file_shutdown(void);
+int file_checkfile(char *urltype, char *infile, char *outfile);
+int file_open(char *filename, int rwmode, int *driverhandle);
+int file_compress_open(char *filename, int rwmode, int *hdl);
+int file_openfile(char *filename, int rwmode, FILE **diskfile);
+int file_create(char *filename, int *driverhandle);
+int file_truncate(int driverhandle, LONGLONG filesize);
+int file_size(int driverhandle, LONGLONG *filesize);
+int file_close(int driverhandle);
+int file_remove(char *filename);
+int file_flush(int driverhandle);
+int file_seek(int driverhandle, LONGLONG offset);
+int file_read (int driverhandle, void *buffer, long nbytes);
+int file_write(int driverhandle, void *buffer, long nbytes);
+int file_is_compressed(char *filename);
+
+/* stream driver I/O routines */
+
+int stream_open(char *filename, int rwmode, int *driverhandle);
+int stream_create(char *filename, int *driverhandle);
+int stream_size(int driverhandle, LONGLONG *filesize);
+int stream_close(int driverhandle);
+int stream_flush(int driverhandle);
+int stream_seek(int driverhandle, LONGLONG offset);
+int stream_read (int driverhandle, void *buffer, long nbytes);
+int stream_write(int driverhandle, void *buffer, long nbytes);
+
+/* memory driver I/O routines */
+
+int mem_init(void);
+int mem_setoptions(int options);
+int mem_getoptions(int *options);
+int mem_getversion(int *version);
+int mem_shutdown(void);
+int mem_create(char *filename, int *handle);
+int mem_create_comp(char *filename, int *handle);
+int mem_openmem(void **buffptr, size_t *buffsize, size_t deltasize,
+ void *(*memrealloc)(void *p, size_t newsize), int *handle);
+int mem_createmem(size_t memsize, int *handle);
+int stdin_checkfile(char *urltype, char *infile, char *outfile);
+int stdin_open(char *filename, int rwmode, int *handle);
+int stdin2mem(int hd);
+int stdin2file(int hd);
+int stdout_close(int handle);
+int mem_compress_openrw(char *filename, int rwmode, int *hdl);
+int mem_compress_open(char *filename, int rwmode, int *hdl);
+int mem_compress_stdin_open(char *filename, int rwmode, int *hdl);
+int mem_iraf_open(char *filename, int rwmode, int *hdl);
+int mem_rawfile_open(char *filename, int rwmode, int *hdl);
+int mem_size(int handle, LONGLONG *filesize);
+int mem_truncate(int handle, LONGLONG filesize);
+int mem_close_free(int handle);
+int mem_close_keep(int handle);
+int mem_close_comp(int handle);
+int mem_seek(int handle, LONGLONG offset);
+int mem_read(int hdl, void *buffer, long nbytes);
+int mem_write(int hdl, void *buffer, long nbytes);
+int mem_uncompress2mem(char *filename, FILE *diskfile, int hdl);
+
+int iraf2mem(char *filename, char **buffptr, size_t *buffsize,
+ size_t *filesize, int *status);
+
+/* root driver I/O routines */
+
+int root_init(void);
+int root_setoptions(int options);
+int root_getoptions(int *options);
+int root_getversion(int *version);
+int root_shutdown(void);
+int root_open(char *filename, int rwmode, int *driverhandle);
+int root_create(char *filename, int *driverhandle);
+int root_close(int driverhandle);
+int root_flush(int driverhandle);
+int root_seek(int driverhandle, LONGLONG offset);
+int root_read (int driverhandle, void *buffer, long nbytes);
+int root_write(int driverhandle, void *buffer, long nbytes);
+int root_size(int handle, LONGLONG *filesize);
+
+/* http driver I/O routines */
+
+int http_checkfile(char *urltype, char *infile, char *outfile);
+int http_open(char *filename, int rwmode, int *driverhandle);
+int http_file_open(char *filename, int rwmode, int *driverhandle);
+int http_compress_open(char *filename, int rwmode, int *driverhandle);
+
+/* ftp driver I/O routines */
+
+int ftp_checkfile(char *urltype, char *infile, char *outfile);
+int ftp_open(char *filename, int rwmode, int *driverhandle);
+int ftp_file_open(char *filename, int rwmode, int *driverhandle);
+int ftp_compress_open(char *filename, int rwmode, int *driverhandle);
+
+int uncompress2mem(char *filename, FILE *diskfile,
+ char **buffptr, size_t *buffsize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ size_t *filesize, int *status);
+
+int uncompress2mem_from_mem(
+ char *inmemptr,
+ size_t inmemsize,
+ char **buffptr,
+ size_t *buffsize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ size_t *filesize,
+ int *status);
+
+int uncompress2file(char *filename,
+ FILE *indiskfile,
+ FILE *outdiskfile,
+ int *status);
+
+int compress2mem_from_mem(
+ char *inmemptr,
+ size_t inmemsize,
+ char **buffptr,
+ size_t *buffsize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ size_t *filesize,
+ int *status);
+
+int compress2file_from_mem(
+ char *inmemptr,
+ size_t inmemsize,
+ FILE *outdiskfile,
+ size_t *filesize, /* O - size of file, in bytes */
+ int *status);
+
+
+#ifdef HAVE_GSIFTP
+/* prototypes for gsiftp driver I/O routines */
+#include "drvrgsiftp.h"
+#endif
+
+#ifdef HAVE_SHMEM_SERVICES
+/* prototypes for shared memory driver I/O routines */
+#include "drvrsmem.h"
+#endif
+
+#if defined(vms) || defined(__vms) || defined(WIN32) || defined(__WIN32__) || (defined(macintosh) && !defined(TARGET_API_MAC_CARBON))
+/* A hack for nonunix machines, which lack strcasecmp and strncasecmp */
+int strcasecmp (const char *s1, const char *s2 );
+int strncasecmp(const char *s1, const char *s2, size_t n);
+#endif
+
+/* end of the entire "ifndef _FITSIO2_H" block */
+#endif
diff --git a/src/plugins/cfitsio/fpack.h b/src/plugins/cfitsio/fpack.h
new file mode 100644
index 0000000..8a350ba
--- /dev/null
+++ b/src/plugins/cfitsio/fpack.h
@@ -0,0 +1,164 @@
+/* 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 (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);
diff --git a/src/plugins/cfitsio/fpackutil.c b/src/plugins/cfitsio/fpackutil.c
new file mode 100644
index 0000000..8eb74d7
--- /dev/null
+++ b/src/plugins/cfitsio/fpackutil.c
@@ -0,0 +1,2381 @@
+/* FPACK utility routines
+ R. Seaman, NOAO & W. Pence, NASA/GSFC
+*/
+
+#include <time.h>
+#include <float.h>
+#include <signal.h>
+
+/* #include "bzlib.h" only for experimental purposes */
+
+#if defined(unix) || defined(__unix__) || defined(__unix)
+#include <sys/time.h>
+#endif
+
+#include <math.h>
+#include "fitsio.h"
+#include "fpack.h"
+
+/* these filename buffer are used to delete temporary files */
+/* in case the program is aborted */
+char tempfilename[SZ_STR];
+char tempfilename2[SZ_STR];
+char tempfilename3[SZ_STR];
+
+/* nearest integer function */
+# define NINT(x) ((x >= 0.) ? (int) (x + 0.5) : (int) (x - 0.5))
+# define NSHRT(x) ((x >= 0.) ? (short) (x + 0.5) : (short) (x - 0.5))
+
+/* define variables for measuring elapsed time */
+clock_t scpu, ecpu;
+long startsec; /* start of elapsed time interval */
+int startmilli; /* start of elapsed time interval */
+
+/* CLOCKS_PER_SEC should be defined by most compilers */
+#if defined(CLOCKS_PER_SEC)
+#define CLOCKTICKS CLOCKS_PER_SEC
+#else
+/* on SUN OS machine, CLOCKS_PER_SEC is not defined, so set its value */
+#define CLOCKTICKS 1000000
+#endif
+
+FILE *outreport;
+
+/* dimension of central image area to be sampled for test statistics */
+int XSAMPLE = 4100;
+int YSAMPLE = 4100;
+
+int fp_msg (char *msg)
+{
+ printf ("%s", msg);
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fp_noop (void)
+{
+ fp_msg ("Input and output files are unchanged.\n");
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+void fp_abort_output (fitsfile *infptr, fitsfile *outfptr, int stat)
+{
+ int status = 0, hdunum;
+ char msg[SZ_STR];
+
+ fits_file_name(infptr, tempfilename, &status);
+ fits_get_hdu_num(infptr, &hdunum);
+
+ fits_close_file (infptr, &status);
+
+ sprintf(msg, "Error processing file: %s\n", tempfilename);
+ fp_msg (msg);
+ sprintf(msg, " in HDU number %d\n", hdunum);
+ fp_msg (msg);
+
+ fits_report_error (stderr, stat);
+
+ if (outfptr) {
+ fits_delete_file(outfptr, &status);
+ fp_msg ("Input file is unchanged.\n");
+ }
+
+ exit (stat);
+}
+/*--------------------------------------------------------------------------*/
+int fp_version (void)
+{
+ float version;
+ char cfitsioversion[40];
+
+ fp_msg (FPACK_VERSION);
+ fits_get_version(&version);
+ sprintf(cfitsioversion, " CFITSIO version %5.3f", version);
+ fp_msg(cfitsioversion);
+ fp_msg ("\n");
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fp_access (char *filename)
+{
+ /* test if a file exists */
+
+ FILE *diskfile;
+
+ diskfile = fopen(filename, "r");
+
+ if (diskfile) {
+ fclose(diskfile);
+ return(0);
+ } else {
+ return(-1);
+ }
+}
+/*--------------------------------------------------------------------------*/
+int fp_tmpnam(char *suffix, char *rootname, char *tmpnam)
+{
+ /* create temporary file name */
+
+ int maxtry = 30, len, i1 = 0, ii;
+
+ if (strlen(suffix) + strlen(rootname) > SZ_STR-5) {
+ fp_msg ("Error: filename is too long to create tempory file\n"); exit (-1);
+ }
+
+ strcpy (tmpnam, rootname); /* start with rootname */
+ strcat(tmpnam, suffix); /* append the suffix */
+
+ maxtry = SZ_STR - strlen(tmpnam) - 1;
+
+ for (ii = 0; ii < maxtry; ii++) {
+ if (fp_access(tmpnam)) break; /* good, the file does not exist */
+ strcat(tmpnam, "x"); /* append an x to the name, and try again */
+ }
+
+ if (ii == maxtry) {
+ fp_msg ("\nCould not create temporary file name:\n");
+ fp_msg (tmpnam);
+ fp_msg ("\n");
+ exit (-1);
+ }
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fp_init (fpstate *fpptr)
+{
+ int ii;
+
+ fpptr->comptype = RICE_1;
+ fpptr->quantize_level = DEF_QLEVEL;
+ fpptr->no_dither = 0;
+ fpptr->dither_offset = 0;
+ fpptr->int_to_float = 0;
+
+ /* thresholds when using the -i2f flag */
+ fpptr->n3ratio = 1.20; /* minimum ratio of image noise sigma / q */
+ fpptr->n3min = 6.; /* minimum noise sigma. */
+
+ fpptr->scale = DEF_HCOMP_SCALE;
+ fpptr->smooth = DEF_HCOMP_SMOOTH;
+ fpptr->rescale_noise = DEF_RESCALE_NOISE;
+ fpptr->ntile[0] = (long) 0; /* 0 means extent of axis */
+
+ for (ii=1; ii < MAX_COMPRESS_DIM; ii++)
+ fpptr->ntile[ii] = (long) 1;
+
+ fpptr->to_stdout = 0;
+ fpptr->listonly = 0;
+ fpptr->clobber = 0;
+ fpptr->delete_input = 0;
+ fpptr->do_not_prompt = 0;
+ fpptr->do_checksums = 1;
+ fpptr->do_gzip_file = 0;
+ fpptr->do_tables = 0; /* this is for beta testing purposes only */
+ fpptr->do_fast = 0; /* this is for beta testing purposes only */
+ fpptr->test_all = 0;
+ fpptr->verbose = 0;
+
+ fpptr->prefix[0] = 0;
+ fpptr->extname[0] = 0;
+ fpptr->delete_suffix = 0;
+ fpptr->outfile[0] = 0;
+
+ fpptr->firstfile = 1;
+
+ /* magic number for initialization check, boolean for preflight
+ */
+ fpptr->initialized = FP_INIT_MAGIC;
+ fpptr->preflight_checked = 0;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fp_list (int argc, char *argv[], fpstate fpvar)
+{
+ fitsfile *infptr;
+ char infits[SZ_STR], msg[SZ_STR];
+ int hdunum, iarg, stat=0;
+ LONGLONG sizell;
+
+ if (fpvar.initialized != FP_INIT_MAGIC) {
+ fp_msg ("Error: internal initialization error\n"); exit (-1);
+ }
+
+ for (iarg=fpvar.firstfile; iarg < argc; iarg++) {
+ strncpy (infits, argv[iarg], SZ_STR);
+
+ if (strchr (infits, '[') || strchr (infits, ']')) {
+ fp_msg ("Error: section/extension notation not supported: ");
+ fp_msg (infits); fp_msg ("\n"); exit (-1);
+ }
+
+ if (fp_access (infits) != 0) {
+ fp_msg ("Error: can't find or read input file "); fp_msg (infits);
+ fp_msg ("\n"); fp_noop (); exit (-1);
+ }
+
+ fits_open_file (&infptr, infits, READONLY, &stat);
+ if (stat) { fits_report_error (stderr, stat); exit (stat); }
+
+ /* move to the end of file, to get the total size in bytes */
+ fits_get_num_hdus (infptr, &hdunum, &stat);
+ fits_movabs_hdu (infptr, hdunum, NULL, &stat);
+ fits_get_hduaddrll(infptr, NULL, NULL, &sizell, &stat);
+
+
+ if (stat) {
+ fp_abort_output(infptr, NULL, stat);
+ }
+
+ sprintf (msg, "# %s (", infits); fp_msg (msg);
+
+#if defined(_MSC_VER)
+ /* Microsoft Visual C++ 6.0 uses '%I64d' syntax for 8-byte integers */
+ sprintf(msg, "%I64d bytes)\n", sizell); fp_msg (msg);
+#elif (USE_LL_SUFFIX == 1)
+ sprintf(msg, "%lld bytes)\n", sizell); fp_msg (msg);
+#else
+ sprintf(msg, "%ld bytes)\n", sizell); fp_msg (msg);
+#endif
+ fp_info_hdu (infptr);
+
+ fits_close_file (infptr, &stat);
+ if (stat) { fits_report_error (stderr, stat); exit (stat); }
+ }
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fp_info_hdu (fitsfile *infptr)
+{
+ long naxes[9] = {1, 1, 1, 1, 1, 1, 1, 1, 1};
+ char msg[SZ_STR], val[SZ_CARD], com[SZ_CARD];
+ int comptype, naxis=0, hdutype, bitpix, hdupos, stat=0, ii;
+ unsigned long datasum, hdusum;
+
+ fits_movabs_hdu (infptr, 1, NULL, &stat);
+ if (stat) {
+ fp_abort_output(infptr, NULL, stat);
+ }
+
+ for (hdupos=1; ! stat; hdupos++) {
+ fits_get_hdu_type (infptr, &hdutype, &stat);
+ if (stat) {
+ fp_abort_output(infptr, NULL, stat);
+ }
+
+ /* fits_get_hdu_type calls unknown extensions "IMAGE_HDU"
+ * so consult XTENSION keyword itself
+ */
+ fits_read_keyword (infptr, "XTENSION", val, com, &stat);
+ if (stat == KEY_NO_EXIST) {
+ /* in primary HDU which by definition is an "image" */
+ stat=0; /* clear for later error handling */
+
+ } else if (stat) {
+ fp_abort_output(infptr, NULL, stat);
+
+ } else if (hdutype == IMAGE_HDU) {
+ /* that is, if XTENSION != "IMAGE" AND != "BINTABLE" */
+ if (strncmp (val+1, "IMAGE", 5) &&
+ strncmp (val+1, "BINTABLE", 5)) {
+
+ /* assign something other than any of these */
+ hdutype = IMAGE_HDU + ASCII_TBL + BINARY_TBL;
+ }
+ }
+
+ fits_get_chksum(infptr, &datasum, &hdusum, &stat);
+
+ if (hdutype == IMAGE_HDU) {
+ sprintf (msg, " %d IMAGE", hdupos); fp_msg (msg);
+ sprintf (msg, " SUMS=%lu/%lu", (unsigned long) (~((int) hdusum)), datasum); fp_msg (msg);
+
+ fits_get_img_param (infptr, 9, &bitpix, &naxis, naxes, &stat);
+
+ sprintf (msg, " BITPIX=%d", bitpix); fp_msg (msg);
+
+ if (naxis == 0) {
+ sprintf (msg, " [no_pixels]"); fp_msg (msg);
+ } else if (naxis == 1) {
+ sprintf (msg, " [%ld]", naxes[1]); fp_msg (msg);
+ } else {
+ sprintf (msg, " [%ld", naxes[0]); fp_msg (msg);
+ for (ii=1; ii < naxis; ii++) {
+ sprintf (msg, "x%ld", naxes[ii]); fp_msg (msg);
+ }
+ fp_msg ("]");
+ }
+
+ if (fits_is_compressed_image (infptr, &stat)) {
+ fits_read_keyword (infptr, "ZCMPTYPE", val, com, &stat);
+
+ /* allow for quote in keyword value */
+ if (! strncmp (val+1, "RICE_1", 6))
+ fp_msg (" tiled_rice\n");
+ else if (! strncmp (val+1, "GZIP_1", 6))
+ fp_msg (" tiled_gzip_1\n");
+ else if (! strncmp (val+1, "GZIP_2", 6))
+ fp_msg (" tiled_gzip_2\n");
+ else if (! strncmp (val+1, "PLIO_1", 6))
+ fp_msg (" tiled_plio\n");
+ else if (! strncmp (val+1, "HCOMPRESS_1", 11))
+ fp_msg (" tiled_hcompress\n");
+ else
+ fp_msg (" unknown\n");
+
+ } else
+ fp_msg (" not_tiled\n");
+
+ } else if (hdutype == ASCII_TBL) {
+ sprintf (msg, " %d ASCII_TBL", hdupos); fp_msg (msg);
+ sprintf (msg, " SUMS=%lu/%lu\n", (unsigned long) (~((int) hdusum)), datasum); fp_msg (msg);
+
+ } else if (hdutype == BINARY_TBL) {
+ sprintf (msg, " %d BINARY_TBL", hdupos); fp_msg (msg);
+ sprintf (msg, " SUMS=%lu/%lu\n", (unsigned long) (~((int) hdusum)), datasum); fp_msg (msg);
+
+ } else {
+ sprintf (msg, " %d OTHER", hdupos); fp_msg (msg);
+ sprintf (msg, " SUMS=%lu/%lu", (unsigned long) (~((int) hdusum), datasum)); fp_msg (msg);
+ sprintf (msg, " %s\n", val); fp_msg (msg);
+ }
+
+ fits_movrel_hdu (infptr, 1, NULL, &stat);
+ }
+ return(0);
+}
+
+/*--------------------------------------------------------------------------*/
+int fp_preflight (int argc, char *argv[], int unpack, fpstate *fpptr)
+{
+ char infits[SZ_STR], outfits[SZ_STR], temp[SZ_STR], *cptr;
+ int iarg, suflen, namelen, nfiles = 0;
+
+ if (fpptr->initialized != FP_INIT_MAGIC) {
+ fp_msg ("Error: internal initialization error\n"); exit (-1);
+ }
+
+ for (iarg=fpptr->firstfile; iarg < argc; iarg++) {
+
+ outfits[0] = '\0';
+
+ if (strlen(argv[iarg]) > SZ_STR - 4) { /* allow for .fz or .gz suffix */
+ fp_msg ("Error: input file name\n "); fp_msg (argv[iarg]);
+ fp_msg ("\n is too long\n"); fp_noop (); exit (-1);
+ }
+
+ strncpy (infits, argv[iarg], SZ_STR);
+
+ if (strchr (infits, '[') || strchr (infits, ']')) {
+ fp_msg ("Error: section/extension notation not supported: ");
+ fp_msg (infits); fp_msg ("\n"); fp_noop (); exit (-1);
+ }
+
+ if (unpack) {
+ /* ********** This section applies to funpack ************ */
+
+ /* check that input file exists */
+ if (infits[0] != '-') { /* if not reading from stdin stream */
+ if (fp_access (infits) != 0) { /* if not, then check if */
+ strcat(infits, ".fz"); /* a .fz version exsits */
+ if (fp_access (infits) != 0) {
+ namelen = strlen(infits);
+ infits[namelen - 3] = '\0'; /* remove the .fz suffix */
+ fp_msg ("Error: can't find or read input file "); fp_msg (infits);
+ fp_msg ("\n"); fp_noop (); exit (-1);
+ }
+ } else { /* make sure a .fz version of the same file doesn't exist */
+ namelen = strlen(infits);
+ strcat(infits, ".fz");
+ if (fp_access (infits) == 0) {
+ infits[namelen] = '\0'; /* remove the .fz suffix */
+ fp_msg ("Error: ambiguous input file name. Which file should be unpacked?:\n ");
+ fp_msg (infits); fp_msg ("\n ");
+ fp_msg (infits); fp_msg (".fz\n");
+ fp_noop (); exit (-1);
+ } else {
+ infits[namelen] = '\0'; /* remove the .fz suffix */
+ }
+ }
+ }
+
+ /* if writing to stdout, then we are all done */
+ if (fpptr->to_stdout) {
+ continue;
+ }
+
+ if (fpptr->outfile[0]) { /* user specified output file name */
+ nfiles++;
+ if (nfiles > 1) {
+ fp_msg ("Error: cannot use same output file name for multiple files:\n ");
+ fp_msg (fpptr->outfile);
+ fp_msg ("\n"); fp_noop (); exit (-1);
+ }
+
+ /* check that output file doesn't exist */
+ if (fp_access (fpptr->outfile) == 0) {
+ fp_msg ("Error: output file already exists:\n ");
+ fp_msg (fpptr->outfile);
+ fp_msg ("\n "); fp_noop (); exit (-1);
+ }
+ continue;
+ }
+
+ /* construct output file name to test */
+ if (fpptr->prefix[0]) {
+ if (strlen(fpptr->prefix) + strlen(infits) > SZ_STR - 1) {
+ fp_msg ("Error: output file name for\n "); fp_msg (infits);
+ fp_msg ("\n is too long with the prefix\n"); fp_noop (); exit (-1);
+ }
+ strcat(outfits,fpptr->prefix);
+ }
+
+ /* construct output file name */
+ if (infits[0] == '-') {
+ strcpy(outfits, "output.fits");
+ } else {
+ strcpy(outfits, infits);
+ }
+
+ /* remove .gz suffix, if present (output is not gzipped) */
+ namelen = strlen(outfits);
+ if ( !strcmp(".gz", outfits + namelen - 3) ) {
+ outfits[namelen - 3] = '\0';
+ }
+
+ /* check for .fz suffix that is sometimes required */
+ /* and remove it if present */
+ if (infits[0] != '-') { /* if not reading from stdin stream */
+ namelen = strlen(outfits);
+ if ( !strcmp(".fz", outfits + namelen - 3) ) { /* suffix is present */
+ outfits[namelen - 3] = '\0';
+ } else if (fpptr->delete_suffix) { /* required suffix is missing */
+ fp_msg ("Error: input compressed file "); fp_msg (infits);
+ fp_msg ("\n does not have the default .fz suffix.\n");
+ fp_noop (); exit (-1);
+ }
+ }
+
+ /* if infits != outfits, make sure outfits doesn't already exist */
+ if (strcmp(infits, outfits)) {
+ if (fp_access (outfits) == 0) {
+ fp_msg ("Error: output file already exists:\n "); fp_msg (outfits);
+ fp_msg ("\n "); fp_noop (); exit (-1);
+ }
+ }
+
+ /* if gzipping the output, make sure .gz file doesn't exist */
+ if (fpptr->do_gzip_file) {
+ strcat(outfits, ".gz");
+ if (fp_access (outfits) == 0) {
+ fp_msg ("Error: output file already exists:\n "); fp_msg (outfits);
+ fp_msg ("\n "); fp_noop (); exit (-1);
+ }
+ namelen = strlen(outfits);
+ outfits[namelen - 3] = '\0'; /* remove the .gz suffix again */
+ }
+ } else {
+ /* ********** This section applies to fpack ************ */
+
+ /* check that input file exists */
+ if (infits[0] != '-') { /* if not reading from stdin stream */
+ if (fp_access (infits) != 0) { /* if not, then check if */
+ strcat(infits, ".gz"); /* a gzipped version exsits */
+ if (fp_access (infits) != 0) {
+ namelen = strlen(infits);
+ infits[namelen - 3] = '\0'; /* remove the .gz suffix */
+ fp_msg ("Error: can't find or read input file "); fp_msg (infits);
+ fp_msg ("\n"); fp_noop (); exit (-1);
+ }
+ }
+ }
+
+ /* make sure the file to pack does not already have a .fz suffix */
+ namelen = strlen(infits);
+ if ( !strcmp(".fz", infits + namelen - 3) ) {
+ fp_msg ("Error: fpack input file already has '.fz' suffix\n" ); fp_msg (infits);
+ fp_msg ("\n"); fp_noop (); exit (-1);
+ }
+
+ /* if writing to stdout, or just testing the files, then we are all done */
+ if (fpptr->to_stdout || fpptr->test_all) {
+ continue;
+ }
+
+ /* construct output file name */
+ if (infits[0] == '-') {
+ strcpy(outfits, "input.fits");
+ } else {
+ strcpy(outfits, infits);
+ }
+
+ /* remove .gz suffix, if present (output is not gzipped) */
+ namelen = strlen(outfits);
+ if ( !strcmp(".gz", outfits + namelen - 3) ) {
+ outfits[namelen - 3] = '\0';
+ }
+
+ /* remove .imh suffix (IRAF format image), and replace with .fits */
+ namelen = strlen(outfits);
+ if ( !strcmp(".imh", outfits + namelen - 4) ) {
+ outfits[namelen - 4] = '\0';
+ strcat(outfits, ".fits");
+ }
+
+ /* If not clobbering the input file, add .fz suffix to output name */
+ if (! fpptr->clobber)
+ strcat(outfits, ".fz");
+
+ /* if infits != outfits, make sure outfits doesn't already exist */
+ if (strcmp(infits, outfits)) {
+ if (fp_access (outfits) == 0) {
+ fp_msg ("Error: output file already exists:\n "); fp_msg (outfits);
+ fp_msg ("\n "); fp_noop (); exit (-1);
+ }
+ }
+ } /* end of fpack section */
+ }
+
+ fpptr->preflight_checked++;
+ return(0);
+}
+
+/*--------------------------------------------------------------------------*/
+/* must run fp_preflight() before fp_loop()
+ */
+int fp_loop (int argc, char *argv[], int unpack, fpstate fpvar)
+{
+ char infits[SZ_STR], outfits[SZ_STR];
+ char temp[SZ_STR], answer[30], *cptr;
+ int ii, iarg, islossless, namelen, iraf_infile = 0, status = 0, ifail;
+ FILE *diskfile;
+
+ if (fpvar.initialized != FP_INIT_MAGIC) {
+ fp_msg ("Error: internal initialization error\n"); exit (-1);
+ } else if (! fpvar.preflight_checked) {
+ fp_msg ("Error: internal preflight error\n"); exit (-1);
+ }
+
+ if (fpvar.test_all && fpvar.outfile[0]) {
+ outreport = fopen(fpvar.outfile, "w");
+ fprintf(outreport," Filename Extension BITPIX NAXIS1 NAXIS2 Size N_nulls Minval Maxval Mean Sigm Noise1 Noise2 Noise3 Noise5 T_whole T_rowbyrow ");
+ fprintf(outreport,"[Comp_ratio, Pack_cpu, Unpack_cpu, Lossless readtimes] (repeated for Rice, Hcompress, and GZIP)\n");
+ }
+
+
+ tempfilename[0] = '\0';
+ tempfilename2[0] = '\0';
+ tempfilename3[0] = '\0';
+
+/* set up signal handler to delete temporary file on abort */
+#ifdef SIGINT
+ if (signal(SIGINT, SIG_IGN) != SIG_IGN) {
+ (void) signal(SIGINT, abort_fpack);
+ }
+#endif
+
+#ifdef SIGTERM
+ if (signal(SIGTERM, SIG_IGN) != SIG_IGN) {
+ (void) signal(SIGTERM, abort_fpack);
+ }
+#endif
+
+#ifdef SIGHUP
+ if (signal(SIGHUP, SIG_IGN) != SIG_IGN) {
+ (void) signal(SIGHUP, abort_fpack);
+ }
+#endif
+
+ for (iarg=fpvar.firstfile; iarg < argc; iarg++) {
+
+ temp[0] = '\0';
+ outfits[0] = '\0';
+ islossless = 1;
+
+ strncpy (infits, argv[iarg], SZ_STR - 1);
+
+ if (unpack) {
+ /* ********** This section applies to funpack ************ */
+
+ /* find input file */
+ if (infits[0] != '-') { /* if not reading from stdin stream */
+ if (fp_access (infits) != 0) { /* if not, then */
+ strcat(infits, ".fz"); /* a .fz version must exsit */
+ }
+ }
+
+ if (fpvar.to_stdout) {
+ strcpy(outfits, "-");
+
+ } else if (fpvar.outfile[0]) { /* user specified output file name */
+ strcpy(outfits, fpvar.outfile);
+
+ } else {
+ /* construct output file name */
+ if (fpvar.prefix[0]) {
+ strcat(outfits,fpvar.prefix);
+ }
+
+ /* construct output file name */
+ if (infits[0] == '-') {
+ strcpy(outfits, "output.fits");
+ } else {
+ strcpy(outfits, infits);
+ }
+
+ /* remove .gz suffix, if present (output is not gzipped) */
+ namelen = strlen(outfits);
+ if ( !strcmp(".gz", outfits + namelen - 3) ) {
+ outfits[namelen - 3] = '\0';
+ }
+
+ /* check for .fz suffix that is sometimes required */
+ /* and remove it if present */
+ namelen = strlen(outfits);
+ if ( !strcmp(".fz", outfits + namelen - 3) ) { /* suffix is present */
+ outfits[namelen - 3] = '\0';
+ }
+ }
+
+ } else {
+ /* ********** This section applies to fpack ************ */
+
+ if (fpvar.to_stdout) {
+ strcpy(outfits, "-");
+ } else if (! fpvar.test_all) {
+
+ /* construct output file name */
+ if (infits[0] == '-') {
+ strcpy(outfits, "input.fits");
+ } else {
+ strcpy(outfits, infits);
+ }
+
+ /* remove .gz suffix, if present (output is not gzipped) */
+ namelen = strlen(outfits);
+ if ( !strcmp(".gz", outfits + namelen - 3) ) {
+ outfits[namelen - 3] = '\0';
+ }
+
+ /* remove .imh suffix (IRAF format image), and replace with .fits */
+ namelen = strlen(outfits);
+ if ( !strcmp(".imh", outfits + namelen - 4) ) {
+ outfits[namelen - 4] = '\0';
+ strcat(outfits, ".fits");
+ iraf_infile = 1; /* this is an IRAF format input file */
+ /* change the output name to "NAME.fits.fz" */
+ }
+
+ /* If not clobbering the input file, add .fz suffix to output name */
+ if (! fpvar.clobber)
+ strcat(outfits, ".fz");
+ }
+ }
+
+ strncpy(temp, outfits, SZ_STR-1);
+
+ if (infits[0] != '-') { /* if not reading from stdin stream */
+ if (!strcmp(infits, outfits) ) { /* are input and output names the same? */
+
+ /* clobber the input file with the output file with the same name */
+ if (! fpvar.clobber) {
+ fp_msg ("\nError: must use -F flag to clobber input file.\n");
+ exit (-1);
+ }
+
+ /* create temporary file name in the output directory (same as input directory)*/
+ fp_tmpnam("Tmp1", infits, outfits);
+
+ strcpy(tempfilename, outfits); /* store temp file name, in case of abort */
+ }
+ }
+
+
+ /* *************** now do the real work ********************* */
+
+ if (fpvar.verbose && ! fpvar.to_stdout)
+ printf("%s ", infits);
+
+ if (fpvar.test_all) { /* compare all the algorithms */
+
+ /* create 2 temporary file names, in the CWD */
+ fp_tmpnam("Tmpfile1", "", tempfilename);
+ fp_tmpnam("Tmpfile2", "", tempfilename2);
+
+ fp_test (infits, tempfilename, tempfilename2, fpvar);
+
+ remove(tempfilename);
+ tempfilename[0] = '\0'; /* clear the temp file name */
+ remove(tempfilename2);
+ tempfilename2[0] = '\0';
+ continue;
+
+ } else if (unpack) {
+ if (fpvar.to_stdout) {
+ /* unpack the input file to the stdout stream */
+ fp_unpack (infits, outfits, fpvar);
+ } else {
+ /* unpack to temporary file, so other tasks can't open it until it is renamed */
+
+ /* create temporary file name, in the output directory */
+ fp_tmpnam("Tmp2", outfits, tempfilename2);
+
+ /* unpack the input file to the temporary file */
+ fp_unpack (infits, tempfilename2, fpvar);
+
+ /* rename the temporary file to it's real name */
+ ifail = rename(tempfilename2, outfits);
+ if (ifail) {
+ fp_msg("Failed to rename temporary file name:\n ");
+ fp_msg(tempfilename2);
+ fp_msg(" -> ");
+ fp_msg(outfits);
+ fp_msg("\n");
+ exit (-1);
+ } else {
+ tempfilename2[0] = '\0'; /* clear temporary file name */
+ }
+ }
+ } else {
+ fp_pack (infits, outfits, fpvar, &islossless);
+ }
+
+ if (fpvar.to_stdout) {
+ continue;
+ }
+
+ /* ********** clobber and/or delete files, if needed ************** */
+
+ if (!strcmp(infits, temp) && fpvar.clobber ) {
+
+ if (!islossless && ! fpvar.do_not_prompt) {
+ fp_msg ("\nFile ");
+ fp_msg (infits);
+ fp_msg ("\nwas compressed with a LOSSY method. Overwrite the\n");
+ fp_msg ("original file with the compressed version? (Y/N) ");
+ fgets(answer, 29, stdin);
+ if (answer[0] != 'Y' && answer[0] != 'y') {
+ fp_msg ("\noriginal file NOT overwritten!\n");
+ remove(outfits);
+ continue;
+ }
+ }
+
+ /* rename clobbers input, may be unix/shell version dependent */
+
+ if (iraf_infile) { /* special case of deleting an IRAF format header and pixel file */
+ if (fits_delete_iraf_file(infits, &status)) {
+ fp_msg("\nError deleting IRAF .imh and .pix files.\n");
+ fp_msg(infits); fp_msg ("\n"); exit (-1);
+ }
+ }
+
+ if (rename (outfits, temp) != 0) {
+ fp_msg ("\nError renaming tmp file to ");
+ fp_msg (temp); fp_msg ("\n"); exit (-1);
+ }
+ tempfilename[0] = '\0'; /* clear temporary file name */
+ strcpy(outfits, temp);
+
+ } else if (fpvar.clobber || fpvar.delete_input) { /* delete the input file */
+ if (!islossless && !fpvar.do_not_prompt) { /* user did not turn off delete prompt */
+ fp_msg ("\nFile ");
+ fp_msg (infits);
+ fp_msg ("\nwas compressed with a LOSSY method. \n");
+ fp_msg ("Delete the original file? (Y/N) ");
+ fgets(answer, 29, stdin);
+ if (answer[0] != 'Y' && answer[0] != 'y') { /* user abort */
+ fp_msg ("\noriginal file NOT deleted!\n");
+ } else {
+ if (iraf_infile) { /* special case of deleting an IRAF format header and pixel file */
+ if (fits_delete_iraf_file(infits, &status)) {
+ fp_msg("\nError deleting IRAF .imh and .pix files.\n");
+ fp_msg(infits); fp_msg ("\n"); exit (-1);
+ }
+ } else if (remove(infits) != 0) { /* normal case of deleting input FITS file */
+ fp_msg ("\nError deleting input file ");
+ fp_msg (infits); fp_msg ("\n"); exit (-1);
+ }
+ }
+ } else { /* user said don't prompt, so just delete the input file */
+ if (iraf_infile) { /* special case of deleting an IRAF format header and pixel file */
+ if (fits_delete_iraf_file(infits, &status)) {
+ fp_msg("\nError deleting IRAF .imh and .pix files.\n");
+ fp_msg(infits); fp_msg ("\n"); exit (-1);
+ }
+ } else if (remove(infits) != 0) { /* normal case of deleting input FITS file */
+ fp_msg ("\nError deleting input file ");
+ fp_msg (infits); fp_msg ("\n"); exit (-1);
+ }
+ }
+ }
+ iraf_infile = 0;
+
+ if (fpvar.do_gzip_file) { /* gzip the output file */
+ strcpy(temp, "gzip -1 ");
+ strcat(temp,outfits);
+ system(temp);
+ strcat(outfits, ".gz"); /* only possibible with funpack */
+ }
+
+ if (fpvar.verbose && ! fpvar.to_stdout)
+ printf("-> %s\n", outfits);
+
+ }
+
+ if (fpvar.test_all && fpvar.outfile[0])
+ fclose(outreport);
+ return(0);
+}
+
+/*--------------------------------------------------------------------------*/
+/* fp_pack assumes the output file does not exist (checked by preflight)
+ */
+int fp_pack (char *infits, char *outfits, fpstate fpvar, int *islossless)
+{
+ fitsfile *infptr, *outfptr;
+ int stat=0;
+
+ fits_open_file (&infptr, infits, READONLY, &stat);
+ if (stat) { fits_report_error (stderr, stat); exit (stat); }
+
+ fits_create_file (&outfptr, outfits, &stat);
+ if (stat) {
+ fp_abort_output(infptr, NULL, stat);
+ }
+
+ fits_set_compression_type (outfptr, fpvar.comptype, &stat);
+ fits_set_lossy_int (outfptr, fpvar.int_to_float, &stat);
+
+ if (fpvar.no_dither)
+ fits_set_quantize_dither(outfptr, -1, &stat);
+
+ fits_set_quantize_level (outfptr, fpvar.quantize_level, &stat);
+ fits_set_hcomp_scale (outfptr, fpvar.scale, &stat);
+ fits_set_hcomp_smooth (outfptr, fpvar.smooth, &stat);
+ fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
+ fits_set_dither_offset(outfptr, fpvar.dither_offset, &stat);
+
+ if (stat) {
+ fp_abort_output(infptr, outfptr, stat);
+ }
+
+
+ while (! stat) {
+
+ /* the lossy_int value may have changed, so reset it for each HDU */
+ fits_set_lossy_int (outfptr, fpvar.int_to_float, &stat);
+
+ fp_pack_hdu (infptr, outfptr, fpvar, islossless, &stat);
+
+ if (fpvar.do_checksums) {
+ fits_write_chksum (outfptr, &stat);
+ }
+
+ fits_movrel_hdu (infptr, 1, NULL, &stat);
+ }
+
+ if (stat == END_OF_FILE) stat = 0;
+
+ /* set checksum for case of newly created primary HDU
+ */
+ if (fpvar.do_checksums) {
+ fits_movabs_hdu (outfptr, 1, NULL, &stat);
+ fits_write_chksum (outfptr, &stat);
+ }
+
+ if (stat) {
+ fp_abort_output(infptr, outfptr, stat);
+ }
+
+ fits_close_file (outfptr, &stat);
+ fits_close_file (infptr, &stat);
+
+ return(0);
+}
+
+/*--------------------------------------------------------------------------*/
+/* fp_unpack assumes the output file does not exist
+ */
+int fp_unpack (char *infits, char *outfits, fpstate fpvar)
+{
+ fitsfile *infptr, *outfptr;
+ int stat=0, hdutype, extnum, single = 0;
+ char *loc, *hduloc, hduname[SZ_STR];
+
+ fits_open_file (&infptr, infits, READONLY, &stat);
+ fits_create_file (&outfptr, outfits, &stat);
+
+ if (fpvar.extname[0]) { /* unpack a list of HDUs? */
+
+ /* move to the first HDU in the list */
+ hduloc = fpvar.extname;
+ loc = strchr(hduloc, ','); /* look for 'comma' delimiter between names */
+
+ if (loc)
+ *loc = '\0'; /* terminate the first name in the string */
+
+ strcpy(hduname, hduloc); /* copy the first name into temporary string */
+
+ if (loc)
+ hduloc = loc + 1; /* advance to the beginning of the next name, if any */
+ else {
+ hduloc += strlen(hduname); /* end of the list */
+ single = 1; /* only 1 HDU is being unpacked */
+ }
+
+ if (isdigit( (int) hduname[0]) ) {
+ extnum = strtol(hduname, &loc, 10); /* read the string as an integer */
+
+ /* check for junk following the integer */
+ if (*loc == '\0' ) /* no junk, so move to this HDU number (+1) */
+ {
+ fits_movabs_hdu(infptr, extnum + 1, &hdutype, &stat); /* move to HDU number */
+ if (hdutype != IMAGE_HDU)
+ stat = NOT_IMAGE;
+
+ } else { /* the string is not an integer, so must be the column name */
+ hdutype = IMAGE_HDU;
+ fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
+ }
+ }
+ else
+ {
+ /* move to the named image extension */
+ hdutype = IMAGE_HDU;
+ fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
+ }
+ }
+
+ if (stat) {
+ fp_msg ("Unable to find and move to extension '");
+ fp_msg(hduname);
+ fp_msg("'\n");
+ fp_abort_output(infptr, outfptr, stat);
+ }
+
+ while (! stat) {
+
+ if (single)
+ stat = -1; /* special status flag to force output primary array */
+
+ fp_unpack_hdu (infptr, outfptr, fpvar, &stat);
+
+ if (fpvar.do_checksums) {
+ fits_write_chksum (outfptr, &stat);
+ }
+
+ /* move to the next HDU */
+ if (fpvar.extname[0]) { /* unpack a list of HDUs? */
+
+ if (!(*hduloc)) {
+ stat = END_OF_FILE; /* we reached the end of the list */
+ } else {
+ /* parse the next HDU name and move to it */
+ loc = strchr(hduloc, ',');
+
+ if (loc) /* look for 'comma' delimiter between names */
+ *loc = '\0'; /* terminate the first name in the string */
+
+ strcpy(hduname, hduloc); /* copy the next name into temporary string */
+
+ if (loc)
+ hduloc = loc + 1; /* advance to the beginning of the next name, if any */
+ else
+ *hduloc = '\0'; /* end of the list */
+
+ if (isdigit( (int) hduname[0]) ) {
+ extnum = strtol(hduname, &loc, 10); /* read the string as an integer */
+
+ /* check for junk following the integer */
+ if (*loc == '\0' ) /* no junk, so move to this HDU number (+1) */
+ {
+ fits_movabs_hdu(infptr, extnum + 1, &hdutype, &stat); /* move to HDU number */
+ if (hdutype != IMAGE_HDU)
+ stat = NOT_IMAGE;
+
+ } else { /* the string is not an integer, so must be the column name */
+ hdutype = IMAGE_HDU;
+ fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
+ }
+
+ } else {
+ /* move to the named image extension */
+ hdutype = IMAGE_HDU;
+ fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
+ }
+
+ if (stat) {
+ fp_msg ("Unable to find and move to extension '");
+ fp_msg(hduname);
+ fp_msg("'\n");
+ }
+ }
+ } else {
+ /* increment to the next HDU */
+ fits_movrel_hdu (infptr, 1, NULL, &stat);
+ }
+ }
+
+ if (stat == END_OF_FILE) stat = 0;
+
+ /* set checksum for case of newly created primary HDU
+ */
+ if (fpvar.do_checksums) {
+ fits_movabs_hdu (outfptr, 1, NULL, &stat);
+ fits_write_chksum (outfptr, &stat);
+ }
+
+
+ if (stat) {
+ fp_abort_output(infptr, outfptr, stat);
+ }
+
+ fits_close_file (outfptr, &stat);
+ fits_close_file (infptr, &stat);
+
+ return(0);
+}
+
+/*--------------------------------------------------------------------------*/
+/* fp_test assumes the output files do not exist
+ */
+int fp_test (char *infits, char *outfits, char *outfits2, fpstate fpvar)
+{
+ fitsfile *inputfptr, *infptr, *outfptr, *outfptr2, *tempfile;
+
+ long naxes[9] = {1, 1, 1, 1, 1, 1, 1, 1, 1};
+ long tilesize[9] = {0,1,1,1,1,1,1,1,1};
+ int stat=0, totpix=0, naxis=0, ii, hdutype, bitpix, extnum = 0, len;
+ int tstatus = 0, hdunum, rescale_flag, bpix;
+ char dtype[8], dimen[100];
+ double bscale, rescale, noisemin;
+ long headstart, datastart, dataend;
+ float origdata = 0., whole_cpu, whole_elapse, row_elapse, row_cpu, xbits;
+ FILE *diskfile;
+ /* structure to hold image statistics (defined in fpack.h) */
+ imgstats imagestats;
+
+ fits_open_file (&inputfptr, infits, READONLY, &stat);
+ fits_create_file (&outfptr, outfits, &stat);
+ fits_create_file (&outfptr2, outfits2, &stat);
+
+ if (stat) { fits_report_error (stderr, stat); exit (stat); }
+
+ if (fpvar.no_dither)
+ fits_set_quantize_dither(outfptr, -1, &stat);
+
+ fits_set_quantize_level (outfptr, fpvar.quantize_level, &stat);
+ fits_set_hcomp_scale (outfptr, fpvar.scale, &stat);
+ fits_set_hcomp_smooth (outfptr, fpvar.smooth, &stat);
+ fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
+ fits_set_dither_offset(outfptr, fpvar.dither_offset, &stat);
+
+ while (! stat) {
+
+ rescale_flag = 0;
+
+ /* LOOP OVER EACH HDU */
+ fits_get_hdu_type (inputfptr, &hdutype, &stat);
+
+ if (hdutype == IMAGE_HDU) {
+ fits_get_img_param (inputfptr, 9, &bitpix, &naxis, naxes, &stat);
+ for (totpix=1, ii=0; ii < 9; ii++) totpix *= naxes[ii];
+ }
+
+ if ( !fits_is_compressed_image (inputfptr, &stat) &&
+ hdutype == IMAGE_HDU && naxis != 0 && totpix != 0) {
+
+ /* rescale a scaled integer image to reduce noise? */
+ if (fpvar.rescale_noise != 0. && bitpix > 0 && bitpix < LONGLONG_IMG) {
+
+ tstatus = 0;
+ fits_read_key(inputfptr, TDOUBLE, "BSCALE", &bscale, 0, &tstatus);
+
+ if (tstatus == 0 && bscale != 1.0) { /* image must be scaled */
+
+ if (bitpix == LONG_IMG)
+ fp_i4stat(inputfptr, naxis, naxes, &imagestats, &stat);
+ else
+ fp_i2stat(inputfptr, naxis, naxes, &imagestats, &stat);
+
+ /* use the minimum of the MAD 2nd, 3rd, and 5th order noise estimates */
+ noisemin = imagestats.noise3;
+ if (imagestats.noise2 != 0. && imagestats.noise2 < noisemin) noisemin = imagestats.noise2;
+ if (imagestats.noise5 != 0. && imagestats.noise5 < noisemin) noisemin = imagestats.noise5;
+
+ rescale = noisemin / fpvar.rescale_noise;
+ if (rescale > 1.0) {
+
+ /* all the criteria are met, so create a temporary file that */
+ /* contains a rescaled version of the image, in CWD */
+
+ /* create temporary file name */
+ fp_tmpnam("Tmpfile3", "", tempfilename3);
+
+ fits_create_file(&tempfile, tempfilename3, &stat);
+
+ fits_get_hdu_num(inputfptr, &hdunum);
+ if (hdunum != 1) {
+
+ /* the input hdu is an image extension, so create dummy primary */
+ fits_create_img(tempfile, 8, 0, naxes, &stat);
+ }
+
+ fits_copy_header(inputfptr, tempfile, &stat); /* copy the header */
+
+ /* rescale the data, so that it will compress more efficiently */
+ if (bitpix == LONG_IMG)
+ fp_i4rescale(inputfptr, naxis, naxes, rescale, tempfile, &stat);
+ else
+ fp_i2rescale(inputfptr, naxis, naxes, rescale, tempfile, &stat);
+
+ /* scale the BSCALE keyword by the inverse factor */
+
+ bscale = bscale * rescale;
+ fits_update_key(tempfile, TDOUBLE, "BSCALE", &bscale, 0, &stat);
+
+ /* rescan the header, to reset the actual scaling parameters */
+ fits_set_hdustruc(tempfile, &stat);
+
+ infptr = tempfile;
+ rescale_flag = 1;
+ }
+ }
+ }
+
+ if (!rescale_flag) /* just compress the input file, without rescaling */
+ infptr = inputfptr;
+
+ /* compute basic statistics about the input image */
+ if (bitpix == BYTE_IMG) {
+ bpix = 8;
+ strcpy(dtype, "8 ");
+ fp_i2stat(infptr, naxis, naxes, &imagestats, &stat);
+ } else if (bitpix == SHORT_IMG) {
+ bpix = 16;
+ strcpy(dtype, "16 ");
+ fp_i2stat(infptr, naxis, naxes, &imagestats, &stat);
+ } else if (bitpix == LONG_IMG) {
+ bpix = 32;
+ strcpy(dtype, "32 ");
+ fp_i4stat(infptr, naxis, naxes, &imagestats, &stat);
+ } else if (bitpix == LONGLONG_IMG) {
+ bpix = 64;
+ strcpy(dtype, "64 ");
+ } else if (bitpix == FLOAT_IMG) {
+ bpix = 32;
+ strcpy(dtype, "-32");
+ fp_r4stat(infptr, naxis, naxes, &imagestats, &stat);
+ } else if (bitpix == DOUBLE_IMG) {
+ bpix = 64;
+ strcpy(dtype, "-64");
+ fp_r4stat(infptr, naxis, naxes, &imagestats, &stat);
+ }
+
+ /* use the minimum of the MAD 2nd, 3rd, and 5th order noise estimates */
+ noisemin = imagestats.noise3;
+ if (imagestats.noise2 != 0. && imagestats.noise2 < noisemin) noisemin = imagestats.noise2;
+ if (imagestats.noise5 != 0. && imagestats.noise5 < noisemin) noisemin = imagestats.noise5;
+
+ xbits = log10(noisemin)/.301 + 1.792;
+
+ printf("\n File: %s\n", infits);
+ printf(" Ext BITPIX Dimens. Nulls Min Max Mean Sigma Noise2 Noise3 Noise5 Nbits MaxR\n");
+
+ printf(" %3d %s", extnum, dtype);
+ sprintf(dimen," (%ld", naxes[0]);
+ len =strlen(dimen);
+ for (ii = 1; ii < naxis; ii++) {
+ sprintf(dimen+len,",%ld", naxes[ii]);
+ len =strlen(dimen);
+ }
+ strcat(dimen, ")");
+ printf("%-12s",dimen);
+
+ fits_get_hduaddr(inputfptr, &headstart, &datastart, &dataend, &stat);
+ origdata = (dataend - datastart)/1000000.;
+
+ /* get elapsed and cpu times need to read the uncompressed image */
+ fits_read_image_speed (infptr, &whole_elapse, &whole_cpu,
+ &row_elapse, &row_cpu, &stat);
+
+ printf(" %5d %6.0f %6.0f %8.1f %#8.2g %#7.3g %#7.3g %#7.3g %#5.1f %#6.2f\n",
+ imagestats.n_nulls, imagestats.minval, imagestats.maxval,
+ imagestats.mean, imagestats.sigma,
+ imagestats.noise2, imagestats.noise3, imagestats.noise5, xbits, bpix/xbits);
+
+ printf("\n Type Ratio Size (MB) Pk (Sec) UnPk Exact ElpN CPUN Elp1 CPU1\n");
+
+ printf(" Native %5.3f %5.3f %5.3f %5.3f\n",
+ whole_elapse, whole_cpu, row_elapse, row_cpu);
+
+ if (fpvar.outfile[0]) {
+ fprintf(outreport,
+ " %s %d %d %ld %ld %#10.4g %d %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g",
+ infits, extnum, bitpix, naxes[0], naxes[1], origdata, imagestats.n_nulls, imagestats.minval,
+ imagestats.maxval, imagestats.mean, imagestats.sigma,
+ imagestats.noise1, imagestats.noise2, imagestats.noise3, imagestats.noise5, whole_elapse, whole_cpu, row_elapse, row_cpu);
+ }
+
+ fits_set_lossy_int (outfptr, fpvar.int_to_float, &stat);
+ if ( (bitpix > 0) && (fpvar.int_to_float != 0) ) {
+
+ if ( (noisemin < (fpvar.n3ratio * fpvar.quantize_level) ) ||
+ (noisemin < fpvar.n3min)) {
+
+ /* image contains too little noise to quantize effectively */
+ fits_set_lossy_int (outfptr, 0, &stat);
+ fits_get_hdu_num(infptr, &hdunum);
+
+printf(" HDU %d does not meet noise criteria to be quantized, so losslessly compressed.\n", hdunum);
+ }
+ }
+
+ /* test compression ratio and speed for each algorithm */
+
+ if (fpvar.quantize_level != 0) {
+ fits_set_compression_type (outfptr, RICE_1, &stat);
+ fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
+ fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
+ }
+
+ if (fpvar.quantize_level != 0) {
+ fits_set_compression_type (outfptr, HCOMPRESS_1, &stat);
+ fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
+ fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
+ }
+
+ if (fpvar.comptype == GZIP_2) {
+ fits_set_compression_type (outfptr, GZIP_2, &stat);
+ } else {
+ fits_set_compression_type (outfptr, GZIP_1, &stat);
+ }
+ fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
+ fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
+
+/*
+ fits_set_compression_type (outfptr, BZIP2_1, &stat);
+ fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
+ fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
+*/
+/*
+ fits_set_compression_type (outfptr, PLIO_1, &stat);
+ fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
+ fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
+*/
+/*
+ if (bitpix == SHORT_IMG || bitpix == LONG_IMG) {
+ fits_set_compression_type (outfptr, NOCOMPRESS, &stat);
+ fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
+ fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
+ }
+*/
+ if (fpvar.outfile[0])
+ fprintf(outreport,"\n");
+
+ /* delete the temporary file */
+ if (rescale_flag) {
+ fits_delete_file (infptr, &stat);
+ tempfilename3[0] = '\0'; /* clear the temp filename */
+ }
+ } else if ( (hdutype == BINARY_TBL) && fpvar.do_tables) {
+
+ printf("\n File: %s\n", infits);
+ fp_test_table(inputfptr, outfptr, outfptr2, fpvar, &stat);
+
+ } else {
+ fits_copy_hdu (inputfptr, outfptr, 0, &stat);
+ fits_copy_hdu (inputfptr, outfptr2, 0, &stat);
+ }
+
+ fits_movrel_hdu (inputfptr, 1, NULL, &stat);
+ extnum++;
+ }
+
+
+ if (stat == END_OF_FILE) stat = 0;
+
+ fits_close_file (outfptr2, &stat);
+ fits_close_file (outfptr, &stat);
+ fits_close_file (inputfptr, &stat);
+
+ if (stat) {
+ fits_report_error (stderr, stat);
+ }
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fp_pack_hdu (fitsfile *infptr, fitsfile *outfptr, fpstate fpvar,
+ int *islossless, int *status)
+{
+ fitsfile *tempfile;
+ long naxes[9] = {1, 1, 1, 1, 1, 1, 1, 1, 1};
+ int stat=0, totpix=0, naxis=0, ii, hdutype, bitpix;
+ int tstatus, hdunum, rescale_flag = 0;
+ double bscale, rescale;
+ FILE *diskfile;
+ char outfits[SZ_STR];
+ long headstart, datastart, dataend, datasize;
+ double noisemin;
+ /* structure to hold image statistics (defined in fpack.h) */
+ imgstats imagestats;
+
+ if (*status) return(0);
+
+ fits_get_hdu_type (infptr, &hdutype, &stat);
+
+ if (hdutype == IMAGE_HDU) {
+ fits_get_img_param (infptr, 9, &bitpix, &naxis, naxes, &stat);
+ for (totpix=1, ii=0; ii < 9; ii++) totpix *= naxes[ii];
+ }
+
+ /* =============================================================== */
+ /* This block is only for beta testing of binary table compression */
+ if (hdutype == BINARY_TBL && fpvar.do_tables) {
+
+ fits_get_hduaddr(infptr, &headstart, &datastart, &dataend, status);
+ datasize = dataend - datastart;
+
+ if (datasize <= 2880) {
+ /* data is less than 1 FITS block in size, so don't compress */
+ fits_copy_hdu (infptr, outfptr, 0, &stat);
+ } else {
+
+ /* transpose the table and compress each column */
+ if (fpvar.do_fast) {
+ fits_compress_table_fast (infptr, outfptr, &stat);
+ } else {
+ fits_compress_table_best (infptr, outfptr, &stat);
+ }
+ }
+
+ return(0);
+ }
+ /* =============================================================== */
+
+ /* If this is not a non-null image HDU, just copy it verbatim */
+ if (fits_is_compressed_image (infptr, &stat) ||
+ hdutype != IMAGE_HDU || naxis == 0 || totpix == 0) {
+ fits_copy_hdu (infptr, outfptr, 0, &stat);
+
+ } else { /* remaining code deals only with IMAGE HDUs */
+
+ /* special case: rescale a scaled integer image to reduce noise? */
+ if (fpvar.rescale_noise != 0. && bitpix > 0 && bitpix < LONGLONG_IMG) {
+
+ tstatus = 0;
+ fits_read_key(infptr, TDOUBLE, "BSCALE", &bscale, 0, &tstatus);
+ if (tstatus == 0 && bscale != 1.0) { /* image must be scaled */
+
+ if (bitpix == LONG_IMG)
+ fp_i4stat(infptr, naxis, naxes, &imagestats, &stat);
+ else
+ fp_i2stat(infptr, naxis, naxes, &imagestats, &stat);
+
+ /* use the minimum of the MAD 2nd, 3rd, and 5th order noise estimates */
+ noisemin = imagestats.noise3;
+ if (imagestats.noise2 != 0. && imagestats.noise2 < noisemin) noisemin = imagestats.noise2;
+ if (imagestats.noise5 != 0. && imagestats.noise5 < noisemin) noisemin = imagestats.noise5;
+
+ rescale = noisemin / fpvar.rescale_noise;
+ if (rescale > 1.0) {
+
+ /* all the criteria are met, so create a temporary file that */
+ /* contains a rescaled version of the image, in output directory */
+
+ /* create temporary file name */
+ fits_file_name(outfptr, outfits, &stat); /* get the output file name */
+ fp_tmpnam("Tmp3", outfits, tempfilename3);
+
+ fits_create_file(&tempfile, tempfilename3, &stat);
+
+ fits_get_hdu_num(infptr, &hdunum);
+ if (hdunum != 1) {
+
+ /* the input hdu is an image extension, so create dummy primary */
+ fits_create_img(tempfile, 8, 0, naxes, &stat);
+ }
+
+ fits_copy_header(infptr, tempfile, &stat); /* copy the header */
+
+ /* rescale the data, so that it will compress more efficiently */
+ if (bitpix == LONG_IMG)
+ fp_i4rescale(infptr, naxis, naxes, rescale, tempfile, &stat);
+ else
+ fp_i2rescale(infptr, naxis, naxes, rescale, tempfile, &stat);
+
+
+ /* scale the BSCALE keyword by the inverse factor */
+
+ bscale = bscale * rescale;
+ fits_update_key(tempfile, TDOUBLE, "BSCALE", &bscale, 0, &stat);
+
+ /* rescan the header, to reset the actual scaling parameters */
+ fits_set_hdustruc(tempfile, &stat);
+
+ fits_img_compress (tempfile, outfptr, &stat);
+ fits_delete_file (tempfile, &stat);
+ tempfilename3[0] = '\0'; /* clear the temp filename */
+ *islossless = 0; /* used a lossy compression method */
+
+ *status = stat;
+ return(0);
+ }
+ }
+ }
+
+ /* if requested to do lossy compression of integer images (by */
+ /* converting to float), then check if this HDU qualifies */
+ if ( (bitpix > 0) && (fpvar.int_to_float != 0) ) {
+
+ if (bitpix >= LONG_IMG)
+ fp_i4stat(infptr, naxis, naxes, &imagestats, &stat);
+ else
+ fp_i2stat(infptr, naxis, naxes, &imagestats, &stat);
+
+ /* use the minimum of the MAD 2nd, 3rd, and 5th order noise estimates */
+ noisemin = imagestats.noise3;
+ if (imagestats.noise2 != 0. && imagestats.noise2 < noisemin) noisemin = imagestats.noise2;
+ if (imagestats.noise5 != 0. && imagestats.noise5 < noisemin) noisemin = imagestats.noise5;
+
+ if ( (noisemin < (fpvar.n3ratio * fpvar.quantize_level) ) ||
+ (imagestats.noise3 < fpvar.n3min)) {
+
+ /* image contains too little noise to quantize effectively */
+ fits_set_lossy_int (outfptr, 0, &stat);
+
+ fits_get_hdu_num(infptr, &hdunum);
+
+printf(" HDU %d does not meet noise criteria to be quantized, so losslessly compressed.\n", hdunum);
+
+ } else {
+ /* compressed image is not identical to original */
+ *islossless = 0;
+ }
+ }
+
+ /* finally, do the actual image compression */
+ fits_img_compress (infptr, outfptr, &stat);
+
+ if (bitpix < 0 ||
+ (fpvar.comptype == HCOMPRESS_1 && fpvar.scale != 0.)) {
+
+ /* compressed image is not identical to original */
+ *islossless = 0;
+ }
+ }
+
+ *status = stat;
+ return(0);
+}
+
+/*--------------------------------------------------------------------------*/
+int fp_unpack_hdu (fitsfile *infptr, fitsfile *outfptr, fpstate fpvar, int *status)
+{
+ int hdutype, lval;
+
+ if (*status > 0) return(0);
+
+ fits_get_hdu_type (infptr, &hdutype, status);
+
+ /* =============================================================== */
+ /* This block is only for beta testing of binary table compression */
+ if (hdutype == BINARY_TBL) {
+
+ fits_read_key(infptr, TLOGICAL, "ZTABLE", &lval, NULL, status);
+
+ if (*status == 0 && lval != 0) {
+ /* uncompress the table */
+ fits_uncompress_table (infptr, outfptr, status);
+
+ } else {
+ if (*status == KEY_NO_EXIST) /* table is not compressed */
+ *status = 0;
+ fits_copy_hdu (infptr, outfptr, 0, status);
+ }
+
+ return(0);
+ /* =============================================================== */
+
+ } else if (fits_is_compressed_image (infptr, status)) {
+ /* uncompress the compressed image HDU */
+ fits_img_decompress (infptr, outfptr, status);
+ } else {
+ /* not a compressed image HDU, so just copy it to the output */
+ fits_copy_hdu (infptr, outfptr, 0, status);
+ }
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fits_read_image_speed (fitsfile *infptr, float *whole_elapse,
+ float *whole_cpu, float *row_elapse, float *row_cpu, int *status)
+{
+ unsigned char *carray, cnull = 0;
+ short *sarray, snull=0;
+ int bitpix, naxis, anynull, *iarray, inull = 0;
+ long ii, naxes[9], fpixel[9]={1,1,1,1,1,1,1,1,1}, lpixel[9]={1,1,1,1,1,1,1,1,1};
+ long inc[9]={1,1,1,1,1,1,1,1,1} ;
+ float *earray, enull = 0, filesize;
+ double *darray, dnull = 0;
+ LONGLONG fpixelll[9];
+
+ if (*status) return(*status);
+
+ fits_get_img_param (infptr, 9, &bitpix, &naxis, naxes, status);
+
+ if (naxis != 2)return(*status);
+
+ lpixel[0] = naxes[0];
+ lpixel[1] = naxes[1];
+
+ /* filesize in MB */
+ filesize = naxes[0] * abs(bitpix) / 8000000. * naxes[1];
+
+ /* measure time required to read the raw image */
+ fits_set_bscale(infptr, 1.0, 0.0, status);
+ *whole_elapse = 0.;
+ *whole_cpu = 0;
+
+ if (bitpix == BYTE_IMG) {
+ carray = calloc(naxes[1]*naxes[0], sizeof(char));
+
+ /* remove any cached uncompressed tile
+ (dangerous to directly modify the structure!) */
+ (infptr->Fptr)->tilerow = 0;
+
+ marktime(status);
+ fits_read_subset(infptr, TBYTE, fpixel, lpixel, inc, &cnull,
+ carray, &anynull, status);
+
+ /* get elapsped times */
+ gettime(whole_elapse, whole_cpu, status);
+
+ /* now read the image again, row by row */
+ if (row_elapse) {
+
+ /* remove any cached uncompressed tile
+ (dangerous to directly modify the structure!) */
+ (infptr->Fptr)->tilerow = 0;
+
+ marktime(status);
+ for (ii = 0; ii < naxes[1]; ii++) {
+ fpixel[1] = ii+1;
+ fits_read_pix(infptr, TBYTE, fpixel, naxes[0], &cnull,
+ carray, &anynull, status);
+ }
+ /* get elapsped times */
+ gettime(row_elapse, row_cpu, status);
+ }
+ free(carray);
+
+ } else if (bitpix == SHORT_IMG) {
+ sarray = calloc(naxes[0]*naxes[1], sizeof(short));
+
+ marktime(status);
+
+ fits_read_subset(infptr, TSHORT, fpixel, lpixel, inc, &snull,
+ sarray, &anynull, status);
+
+ gettime(whole_elapse, whole_cpu, status); /* get elapsped times */
+
+ /* now read the image again, row by row */
+ if (row_elapse) {
+ marktime(status);
+ for (ii = 0; ii < naxes[1]; ii++) {
+ fpixel[1] = ii+1;
+ fits_read_pix(infptr, TSHORT, fpixel, naxes[0], &snull,
+ sarray, &anynull, status);
+ }
+ /* get elapsped times */
+ gettime(row_elapse, row_cpu, status);
+ }
+
+ free(sarray);
+
+ } else if (bitpix == LONG_IMG) {
+ iarray = calloc(naxes[0]*naxes[1], sizeof(int));
+
+ marktime(status);
+
+ fits_read_subset(infptr, TINT, fpixel, lpixel, inc, &inull,
+ iarray, &anynull, status);
+
+ /* get elapsped times */
+ gettime(whole_elapse, whole_cpu, status);
+
+
+ /* now read the image again, row by row */
+ if (row_elapse) {
+ marktime(status);
+ for (ii = 0; ii < naxes[1]; ii++) {
+ fpixel[1] = ii+1;
+ fits_read_pix(infptr, TINT, fpixel, naxes[0], &inull,
+ iarray, &anynull, status);
+ }
+ /* get elapsped times */
+ gettime(row_elapse, row_cpu, status);
+ }
+
+
+ free(iarray);
+
+ } else if (bitpix == FLOAT_IMG) {
+ earray = calloc(naxes[1]*naxes[0], sizeof(float));
+
+ marktime(status);
+
+ fits_read_subset(infptr, TFLOAT, fpixel, lpixel, inc, &enull,
+ earray, &anynull, status);
+
+ /* get elapsped times */
+ gettime(whole_elapse, whole_cpu, status);
+
+ /* now read the image again, row by row */
+ if (row_elapse) {
+ marktime(status);
+ for (ii = 0; ii < naxes[1]; ii++) {
+ fpixel[1] = ii+1;
+ fits_read_pix(infptr, TFLOAT, fpixel, naxes[0], &enull,
+ earray, &anynull, status);
+ }
+ /* get elapsped times */
+ gettime(row_elapse, row_cpu, status);
+ }
+
+ free(earray);
+
+ } else if (bitpix == DOUBLE_IMG) {
+ darray = calloc(naxes[1]*naxes[0], sizeof(double));
+
+ marktime(status);
+
+ fits_read_subset(infptr, TDOUBLE, fpixel, lpixel, inc, &dnull,
+ darray, &anynull, status);
+
+ /* get elapsped times */
+ gettime(whole_elapse, whole_cpu, status);
+
+ /* now read the image again, row by row */
+ if (row_elapse) {
+ marktime(status);
+ for (ii = 0; ii < naxes[1]; ii++) {
+ fpixel[1] = ii+1;
+ fits_read_pix(infptr, TDOUBLE, fpixel, naxes[0], &dnull,
+ darray, &anynull, status);
+ }
+ /* get elapsped times */
+ gettime(row_elapse, row_cpu, status);
+ }
+
+ free(darray);
+ }
+
+ if (whole_elapse) *whole_elapse = *whole_elapse / filesize;
+ if (row_elapse) *row_elapse = *row_elapse / filesize;
+ if (whole_cpu) *whole_cpu = *whole_cpu / filesize;
+ if (row_cpu) *row_cpu = *row_cpu / filesize;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fp_test_hdu (fitsfile *infptr, fitsfile *outfptr, fitsfile *outfptr2,
+ fpstate fpvar, int *status)
+{
+ /* This routine is only used for performance testing of image HDUs. */
+ /* Use fp_test_table for testing binary table HDUs. */
+
+ int stat = 0, hdutype, comptype, noloss = 0;
+ char ctype[20], lossless[4];
+ long headstart, datastart, dataend;
+ float origdata = 0., compressdata = 0.;
+ float compratio = 0., packcpu = 0., unpackcpu = 0., readcpu;
+ float elapse, whole_elapse, row_elapse, whole_cpu, row_cpu;
+ unsigned long datasum1, datasum2, hdusum;
+
+ if (*status) return(0);
+
+ origdata = 0;
+ compressdata = 0;
+ compratio = 0.;
+ lossless[0] = '\0';
+
+ fits_get_compression_type(outfptr, &comptype, &stat);
+ if (comptype == RICE_1)
+ strcpy(ctype, "RICE");
+ else if (comptype == GZIP_1)
+ strcpy(ctype, "GZIP1");
+ else if (comptype == GZIP_2)
+ strcpy(ctype, "GZIP2");/*
+ else if (comptype == BZIP2_1)
+ strcpy(ctype, "BZIP2");
+*/
+ else if (comptype == PLIO_1)
+ strcpy(ctype, "PLIO");
+ else if (comptype == HCOMPRESS_1)
+ strcpy(ctype, "HCOMP");
+ else if (comptype == NOCOMPRESS)
+ strcpy(ctype, "NONE");
+ else {
+ fp_msg ("Error: unsupported image compression type ");
+ *status = DATA_COMPRESSION_ERR;
+ return(0);
+ }
+
+ /* -------------- COMPRESS the image ------------------ */
+
+ marktime(&stat);
+
+ fits_img_compress (infptr, outfptr, &stat);
+
+ /* get elapsped times */
+ gettime(&elapse, &packcpu, &stat);
+
+ /* get elapsed and cpu times need to read the compressed image */
+
+ /* if whole image is compressed as single tile, don't read row by row
+ because it usually takes a very long time
+ */
+ if (fpvar.ntile[1] == 0) {
+ fits_read_image_speed (outfptr, &whole_elapse, &whole_cpu,
+ 0, 0, &stat);
+ row_elapse = 0; row_cpu = 0;
+ } else {
+
+ fits_read_image_speed (outfptr, &whole_elapse, &whole_cpu,
+ &row_elapse, &row_cpu, &stat);
+ }
+
+ if (!stat) {
+
+ /* -------------- UNCOMPRESS the image ------------------ */
+
+ /* remove any cached uncompressed tile
+ (dangerous to directly modify the structure!) */
+ (outfptr->Fptr)->tilerow = 0;
+ marktime(&stat);
+
+ fits_img_decompress (outfptr, outfptr2, &stat);
+
+ /* get elapsped times */
+ gettime(&elapse, &unpackcpu, &stat);
+
+ /* ----------------------------------------------------- */
+
+ /* get sizes of original and compressed images */
+
+ fits_get_hduaddr(infptr, &headstart, &datastart, &dataend, &stat);
+ origdata = (dataend - datastart)/1000000.;
+
+ fits_get_hduaddr(outfptr, &headstart, &datastart, &dataend, &stat);
+ compressdata = (dataend - datastart)/1000000.;
+
+ if (compressdata != 0)
+ compratio = (float) origdata / (float) compressdata;
+
+ /* is this uncompressed image identical to the original? */
+
+ fits_get_chksum(infptr, &datasum1, &hdusum, &stat);
+ fits_get_chksum(outfptr2, &datasum2, &hdusum, &stat);
+
+ if ( datasum1 == datasum2) {
+ strcpy(lossless, "Yes");
+ noloss = 1;
+ } else {
+ strcpy(lossless, "No");
+ }
+
+ printf(" %-5s %6.2f %7.2f ->%7.2f %7.2f %7.2f %s %5.3f %5.3f %5.3f %5.3f\n",
+ ctype, compratio, origdata, compressdata,
+ packcpu, unpackcpu, lossless, whole_elapse, whole_cpu,
+ row_elapse, row_cpu);
+
+
+ if (fpvar.outfile[0]) {
+ fprintf(outreport," %6.3f %5.2f %5.2f %s %7.3f %7.3f %7.3f %7.3f",
+ compratio, packcpu, unpackcpu, lossless, whole_elapse, whole_cpu,
+ row_elapse, row_cpu);
+ }
+
+ /* delete the output HDUs to concerve disk space */
+
+ fits_delete_hdu(outfptr, &hdutype, &stat);
+ fits_delete_hdu(outfptr2, &hdutype, &stat);
+
+ } else {
+ printf(" %-5s (unable to compress image)\n", ctype);
+ }
+
+ /* try to recover from any compression errors */
+ if (stat == DATA_COMPRESSION_ERR) stat = 0;
+
+ *status = stat;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fp_test_table (fitsfile *infptr, fitsfile *outfptr, fitsfile *outfptr2,
+ fpstate fpvar, int *status)
+{
+/* this routine is for performance testing of the beta table compression methods */
+
+ int stat = 0, hdutype, comptype, noloss = 0, ii;
+ unsigned int idatasize;
+ char ctype[20], lossless[4];
+ LONGLONG headstart, datastart, dataend, datasize;
+ float origdata = 0., compressdata = 0.;
+ float compratio = 0., packcpu = 0., unpackcpu = 0., readcpu;
+ float elapse, whole_elapse, row_elapse, whole_cpu, row_cpu;
+ float gratio, tratio, sratio, pratio, bratio;
+ float grate, trate, srate, prate, brate, filesize;
+ float rratio, rrate;
+ size_t headsize, hlen, dlen;
+ LONGLONG indatasize, outdatasize;
+ char *ptr, *cptr, *iptr, *cbuff;
+
+ if (*status) return(0);
+
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ datasize = dataend - datastart;
+
+ /* can't compress small tables with less than 2880 bytes of data */
+ if (datasize <= 2880) {
+ return(0);
+ }
+
+ /* 1 gzip raw table ********************************** */
+ marktime(&stat);
+
+ /* get compressed size of the data blocks */
+ fits_gzip_datablocks(infptr, &dlen, &stat);
+
+ /* get elapsped times */
+ gettime(&elapse, &packcpu, &stat);
+
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ indatasize = dataend - datastart;
+
+ outdatasize = dlen;
+
+ gratio = (float) indatasize / (float) outdatasize;
+ grate = packcpu;
+
+ fits_delete_hdu(outfptr, &hdutype, &stat);
+
+ /* 2 transposed table and compress each column with gzip *********** */
+
+ marktime(&stat);
+ fits_transpose_table (infptr, outfptr, &stat);
+
+ /* get elapsped times */
+ gettime(&elapse, &packcpu, &stat);
+
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ indatasize = dataend - datastart;
+ filesize = (float) dataend / 1000000.;
+
+ fits_get_hduaddrll(outfptr, &headstart, &datastart, &dataend, status);
+ outdatasize = dataend - datastart;
+
+ sratio = (float) indatasize / (float) outdatasize;
+ srate = packcpu;
+
+ fits_delete_hdu(outfptr, &hdutype, &stat);
+
+ /* 3 transpose table, shuffle numeric columns, and compress each column with gzip */
+
+ marktime(&stat);
+ fits_compress_table_fast (infptr, outfptr, &stat);
+
+ /* get elapsped times */
+ gettime(&elapse, &packcpu, &stat);
+
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ indatasize = dataend - datastart;
+ filesize = (float) dataend / 1000000.;
+
+ fits_get_hduaddrll(outfptr, &headstart, &datastart, &dataend, status);
+ outdatasize = dataend - datastart;
+
+ pratio = (float) indatasize / (float) outdatasize;
+ prate = packcpu;
+
+ fits_delete_hdu(outfptr, &hdutype, &stat);
+
+ /* 4 transposed, use Rice for integer columns, shuffled gzip for others */
+
+ marktime(&stat);
+ fits_compress_table_rice (infptr, outfptr, &stat);
+
+ /* get elapsped times */
+ gettime(&elapse, &packcpu, &stat);
+
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ indatasize = dataend - datastart;
+ filesize = (float) dataend / 1000000.;
+
+ fits_get_hduaddrll(outfptr, &headstart, &datastart, &dataend, status);
+ outdatasize = dataend - datastart;
+
+ rratio = (float) indatasize / (float) outdatasize;
+ rrate = packcpu;
+
+ fits_delete_hdu(outfptr, &hdutype, &stat);
+
+
+ /* 5 best */
+
+ marktime(&stat);
+ fits_compress_table_best (infptr, outfptr, &stat);
+
+ /* get elapsped times */
+ gettime(&elapse, &packcpu, &stat);
+
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ indatasize = dataend - datastart;
+ filesize = (float) dataend / 1000000.;
+
+ fits_get_hduaddrll(outfptr, &headstart, &datastart, &dataend, status);
+ outdatasize = dataend - datastart;
+
+ bratio = (float) indatasize / (float) outdatasize;
+ brate = packcpu;
+
+ fits_delete_hdu(outfptr, &hdutype, &stat);
+
+ printf("\n Size Raw Transposed Shuffled Rice Best\n");
+ printf(" %5.2fMB %5.2f (%4.2fs) %5.2f (%4.2fs) %5.2f (%4.2fs) %5.2f (%4.2fs) %5.2f (%4.2fs)\n",
+ filesize, gratio, grate, sratio, srate, pratio, prate, rratio, rrate, bratio, brate);
+ printf(" Disk savings ratio: %5.2f %5.2f %5.2f\n",
+ (1. - 1./sratio) / (1. - 1./gratio), (1. - 1./pratio) / (1. - 1./gratio), (1. - 1./bratio) / (1. - 1./gratio));
+
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int marktime(int *status)
+{
+#if defined(unix) || defined(__unix__) || defined(__unix)
+ struct timeval tv;
+/* struct timezone tz; */
+
+/* gettimeofday (&tv, &tz); */
+ gettimeofday (&tv, NULL);
+
+ startsec = tv.tv_sec;
+ startmilli = tv.tv_usec/1000;
+
+ scpu = clock();
+#else
+/* don't support high timing precision on Windows machines */
+ startsec = 0.;
+ startmilli = 0.;
+
+ scpu = clock();
+#endif
+ return( *status );
+}
+/*--------------------------------------------------------------------------*/
+int gettime(float *elapse, float *elapscpu, int *status)
+{
+#if defined(unix) || defined(__unix__) || defined(__unix)
+ struct timeval tv;
+/* struct timezone tz; */
+ int stopmilli;
+ long stopsec;
+
+/* gettimeofday (&tv, &tz); */
+ gettimeofday (&tv, NULL);
+ ecpu = clock();
+
+ stopmilli = tv.tv_usec/1000;
+ stopsec = tv.tv_sec;
+
+ *elapse = (stopsec - startsec) + (stopmilli - startmilli)/1000.;
+ *elapscpu = (ecpu - scpu) * 1.0 / CLOCKTICKS;
+/*
+printf(" (start: %ld + %d), stop: (%ld + %d) elapse: %f\n ",
+startsec,startmilli,stopsec, stopmilli, *elapse);
+*/
+#else
+/* set the elapsed time the same as the CPU time on Windows machines */
+ *elapscpu = (ecpu - scpu) * 1.0 / CLOCKTICKS;
+ *elapse = *elapscpu;
+#endif
+ return( *status );
+}
+/*--------------------------------------------------------------------------*/
+int fp_i2stat(fitsfile *infptr, int naxis, long *naxes, imgstats *imagestats, int *status)
+{
+/*
+ read the central XSAMPLE by YSAMPLE region of pixels in the int*2 image,
+ and then compute basic statistics: min, max, mean, sigma, mean diff, etc.
+*/
+
+ long fpixel[9] = {1,1,1,1,1,1,1,1,1};
+ long lpixel[9] = {1,1,1,1,1,1,1,1,1};
+ long inc[9] = {1,1,1,1,1,1,1,1,1};
+ long i1, i2, npix, ii, ngood, nx, ny;
+ short *intarray, minvalue, maxvalue, nullvalue;
+ int anynul, tstatus, checknull = 1;
+ double mean, sigma, noise1, noise2, noise3, noise5;
+
+ /* select the middle XSAMPLE by YSAMPLE area of the image */
+ i1 = naxes[0]/2 - (XSAMPLE/2 - 1);
+ i2 = naxes[0]/2 + (XSAMPLE/2);
+ if (i1 < 1) i1 = 1;
+ if (i2 > naxes[0]) i2 = naxes[0];
+ fpixel[0] = i1;
+ lpixel[0] = i2;
+ nx = i2 - i1 +1;
+
+ if (naxis > 1) {
+ i1 = naxes[1]/2 - (YSAMPLE/2 - 1);
+ i2 = naxes[1]/2 + (YSAMPLE/2);
+ if (i1 < 1) i1 = 1;
+ if (i2 > naxes[1]) i2 = naxes[1];
+ fpixel[1] = i1;
+ lpixel[1] = i2;
+ }
+ ny = i2 - i1 +1;
+
+ npix = nx * ny;
+
+ /* if there are higher dimensions, read the middle plane of the cube */
+ if (naxis > 2) {
+ fpixel[2] = naxes[2]/2 + 1;
+ lpixel[2] = naxes[2]/2 + 1;
+ }
+
+ intarray = calloc(npix, sizeof(short));
+ if (!intarray) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* turn off any scaling of the integer pixel values */
+ fits_set_bscale(infptr, 1.0, 0.0, status);
+
+ fits_read_subset_sht(infptr, 0, naxis, naxes, fpixel, lpixel, inc,
+ 0, intarray, &anynul, status);
+
+ /* read the null value keyword (BLANK) if present */
+ tstatus = 0;
+ fits_read_key(infptr, TSHORT, "BLANK", &nullvalue, 0, &tstatus);
+ if (tstatus) {
+ nullvalue = 0;
+ checknull = 0;
+ }
+
+ /* compute statistics of the image */
+
+ fits_img_stats_short(intarray, nx, ny, checknull, nullvalue,
+ &ngood, &minvalue, &maxvalue, &mean, &sigma, &noise1, &noise2, &noise3, &noise5, status);
+
+ imagestats->n_nulls = npix - ngood;
+ imagestats->minval = minvalue;
+ imagestats->maxval = maxvalue;
+ imagestats->mean = mean;
+ imagestats->sigma = sigma;
+ imagestats->noise1 = noise1;
+ imagestats->noise2 = noise2;
+ imagestats->noise3 = noise3;
+ imagestats->noise5 = noise5;
+
+ free(intarray);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fp_i4stat(fitsfile *infptr, int naxis, long *naxes, imgstats *imagestats, int *status)
+{
+/*
+ read the central XSAMPLE by YSAMPLE region of pixels in the int*2 image,
+ and then compute basic statistics: min, max, mean, sigma, mean diff, etc.
+*/
+
+ long fpixel[9] = {1,1,1,1,1,1,1,1,1};
+ long lpixel[9] = {1,1,1,1,1,1,1,1,1};
+ long inc[9] = {1,1,1,1,1,1,1,1,1};
+ long i1, i2, npix, ii, ngood, nx, ny;
+ int *intarray, minvalue, maxvalue, nullvalue;
+ int anynul, tstatus, checknull = 1;
+ double mean, sigma, noise1, noise2, noise3, noise5;
+
+ /* select the middle XSAMPLE by YSAMPLE area of the image */
+ i1 = naxes[0]/2 - (XSAMPLE/2 - 1);
+ i2 = naxes[0]/2 + (XSAMPLE/2);
+ if (i1 < 1) i1 = 1;
+ if (i2 > naxes[0]) i2 = naxes[0];
+ fpixel[0] = i1;
+ lpixel[0] = i2;
+ nx = i2 - i1 +1;
+
+ if (naxis > 1) {
+ i1 = naxes[1]/2 - (YSAMPLE/2 - 1);
+ i2 = naxes[1]/2 + (YSAMPLE/2);
+ if (i1 < 1) i1 = 1;
+ if (i2 > naxes[1]) i2 = naxes[1];
+ fpixel[1] = i1;
+ lpixel[1] = i2;
+ }
+ ny = i2 - i1 +1;
+
+ npix = nx * ny;
+
+ /* if there are higher dimensions, read the middle plane of the cube */
+ if (naxis > 2) {
+ fpixel[2] = naxes[2]/2 + 1;
+ lpixel[2] = naxes[2]/2 + 1;
+ }
+
+ intarray = calloc(npix, sizeof(int));
+ if (!intarray) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* turn off any scaling of the integer pixel values */
+ fits_set_bscale(infptr, 1.0, 0.0, status);
+
+ fits_read_subset_int(infptr, 0, naxis, naxes, fpixel, lpixel, inc,
+ 0, intarray, &anynul, status);
+
+ /* read the null value keyword (BLANK) if present */
+ tstatus = 0;
+ fits_read_key(infptr, TINT, "BLANK", &nullvalue, 0, &tstatus);
+ if (tstatus) {
+ nullvalue = 0;
+ checknull = 0;
+ }
+
+ /* compute statistics of the image */
+
+ fits_img_stats_int(intarray, nx, ny, checknull, nullvalue,
+ &ngood, &minvalue, &maxvalue, &mean, &sigma, &noise1, &noise2, &noise3, &noise5, status);
+
+ imagestats->n_nulls = npix - ngood;
+ imagestats->minval = minvalue;
+ imagestats->maxval = maxvalue;
+ imagestats->mean = mean;
+ imagestats->sigma = sigma;
+ imagestats->noise1 = noise1;
+ imagestats->noise2 = noise2;
+ imagestats->noise3 = noise3;
+ imagestats->noise5 = noise5;
+
+ free(intarray);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fp_r4stat(fitsfile *infptr, int naxis, long *naxes, imgstats *imagestats, int *status)
+{
+/*
+ read the central XSAMPLE by YSAMPLE region of pixels in the int*2 image,
+ and then compute basic statistics: min, max, mean, sigma, mean diff, etc.
+*/
+
+ long fpixel[9] = {1,1,1,1,1,1,1,1,1};
+ long lpixel[9] = {1,1,1,1,1,1,1,1,1};
+ long inc[9] = {1,1,1,1,1,1,1,1,1};
+ long i1, i2, npix, ii, ngood, nx, ny;
+ float *array, minvalue, maxvalue, nullvalue = FLOATNULLVALUE;
+ int anynul,checknull = 1;
+ double mean, sigma, noise1, noise2, noise3, noise5;
+
+ /* select the middle XSAMPLE by YSAMPLE area of the image */
+ i1 = naxes[0]/2 - (XSAMPLE/2 - 1);
+ i2 = naxes[0]/2 + (XSAMPLE/2);
+ if (i1 < 1) i1 = 1;
+ if (i2 > naxes[0]) i2 = naxes[0];
+ fpixel[0] = i1;
+ lpixel[0] = i2;
+ nx = i2 - i1 +1;
+
+ if (naxis > 1) {
+ i1 = naxes[1]/2 - (YSAMPLE/2 - 1);
+ i2 = naxes[1]/2 + (YSAMPLE/2);
+ if (i1 < 1) i1 = 1;
+ if (i2 > naxes[1]) i2 = naxes[1];
+ fpixel[1] = i1;
+ lpixel[1] = i2;
+ }
+ ny = i2 - i1 +1;
+
+ npix = nx * ny;
+
+ /* if there are higher dimensions, read the middle plane of the cube */
+ if (naxis > 2) {
+ fpixel[2] = naxes[2]/2 + 1;
+ lpixel[2] = naxes[2]/2 + 1;
+ }
+
+ array = calloc(npix, sizeof(float));
+ if (!array) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ fits_read_subset_flt(infptr, 0, naxis, naxes, fpixel, lpixel, inc,
+ nullvalue, array, &anynul, status);
+
+ /* are there any null values in the array? */
+ if (!anynul) {
+ nullvalue = 0.;
+ checknull = 0;
+ }
+
+ /* compute statistics of the image */
+
+ fits_img_stats_float(array, nx, ny, checknull, nullvalue,
+ &ngood, &minvalue, &maxvalue, &mean, &sigma, &noise1, &noise2, &noise3, &noise5, status);
+
+ imagestats->n_nulls = npix - ngood;
+ imagestats->minval = minvalue;
+ imagestats->maxval = maxvalue;
+ imagestats->mean = mean;
+ imagestats->sigma = sigma;
+ imagestats->noise1 = noise1;
+ imagestats->noise2 = noise2;
+ imagestats->noise3 = noise3;
+ imagestats->noise5 = noise5;
+
+ free(array);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fp_i2rescale(fitsfile *infptr, int naxis, long *naxes, double rescale,
+ fitsfile *outfptr, int *status)
+{
+/*
+ divide the integer pixel values in the input file by rescale,
+ and write back out to the output file..
+*/
+
+ long ii, jj, nelem = 1, nx, ny;
+ short *intarray, nullvalue;
+ int anynul, tstatus, checknull = 1;
+
+ nx = naxes[0];
+ ny = 1;
+
+ for (ii = 1; ii < naxis; ii++) {
+ ny = ny * naxes[ii];
+ }
+
+ intarray = calloc(nx, sizeof(short));
+ if (!intarray) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* read the null value keyword (BLANK) if present */
+ tstatus = 0;
+ fits_read_key(infptr, TSHORT, "BLANK", &nullvalue, 0, &tstatus);
+ if (tstatus) {
+ checknull = 0;
+ }
+
+ /* turn off any scaling of the integer pixel values */
+ fits_set_bscale(infptr, 1.0, 0.0, status);
+ fits_set_bscale(outfptr, 1.0, 0.0, status);
+
+ for (ii = 0; ii < ny; ii++) {
+
+ fits_read_img_sht(infptr, 1, nelem, nx,
+ 0, intarray, &anynul, status);
+
+ if (checknull) {
+ for (jj = 0; jj < nx; jj++) {
+ if (intarray[jj] != nullvalue)
+ intarray[jj] = NSHRT( (intarray[jj] / rescale) );
+ }
+ } else {
+ for (jj = 0; jj < nx; jj++)
+ intarray[jj] = NSHRT( (intarray[jj] / rescale) );
+ }
+
+ fits_write_img_sht(outfptr, 1, nelem, nx, intarray, status);
+
+ nelem += nx;
+ }
+
+ free(intarray);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fp_i4rescale(fitsfile *infptr, int naxis, long *naxes, double rescale,
+ fitsfile *outfptr, int *status)
+{
+/*
+ divide the integer pixel values in the input file by rescale,
+ and write back out to the output file..
+*/
+
+ long ii, jj, nelem = 1, nx, ny;
+ int *intarray, nullvalue;
+ int anynul, tstatus, checknull = 1;
+
+ nx = naxes[0];
+ ny = 1;
+
+ for (ii = 1; ii < naxis; ii++) {
+ ny = ny * naxes[ii];
+ }
+
+ intarray = calloc(nx, sizeof(int));
+ if (!intarray) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* read the null value keyword (BLANK) if present */
+ tstatus = 0;
+ fits_read_key(infptr, TINT, "BLANK", &nullvalue, 0, &tstatus);
+ if (tstatus) {
+ checknull = 0;
+ }
+
+ /* turn off any scaling of the integer pixel values */
+ fits_set_bscale(infptr, 1.0, 0.0, status);
+ fits_set_bscale(outfptr, 1.0, 0.0, status);
+
+ for (ii = 0; ii < ny; ii++) {
+
+ fits_read_img_int(infptr, 1, nelem, nx,
+ 0, intarray, &anynul, status);
+
+ if (checknull) {
+ for (jj = 0; jj < nx; jj++) {
+ if (intarray[jj] != nullvalue)
+ intarray[jj] = NINT( (intarray[jj] / rescale) );
+ }
+ } else {
+ for (jj = 0; jj < nx; jj++)
+ intarray[jj] = NINT( (intarray[jj] / rescale) );
+ }
+
+ fits_write_img_int(outfptr, 1, nelem, nx, intarray, status);
+
+ nelem += nx;
+ }
+
+ free(intarray);
+ return(*status);
+}
+/* ========================================================================
+ * Signal and error handler.
+ */
+void abort_fpack(int sig)
+{
+ /* clean up by deleting temporary files */
+
+ if (tempfilename[0]) {
+ remove(tempfilename);
+ }
+ if (tempfilename2[0]) {
+ remove(tempfilename2);
+ }
+ if (tempfilename3[0]) {
+ remove(tempfilename3);
+ }
+ exit(-1);
+}
diff --git a/src/plugins/cfitsio/getcol.c b/src/plugins/cfitsio/getcol.c
new file mode 100644
index 0000000..f40b91d
--- /dev/null
+++ b/src/plugins/cfitsio/getcol.c
@@ -0,0 +1,1055 @@
+
+/* This file, getcol.c, contains routines that read data elements from */
+/* a FITS image or table. There are generic datatype routines. */
+
+/* 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 "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpxv( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ long *firstpix, /* I - coord of first pixel to read (1s based) */
+ LONGLONG nelem, /* I - number of values to read */
+ void *nulval, /* I - value for undefined pixels */
+ void *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ LONGLONG tfirstpix[99];
+ int naxis, ii;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+
+ for (ii=0; ii < naxis; ii++)
+ tfirstpix[ii] = firstpix[ii];
+
+ ffgpxvll(fptr, datatype, tfirstpix, nelem, nulval, array, anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpxvll( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ LONGLONG *firstpix, /* I - coord of first pixel to read (1s based) */
+ LONGLONG nelem, /* I - number of values to read */
+ void *nulval, /* I - value for undefined pixels */
+ void *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ int naxis, ii;
+ char cdummy;
+ int nullcheck = 1;
+ LONGLONG naxes[9], trc[9]= {1,1,1,1,1,1,1,1,1};
+ long inc[9]= {1,1,1,1,1,1,1,1,1};
+ LONGLONG dimsize = 1, firstelem;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+
+ ffgiszll(fptr, 9, naxes, status);
+
+ if (naxis == 0 || naxes[0] == 0) {
+ *status = BAD_DIMEN;
+ return(*status);
+ }
+
+ /* calculate the position of the first element in the array */
+ firstelem = 0;
+ for (ii=0; ii < naxis; ii++)
+ {
+ firstelem += ((firstpix[ii] - 1) * dimsize);
+ dimsize *= naxes[ii];
+ trc[ii] = firstpix[ii];
+ }
+ firstelem++;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ /* test for special case of reading an integral number of */
+ /* rows in a 2D or 3D image (which includes reading the whole image */
+
+ if (naxis > 1 && naxis < 4 && firstpix[0] == 1 &&
+ (nelem / naxes[0]) * naxes[0] == nelem) {
+
+ /* calculate coordinate of last pixel */
+ trc[0] = naxes[0]; /* reading whole rows */
+ trc[1] = firstpix[1] + (nelem / naxes[0] - 1);
+ while (trc[1] > naxes[1]) {
+ trc[1] = trc[1] - naxes[1];
+ trc[2] = trc[2] + 1; /* increment to next plane of cube */
+ }
+
+ fits_read_compressed_img(fptr, datatype, firstpix, trc, inc,
+ 1, nulval, array, NULL, anynul, status);
+
+ } else {
+
+ fits_read_compressed_pixels(fptr, datatype, firstelem,
+ nelem, nullcheck, nulval, array, NULL, anynul, status);
+ }
+
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (datatype == TBYTE)
+ {
+ if (nulval == 0)
+ ffgclb(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (unsigned char *) array, &cdummy, anynul, status);
+ else
+ ffgclb(fptr, 2, 1, firstelem, nelem, 1, 1, *(unsigned char *) nulval,
+ (unsigned char *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ if (nulval == 0)
+ ffgclsb(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (signed char *) array, &cdummy, anynul, status);
+ else
+ ffgclsb(fptr, 2, 1, firstelem, nelem, 1, 1, *(signed char *) nulval,
+ (signed char *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ if (nulval == 0)
+ ffgclui(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (unsigned short *) array, &cdummy, anynul, status);
+ else
+ ffgclui(fptr, 2, 1, firstelem, nelem, 1, 1, *(unsigned short *) nulval,
+ (unsigned short *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ if (nulval == 0)
+ ffgcli(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (short *) array, &cdummy, anynul, status);
+ else
+ ffgcli(fptr, 2, 1, firstelem, nelem, 1, 1, *(short *) nulval,
+ (short *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TUINT)
+ {
+ if (nulval == 0)
+ ffgcluk(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (unsigned int *) array, &cdummy, anynul, status);
+ else
+ ffgcluk(fptr, 2, 1, firstelem, nelem, 1, 1, *(unsigned int *) nulval,
+ (unsigned int *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TINT)
+ {
+ if (nulval == 0)
+ ffgclk(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (int *) array, &cdummy, anynul, status);
+ else
+ ffgclk(fptr, 2, 1, firstelem, nelem, 1, 1, *(int *) nulval,
+ (int *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TULONG)
+ {
+ if (nulval == 0)
+ ffgcluj(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (unsigned long *) array, &cdummy, anynul, status);
+ else
+ ffgcluj(fptr, 2, 1, firstelem, nelem, 1, 1, *(unsigned long *) nulval,
+ (unsigned long *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TLONG)
+ {
+ if (nulval == 0)
+ ffgclj(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (long *) array, &cdummy, anynul, status);
+ else
+ ffgclj(fptr, 2, 1, firstelem, nelem, 1, 1, *(long *) nulval,
+ (long *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ if (nulval == 0)
+ ffgcljj(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (LONGLONG *) array, &cdummy, anynul, status);
+ else
+ ffgcljj(fptr, 2, 1, firstelem, nelem, 1, 1, *(LONGLONG *) nulval,
+ (LONGLONG *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ if (nulval == 0)
+ ffgcle(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (float *) array, &cdummy, anynul, status);
+ else
+ ffgcle(fptr, 2, 1, firstelem, nelem, 1, 1, *(float *) nulval,
+ (float *) array, &cdummy, anynul, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ if (nulval == 0)
+ ffgcld(fptr, 2, 1, firstelem, nelem, 1, 1, 0,
+ (double *) array, &cdummy, anynul, status);
+ else
+ ffgcld(fptr, 2, 1, firstelem, nelem, 1, 1, *(double *) nulval,
+ (double *) array, &cdummy, anynul, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpxf( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ long *firstpix, /* I - coord of first pixel to read (1s based) */
+ LONGLONG nelem, /* I - number of values to read */
+ void *array, /* O - array of values that are returned */
+ char *nullarray, /* O - returned array of null value flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ The nullarray values will = 1 if the corresponding array value is null.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ LONGLONG tfirstpix[99];
+ int naxis, ii;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+
+ for (ii=0; ii < naxis; ii++)
+ tfirstpix[ii] = firstpix[ii];
+
+ ffgpxfll(fptr, datatype, tfirstpix, nelem, array, nullarray, anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpxfll( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ LONGLONG *firstpix, /* I - coord of first pixel to read (1s based) */
+ LONGLONG nelem, /* I - number of values to read */
+ void *array, /* O - array of values that are returned */
+ char *nullarray, /* O - returned array of null value flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ The nullarray values will = 1 if the corresponding array value is null.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ int naxis, ii;
+ int nullcheck = 2;
+ LONGLONG naxes[9];
+ LONGLONG dimsize = 1, firstelem;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+ ffgiszll(fptr, 9, naxes, status);
+
+ /* calculate the position of the first element in the array */
+ firstelem = 0;
+ for (ii=0; ii < naxis; ii++)
+ {
+ firstelem += ((firstpix[ii] - 1) * dimsize);
+ dimsize *= naxes[ii];
+ }
+ firstelem++;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, datatype, firstelem, nelem,
+ nullcheck, NULL, array, nullarray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (datatype == TBYTE)
+ {
+ ffgclb(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (unsigned char *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffgclsb(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (signed char *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffgclui(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (unsigned short *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffgcli(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (short *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffgcluk(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (unsigned int *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffgclk(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (int *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffgcluj(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (unsigned long *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffgclj(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (long *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffgcljj(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (LONGLONG *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffgcle(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (float *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffgcld(fptr, 2, 1, firstelem, nelem, 1, 2, 0,
+ (double *) array, nullarray, anynul, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsv( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc , /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dim. */
+ void *nulval, /* I - value for undefined pixels */
+ void *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an section of values from the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ int naxis, ii;
+ long naxes[9];
+ LONGLONG nelem = 1;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+ ffgisz(fptr, 9, naxes, status);
+
+ /* test for the important special case where we are reading the whole image */
+ /* this is only useful for images that are not tile-compressed */
+ if (!fits_is_compressed_image(fptr, status)) {
+ for (ii = 0; ii < naxis; ii++) {
+ if (inc[ii] != 1 || blc[ii] !=1 || trc[ii] != naxes[ii])
+ break;
+
+ nelem = nelem * naxes[ii];
+ }
+
+ if (ii == naxis) {
+ /* read the whole image more efficiently */
+ ffgpxv(fptr, datatype, blc, nelem, nulval, array, anynul, status);
+ return(*status);
+ }
+ }
+
+ if (datatype == TBYTE)
+ {
+ if (nulval == 0)
+ ffgsvb(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (unsigned char *) array, anynul, status);
+ else
+ ffgsvb(fptr, 1, naxis, naxes, blc, trc, inc, *(unsigned char *) nulval,
+ (unsigned char *) array, anynul, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ if (nulval == 0)
+ ffgsvsb(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (signed char *) array, anynul, status);
+ else
+ ffgsvsb(fptr, 1, naxis, naxes, blc, trc, inc, *(signed char *) nulval,
+ (signed char *) array, anynul, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ if (nulval == 0)
+ ffgsvui(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (unsigned short *) array, anynul, status);
+ else
+ ffgsvui(fptr, 1, naxis, naxes,blc, trc, inc, *(unsigned short *) nulval,
+ (unsigned short *) array, anynul, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ if (nulval == 0)
+ ffgsvi(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (short *) array, anynul, status);
+ else
+ ffgsvi(fptr, 1, naxis, naxes, blc, trc, inc, *(short *) nulval,
+ (short *) array, anynul, status);
+ }
+ else if (datatype == TUINT)
+ {
+ if (nulval == 0)
+ ffgsvuk(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (unsigned int *) array, anynul, status);
+ else
+ ffgsvuk(fptr, 1, naxis, naxes, blc, trc, inc, *(unsigned int *) nulval,
+ (unsigned int *) array, anynul, status);
+ }
+ else if (datatype == TINT)
+ {
+ if (nulval == 0)
+ ffgsvk(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (int *) array, anynul, status);
+ else
+ ffgsvk(fptr, 1, naxis, naxes, blc, trc, inc, *(int *) nulval,
+ (int *) array, anynul, status);
+ }
+ else if (datatype == TULONG)
+ {
+ if (nulval == 0)
+ ffgsvuj(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (unsigned long *) array, anynul, status);
+ else
+ ffgsvuj(fptr, 1, naxis, naxes, blc, trc, inc, *(unsigned long *) nulval,
+ (unsigned long *) array, anynul, status);
+ }
+ else if (datatype == TLONG)
+ {
+ if (nulval == 0)
+ ffgsvj(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (long *) array, anynul, status);
+ else
+ ffgsvj(fptr, 1, naxis, naxes, blc, trc, inc, *(long *) nulval,
+ (long *) array, anynul, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ if (nulval == 0)
+ ffgsvjj(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (LONGLONG *) array, anynul, status);
+ else
+ ffgsvjj(fptr, 1, naxis, naxes, blc, trc, inc, *(LONGLONG *) nulval,
+ (LONGLONG *) array, anynul, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ if (nulval == 0)
+ ffgsve(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (float *) array, anynul, status);
+ else
+ ffgsve(fptr, 1, naxis, naxes, blc, trc, inc, *(float *) nulval,
+ (float *) array, anynul, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ if (nulval == 0)
+ ffgsvd(fptr, 1, naxis, naxes, blc, trc, inc, 0,
+ (double *) array, anynul, status);
+ else
+ ffgsvd(fptr, 1, naxis, naxes, blc, trc, inc, *(double *) nulval,
+ (double *) array, anynul, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpv( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ void *nulval, /* I - value for undefined pixels */
+ void *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (datatype == TBYTE)
+ {
+ if (nulval == 0)
+ ffgpvb(fptr, 1, firstelem, nelem, 0,
+ (unsigned char *) array, anynul, status);
+ else
+ ffgpvb(fptr, 1, firstelem, nelem, *(unsigned char *) nulval,
+ (unsigned char *) array, anynul, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ if (nulval == 0)
+ ffgpvsb(fptr, 1, firstelem, nelem, 0,
+ (signed char *) array, anynul, status);
+ else
+ ffgpvsb(fptr, 1, firstelem, nelem, *(signed char *) nulval,
+ (signed char *) array, anynul, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ if (nulval == 0)
+ ffgpvui(fptr, 1, firstelem, nelem, 0,
+ (unsigned short *) array, anynul, status);
+ else
+ ffgpvui(fptr, 1, firstelem, nelem, *(unsigned short *) nulval,
+ (unsigned short *) array, anynul, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ if (nulval == 0)
+ ffgpvi(fptr, 1, firstelem, nelem, 0,
+ (short *) array, anynul, status);
+ else
+ ffgpvi(fptr, 1, firstelem, nelem, *(short *) nulval,
+ (short *) array, anynul, status);
+ }
+ else if (datatype == TUINT)
+ {
+ if (nulval == 0)
+ ffgpvuk(fptr, 1, firstelem, nelem, 0,
+ (unsigned int *) array, anynul, status);
+ else
+ ffgpvuk(fptr, 1, firstelem, nelem, *(unsigned int *) nulval,
+ (unsigned int *) array, anynul, status);
+ }
+ else if (datatype == TINT)
+ {
+ if (nulval == 0)
+ ffgpvk(fptr, 1, firstelem, nelem, 0,
+ (int *) array, anynul, status);
+ else
+ ffgpvk(fptr, 1, firstelem, nelem, *(int *) nulval,
+ (int *) array, anynul, status);
+ }
+ else if (datatype == TULONG)
+ {
+ if (nulval == 0)
+ ffgpvuj(fptr, 1, firstelem, nelem, 0,
+ (unsigned long *) array, anynul, status);
+ else
+ ffgpvuj(fptr, 1, firstelem, nelem, *(unsigned long *) nulval,
+ (unsigned long *) array, anynul, status);
+ }
+ else if (datatype == TLONG)
+ {
+ if (nulval == 0)
+ ffgpvj(fptr, 1, firstelem, nelem, 0,
+ (long *) array, anynul, status);
+ else
+ ffgpvj(fptr, 1, firstelem, nelem, *(long *) nulval,
+ (long *) array, anynul, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ if (nulval == 0)
+ ffgpvjj(fptr, 1, firstelem, nelem, 0,
+ (LONGLONG *) array, anynul, status);
+ else
+ ffgpvjj(fptr, 1, firstelem, nelem, *(LONGLONG *) nulval,
+ (LONGLONG *) array, anynul, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ if (nulval == 0)
+ ffgpve(fptr, 1, firstelem, nelem, 0,
+ (float *) array, anynul, status);
+ else
+ ffgpve(fptr, 1, firstelem, nelem, *(float *) nulval,
+ (float *) array, anynul, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ if (nulval == 0)
+ ffgpvd(fptr, 1, firstelem, nelem, 0,
+ (double *) array, anynul, status);
+ else
+ {
+ ffgpvd(fptr, 1, firstelem, nelem, *(double *) nulval,
+ (double *) array, anynul, status);
+ }
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpf( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ void *array, /* O - array of values that are returned */
+ char *nullarray, /* O - array of null value flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ The nullarray values will = 1 if the corresponding array value is null.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (datatype == TBYTE)
+ {
+ ffgpfb(fptr, 1, firstelem, nelem,
+ (unsigned char *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffgpfsb(fptr, 1, firstelem, nelem,
+ (signed char *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffgpfui(fptr, 1, firstelem, nelem,
+ (unsigned short *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffgpfi(fptr, 1, firstelem, nelem,
+ (short *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffgpfuk(fptr, 1, firstelem, nelem,
+ (unsigned int *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffgpfk(fptr, 1, firstelem, nelem,
+ (int *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffgpfuj(fptr, 1, firstelem, nelem,
+ (unsigned long *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffgpfj(fptr, 1, firstelem, nelem,
+ (long *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffgpfjj(fptr, 1, firstelem, nelem,
+ (LONGLONG *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffgpfe(fptr, 1, firstelem, nelem,
+ (float *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffgpfd(fptr, 1, firstelem, nelem,
+ (double *) array, nullarray, anynul, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcv( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ void *nulval, /* I - value for undefined pixels */
+ void *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a table column. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of true if any pixels are undefined.
+*/
+{
+ char cdummy[2];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (datatype == TBIT)
+ {
+ ffgcx(fptr, colnum, firstrow, firstelem, nelem, (char *) array, status);
+ }
+ else if (datatype == TBYTE)
+ {
+ if (nulval == 0)
+ ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0,
+ (unsigned char *) array, cdummy, anynul, status);
+ else
+ ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(unsigned char *)
+ nulval, (unsigned char *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ if (nulval == 0)
+ ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0,
+ (signed char *) array, cdummy, anynul, status);
+ else
+ ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(signed char *)
+ nulval, (signed char *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ if (nulval == 0)
+ ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0,
+ (unsigned short *) array, cdummy, anynul, status);
+ else
+ ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 1,
+ *(unsigned short *) nulval,
+ (unsigned short *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ if (nulval == 0)
+ ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0,
+ (short *) array, cdummy, anynul, status);
+ else
+ ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(short *)
+ nulval, (short *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TUINT)
+ {
+ if (nulval == 0)
+ ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0,
+ (unsigned int *) array, cdummy, anynul, status);
+ else
+ ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 1,
+ *(unsigned int *) nulval, (unsigned int *) array, cdummy, anynul,
+ status);
+ }
+ else if (datatype == TINT)
+ {
+ if (nulval == 0)
+ ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0,
+ (int *) array, cdummy, anynul, status);
+ else
+ ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(int *)
+ nulval, (int *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TULONG)
+ {
+ if (nulval == 0)
+ ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0,
+ (unsigned long *) array, cdummy, anynul, status);
+ else
+ ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 1,
+ *(unsigned long *) nulval,
+ (unsigned long *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TLONG)
+ {
+ if (nulval == 0)
+ ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0,
+ (long *) array, cdummy, anynul, status);
+ else
+ ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(long *)
+ nulval, (long *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ if (nulval == 0)
+ ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0,
+ (LONGLONG *) array, cdummy, anynul, status);
+ else
+ ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(LONGLONG *)
+ nulval, (LONGLONG *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ if (nulval == 0)
+ ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0.,
+ (float *) array, cdummy, anynul, status);
+ else
+ ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(float *)
+ nulval,(float *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ if (nulval == 0)
+ ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0.,
+ (double *) array, cdummy, anynul, status);
+ else
+ ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(double *)
+ nulval, (double *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TCOMPLEX)
+ {
+ if (nulval == 0)
+ ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ 1, 1, 0., (float *) array, cdummy, anynul, status);
+ else
+ ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ 1, 1, *(float *) nulval, (float *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TDBLCOMPLEX)
+ {
+ if (nulval == 0)
+ ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ 1, 1, 0., (double *) array, cdummy, anynul, status);
+ else
+ ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ 1, 1, *(double *) nulval, (double *) array, cdummy, anynul, status);
+ }
+
+ else if (datatype == TLOGICAL)
+ {
+ if (nulval == 0)
+ ffgcll(fptr, colnum, firstrow, firstelem, nelem, 1, 0,
+ (char *) array, cdummy, anynul, status);
+ else
+ ffgcll(fptr, colnum, firstrow, firstelem, nelem, 1, *(char *) nulval,
+ (char *) array, cdummy, anynul, status);
+ }
+ else if (datatype == TSTRING)
+ {
+ if (nulval == 0)
+ {
+ cdummy[0] = '\0';
+ ffgcls(fptr, colnum, firstrow, firstelem, nelem, 1,
+ cdummy, (char **) array, cdummy, anynul, status);
+ }
+ else
+ ffgcls(fptr, colnum, firstrow, firstelem, nelem, 1, (char *)
+ nulval, (char **) array, cdummy, anynul, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcf( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ void *array, /* O - array of values that are returned */
+ char *nullarray, /* O - array of null value flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a table column. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ ANYNUL is returned with a value of true if any pixels are undefined.
+*/
+{
+ void *nulval; /* dummy argument */
+ double dnulval = 0.;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ nulval = &dnulval; /* set to a harmless value; this is never used */
+
+ if (datatype == TBIT)
+ {
+ ffgcx(fptr, colnum, firstrow, firstelem, nelem, (char *) array, status);
+ }
+ else if (datatype == TBYTE)
+ {
+ ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(unsigned char *)
+ nulval, (unsigned char *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(signed char *)
+ nulval, (signed char *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 2,
+ *(unsigned short *) nulval,
+ (unsigned short *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(short *)
+ nulval, (short *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 2,
+ *(unsigned int *) nulval, (unsigned int *) array, nullarray, anynul,
+ status);
+ }
+ else if (datatype == TINT)
+ {
+ ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(int *)
+ nulval, (int *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 2,
+ *(unsigned long *) nulval,
+ (unsigned long *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(long *)
+ nulval, (long *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(LONGLONG *)
+ nulval, (LONGLONG *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(float *)
+ nulval,(float *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 2, *(double *)
+ nulval, (double *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TCOMPLEX)
+ {
+ ffgcfc(fptr, colnum, firstrow, firstelem, nelem,
+ (float *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TDBLCOMPLEX)
+ {
+ ffgcfm(fptr, colnum, firstrow, firstelem, nelem,
+ (double *) array, nullarray, anynul, status);
+ }
+
+ else if (datatype == TLOGICAL)
+ {
+ ffgcll(fptr, colnum, firstrow, firstelem, nelem, 2, *(char *) nulval,
+ (char *) array, nullarray, anynul, status);
+ }
+ else if (datatype == TSTRING)
+ {
+ ffgcls(fptr, colnum, firstrow, firstelem, nelem, 2, (char *)
+ nulval, (char **) array, nullarray, anynul, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+
diff --git a/src/plugins/cfitsio/getcolb.c b/src/plugins/cfitsio/getcolb.c
new file mode 100644
index 0000000..4fff57d
--- /dev/null
+++ b/src/plugins/cfitsio/getcolb.c
@@ -0,0 +1,2001 @@
+/* This file, getcolb.c, contains routines that read data elements from */
+/* a FITS image or table, with unsigned char (unsigned byte) data type. */
+
+/* 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpvb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ unsigned char nulval, /* I - value for undefined pixels */
+ unsigned char *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ unsigned char nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TBYTE, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclb(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ unsigned char *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TBYTE, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclb(fptr, 2, row, firstelem, nelem, 1, 2, 0,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2db(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ unsigned char nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ unsigned char *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3db(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3db(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ unsigned char nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ unsigned char *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ LONGLONG narray, nfits;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1};
+ LONGLONG lpixel[3];
+ unsigned char nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TBYTE, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgclb(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgclb(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvb(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ unsigned char nulval, /* I - value to set undefined pixels */
+ unsigned char *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii, i0, i1, i2, i3, i4, i5, i6, i7, i8, row, rstr, rstp, rinc;
+ long str[9], stp[9], incr[9], dir[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ unsigned char nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvb is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TBYTE, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ dir[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ if (hdutype == IMAGE_HDU)
+ {
+ dir[ii] = -1;
+ }
+ else
+ {
+ sprintf(msg, "ffgsvb: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ dsize[ii] = dsize[ii] * dir[ii];
+ }
+ dsize[naxis] = dsize[naxis] * dir[naxis];
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
+ ninc = incr[0] * dir[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
+ {
+
+ felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
+ (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
+ (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
+ (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
+
+ if ( ffgclb(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfb(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ unsigned char *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ int hdutype, anyf;
+ unsigned char nulval = 0;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvb is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TBYTE, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvb: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgclb(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ unsigned char *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclb(fptr, 1, row, firstelem, nelem, 1, 1, 0,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvb(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 */
+ unsigned char nulval, /* I - value for null pixels */
+ unsigned 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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfb(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 */
+ unsigned char *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ unsigned char dummy = 0;
+
+ ffgclb(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgclb( 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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ unsigned char nulval, /* I - value for null pixels if nultyp = 1 */
+ unsigned 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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1., dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre, ntodo;
+ long ii, xwidth;
+ int convert, nulcheck, readcheck = 0;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ union u_tag {
+ char charval;
+ unsigned char ucharval;
+ } u;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ if (anynul)
+ *anynul = 0;
+
+ if (nultyp == 2)
+ memset(nularray, 0, (size_t) nelem); /* initialize nullarray */
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (elemincre < 0)
+ readcheck = -1; /* don't do range checking in this case */
+
+ ffgcprll( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status);
+
+ /* special case */
+ if (tcode == TLOGICAL && elemincre == 1)
+ {
+ u.ucharval = nulval;
+ ffgcll(fptr, colnum, firstrow, firstelem, nelem, nultyp,
+ u.charval, (char *) array, nularray, anynul, status);
+
+ return(*status);
+ }
+
+ if (strchr(tform,'A') != NULL)
+ {
+ if (*status == BAD_ELEM_NUM)
+ {
+ /* ignore this error message */
+ *status = 0;
+ ffcmsg(); /* clear error stack */
+ }
+
+ /* interpret a 'A' ASCII column as a 'B' byte column ('8A' == '8B') */
+ /* This is an undocumented 'feature' in CFITSIO */
+
+ /* we have to reset some of the values returned by ffgcpr */
+
+ tcode = TBYTE;
+ incre = 1; /* each element is 1 byte wide */
+ repeat = twidth; /* total no. of chars in the col */
+ twidth = 1; /* width of each element */
+ scale = 1.0; /* no scaling */
+ zero = 0.0;
+ tnull = NULL_UNDEFINED; /* don't test for nulls */
+ maxelem = DBUFFSIZE;
+ }
+
+ if (*status > 0)
+ return(*status);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING && hdutype == ASCII_TBL) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ convert = 1;
+ if (tcode == TBYTE) /* Special Case: */
+ { /* no type convertion required, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+
+ if (nulcheck == 0 && scale == 1. && zero == 0.)
+ convert = 0; /* no need to scale data or find nulls */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer or to the number of pixels that remain in
+ the current vector, which ever is smaller.
+ */
+ ntodo = (long) minvalue(remain, maxelem);
+ if (elemincre >= 0)
+ {
+ ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
+ }
+ else
+ {
+ ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
+ }
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, &array[next], status);
+ if (convert)
+ fffi1i1(&array[next], ntodo, scale, zero, nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status);
+ fffi2i1((short *) buffer, ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
+ status);
+ fffi4i1((INT32BIT *) buffer, ntodo, scale, zero, nulcheck,
+ (INT32BIT) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONGLONG):
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8i1( (LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4i1((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8i1((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ /* interpret the string as an ASCII formated number */
+ fffstri1((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read bytes from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgclb).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgclb).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ else if (elemnum < 0) /* completed a row; start on a previous row */
+ {
+ rowincre = (-elemnum - 1) / repeat + 1;
+ rownum -= rowincre;
+ elemnum = (rowincre * repeat) + elemnum;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgextn( fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG offset, /* I - byte offset from start of extension data */
+ LONGLONG nelem, /* I - number of elements to read */
+ void *buffer, /* I - stream of bytes to read */
+ int *status) /* IO - error status */
+/*
+ Read a stream of bytes from the current FITS HDU. This primative routine is mainly
+ for reading non-standard "conforming" extensions and should not be used
+ for standard IMAGE, TABLE or BINTABLE extensions.
+*/
+{
+ if (*status > 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);
+
+ /* move to write position */
+ ffmbyt(fptr, (fptr->Fptr)->datastart+ offset, IGNORE_EOF, status);
+
+ /* read the buffer */
+ ffgbyt(fptr, nelem, buffer, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1i1(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned char *output,/* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ { /* this routine is normally not called in this case */
+ memcpy(output, input, ntodo );
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2i1(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned char *output,/* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+
+ else
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4i1(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned char *output,/* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8i1(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned char *output,/* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4i1(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned char *output,/* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ /* use redundant boolean logic in following statement */
+ /* to suppress irritating Borland compiler warning message */
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (zero > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8i1(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char nullval,/* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned char *output,/* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (zero > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstri1(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ unsigned char nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned char *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1;
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ dvalue = dvalue * scale + zero; /* apply the scaling */
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) dvalue;
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getcold.c b/src/plugins/cfitsio/getcold.c
new file mode 100644
index 0000000..8c33931
--- /dev/null
+++ b/src/plugins/cfitsio/getcold.c
@@ -0,0 +1,1676 @@
+/* This file, getcold.c, contains routines that read data elements from */
+/* a FITS image or table, with double 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpvd( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ double nulval, /* I - value for undefined pixels */
+ double *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ double nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TDOUBLE, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcld(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfd( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ double *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TDOUBLE, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcld(fptr, 2, row, firstelem, nelem, 1, 2, 0.,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2dd(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ double nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ double *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3dd(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3dd(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ double nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ double *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ LONGLONG nfits, narray;
+ long tablerow, ii, jj;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1};
+ LONGLONG lpixel[3];
+ double nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TDOUBLE, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgcld(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgcld(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvd(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ double nulval, /* I - value to set undefined pixels */
+ double *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dir[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ double nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvd is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TDOUBLE, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ dir[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ if (hdutype == IMAGE_HDU)
+ {
+ dir[ii] = -1;
+ }
+ else
+ {
+ sprintf(msg, "ffgsvd: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ dsize[ii] = dsize[ii] * dir[ii];
+ }
+ dsize[naxis] = dsize[naxis] * dir[naxis];
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
+ ninc = incr[0] * dir[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
+ {
+
+ felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
+ (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
+ (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
+ (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
+
+ if ( ffgcld(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfd(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ double *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ int hdutype, anyf;
+ double nulval = 0;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvd is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TDOUBLE, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvd: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgcld(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpd( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ double *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcld(fptr, 1, row, firstelem, nelem, 1, 1, 0.,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvd(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 */
+ double nulval, /* I - value for null pixels */
+ double *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvm(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 */
+ double nulval, /* I - value for null pixels */
+ double *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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.
+
+ TSCAL and ZERO should not be used with complex values.
+*/
+{
+ char cdummy;
+
+ /* a complex double value is interpreted as a pair of double values, */
+ /* thus need to multiply the first element and number of elements by 2 */
+
+ ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ 1, 1, nulval, array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfd(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 */
+ double *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ double dummy = 0;
+
+ ffgcld(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfm(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 */
+ double *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+
+ TSCAL and ZERO should not be used with complex values.
+*/
+{
+ long ii, jj;
+ float dummy = 0;
+ char *carray;
+
+ /* a complex double value is interpreted as a pair of double values, */
+ /* thus need to multiply the first element and number of elements by 2 */
+
+ /* allocate temporary array */
+ carray = (char *) calloc( (size_t) (nelem * 2), 1);
+
+ ffgcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ 1, 2, dummy, array, carray, anynul, status);
+
+ for (ii = 0, jj = 0; jj < nelem; ii += 2, jj++)
+ {
+ if (carray[ii] || carray[ii + 1])
+ nularray[jj] = 1;
+ else
+ nularray[jj] = 0;
+ }
+
+ free(carray);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcld( 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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ double nulval, /* I - value for null pixels if nultyp = 1 */
+ double *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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1, dtemp;
+ int tcode, hdutype, xcode, decimals, maxelem;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int convert, nulcheck, readcheck = 0;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ if (anynul)
+ *anynul = 0;
+
+ if (nultyp == 2)
+ memset(nularray, 0, (size_t) nelem); /* initialize nullarray */
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (elemincre < 0)
+ readcheck = -1; /* don't do range checking in this case */
+
+ if ( ffgcprll( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 )
+ return(*status);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ convert = 1;
+ if (tcode == TDOUBLE) /* Special Case: */
+ { /* no type convertion required, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+
+ if (nulcheck == 0 && scale == 1. && zero == 0.)
+ convert = 0; /* no need to scale data or find nulls */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer or to the number of pixels that remain in
+ the current vector, which ever is smaller.
+ */
+ ntodo = (long) minvalue(remain, maxelem);
+ if (elemincre >= 0)
+ {
+ ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
+ }
+ else
+ {
+ ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
+ }
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, &array[next], status);
+ if (convert)
+ fffr8r8(&array[next], ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
+ status);
+ fffi1r8((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status);
+ fffi2r8((short *) buffer, ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
+ status);
+ fffi4r8((INT32BIT *) buffer, ntodo, scale, zero, nulcheck,
+ (INT32BIT) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONGLONG):
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8r8( (LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4r8((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ fffstrr8((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read numbers from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgcld).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgcld).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = (long) (elemnum / repeat);
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ else if (elemnum < 0) /* completed a row; start on a previous row */
+ {
+ rowincre = (long) ((-elemnum - 1) / repeat + 1);
+ rownum -= rowincre;
+ elemnum = (rowincre * repeat) + elemnum;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1r8(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (double) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2r8(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (double) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4r8(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (double) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8r8(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (double) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4r8(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (double) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = zero;
+ }
+ else
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8r8(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ memcpy(output, input, ntodo * sizeof(double) );
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ {
+ nullarray[ii] = 1;
+ /* explicitly set value in case output contains a NaN */
+ output[ii] = DOUBLENULLVALUE;
+ }
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ {
+ nullarray[ii] = 1;
+ /* explicitly set value in case output contains a NaN */
+ output[ii] = DOUBLENULLVALUE;
+ }
+ }
+ else /* it's an underflow */
+ output[ii] = zero;
+ }
+ else
+ output[ii] = input[ii] * scale + zero;
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstrr8(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1; /* set flag to show there was a decimal point */
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ output[ii] = (dvalue * scale + zero); /* apply the scaling */
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getcole.c b/src/plugins/cfitsio/getcole.c
new file mode 100644
index 0000000..441c657
--- /dev/null
+++ b/src/plugins/cfitsio/getcole.c
@@ -0,0 +1,1679 @@
+/* This file, getcole.c, contains routines that read data elements from */
+/* a FITS image or table, with float 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpve( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ float nulval, /* I - value for undefined pixels */
+ float *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ float nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TFLOAT, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcle(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfe( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ float *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TFLOAT, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcle(fptr, 2, row, firstelem, nelem, 1, 2, 0.F,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2de(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ float nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ float *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3de(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3de(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ float nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ float *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ LONGLONG narray, nfits;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1};
+ LONGLONG lpixel[3];
+ float nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TFLOAT, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgcle(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgcle(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsve(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ float nulval, /* I - value to set undefined pixels */
+ float *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dir[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ float nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsve is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TFLOAT, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ dir[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ if (hdutype == IMAGE_HDU)
+ {
+ dir[ii] = -1;
+ }
+ else
+ {
+ sprintf(msg, "ffgsve: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ dsize[ii] = dsize[ii] * dir[ii];
+ }
+ dsize[naxis] = dsize[naxis] * dir[naxis];
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
+ ninc = incr[0] * dir[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
+ {
+
+ felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
+ (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
+ (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
+ (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
+
+ if ( ffgcle(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfe(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ float *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ int hdutype, anyf;
+ float nulval = 0;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsve is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TFLOAT, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsve: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgcle(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpe( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ float *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcle(fptr, 1, row, firstelem, nelem, 1, 1, 0.F,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcve(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 */
+ float nulval, /* I - value for null pixels */
+ float *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvc(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 */
+ float nulval, /* I - value for null pixels */
+ float *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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.
+
+ TSCAL and ZERO should not be used with complex values.
+*/
+{
+ char cdummy;
+
+ /* a complex value is interpreted as a pair of float values, thus */
+ /* need to multiply the first element and number of elements by 2 */
+
+ ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem *2,
+ 1, 1, nulval, array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfe(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 */
+ float *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ float dummy = 0;
+
+ ffgcle(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfc(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 */
+ float *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+
+ TSCAL and ZERO should not be used with complex values.
+*/
+{
+ long ii, jj;
+ float dummy = 0;
+ char *carray;
+
+ /* a complex value is interpreted as a pair of float values, thus */
+ /* need to multiply the first element and number of elements by 2 */
+
+ /* allocate temporary array */
+ carray = (char *) calloc( (size_t) (nelem * 2), 1);
+
+ ffgcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ 1, 2, dummy, array, carray, anynul, status);
+
+ for (ii = 0, jj = 0; jj < nelem; ii += 2, jj++)
+ {
+ if (carray[ii] || carray[ii + 1])
+ nularray[jj] = 1;
+ else
+ nularray[jj] = 0;
+ }
+
+ free(carray);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcle( 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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ float nulval, /* I - value for null pixels if nultyp = 1 */
+ float *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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1., dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int convert, nulcheck, readcheck = 0;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ if (anynul)
+ *anynul = 0;
+
+ if (nultyp == 2)
+ memset(nularray, 0, (size_t) nelem); /* initialize nullarray */
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (elemincre < 0)
+ readcheck = -1; /* don't do range checking in this case */
+
+ if ( ffgcprll( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 )
+ return(*status);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ convert = 1;
+ if (tcode == TFLOAT) /* Special Case: */
+ { /* no type convertion required, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+
+ if (nulcheck == 0 && scale == 1. && zero == 0.)
+ convert = 0; /* no need to scale data or find nulls */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer or to the number of pixels that remain in
+ the current vector, which ever is smaller.
+ */
+ ntodo = (long) minvalue(remain, maxelem);
+ if (elemincre >= 0)
+ {
+ ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
+ }
+ else
+ {
+ ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
+ }
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, &array[next], status);
+ if (convert)
+ fffr4r4(&array[next], ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
+ status);
+ fffi1r4((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status);
+ fffi2r4((short *) buffer, ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
+ status);
+ fffi4r4((INT32BIT *) buffer, ntodo, scale, zero, nulcheck,
+ (INT32BIT) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ case (TLONGLONG):
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8r4( (LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8r4((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ fffstrr4((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read numbers from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgcle).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgcle).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ else if (elemnum < 0) /* completed a row; start on a previous row */
+ {
+ rowincre = (-elemnum - 1) / repeat + 1;
+ rownum -= rowincre;
+ elemnum = (rowincre * repeat) + elemnum;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1r4(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (float) (( (double) input[ii] ) * scale + zero);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (float) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (float) (( (double) input[ii] ) * scale + zero);
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2r4(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (float) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4r4(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (float) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8r4(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (float) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4r4(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ memcpy(output, input, ntodo * sizeof(float) );
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ {
+ nullarray[ii] = 1;
+ /* explicitly set value in case output contains a NaN */
+ output[ii] = FLOATNULLVALUE;
+ }
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ {
+ nullarray[ii] = 1;
+ /* explicitly set value in case output contains a NaN */
+ output[ii] = FLOATNULLVALUE;
+ }
+ }
+ else /* it's an underflow */
+ output[ii] = (float) zero;
+ }
+ else
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8r4(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (float) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = (float) zero;
+ }
+ else
+ output[ii] = (float) (input[ii] * scale + zero);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstrr4(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1; /* set flag to show there was a decimal point */
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ output[ii] = (float) (dvalue * scale + zero); /* apply the scaling */
+
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getcoli.c b/src/plugins/cfitsio/getcoli.c
new file mode 100644
index 0000000..e3386e8
--- /dev/null
+++ b/src/plugins/cfitsio/getcoli.c
@@ -0,0 +1,1901 @@
+/* This file, getcoli.c, contains routines that read data elements from */
+/* a FITS image or table, with short 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpvi( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ short nulval, /* I - value for undefined pixels */
+ short *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ short nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+ fits_read_compressed_pixels(fptr, TSHORT, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcli(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfi( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ short *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TSHORT, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcli(fptr, 2, row, firstelem, nelem, 1, 2, 0,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2di(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ short nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ short *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3di(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3di(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ short nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ short *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ LONGLONG nfits, narray;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1};
+ LONGLONG lpixel[3];
+ short nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TSHORT, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgcli(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgcli(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvi(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ short nulval, /* I - value to set undefined pixels */
+ short *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dir[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ short nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvi is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TSHORT, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ dir[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ if (hdutype == IMAGE_HDU)
+ {
+ dir[ii] = -1;
+ }
+ else
+ {
+ sprintf(msg, "ffgsvi: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ dsize[ii] = dsize[ii] * dir[ii];
+ }
+ dsize[naxis] = dsize[naxis] * dir[naxis];
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
+ ninc = incr[0] * dir[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
+ {
+
+ felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
+ (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
+ (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
+ (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
+
+ if ( ffgcli(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfi(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ short *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ int hdutype, anyf;
+ short nulval = 0;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvi is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TSHORT, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvi: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgcli(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpi( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ short *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcli(fptr, 1, row, firstelem, nelem, 1, 1, 0,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvi(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 */
+ short nulval, /* I - value for null pixels */
+ short *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfi(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 */
+ short *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ short dummy = 0;
+
+ ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcli( 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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ short nulval, /* I - value for null pixels if nultyp = 1 */
+ short *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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1., dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int convert, nulcheck, readcheck = 0;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ if (anynul)
+ *anynul = 0;
+
+ if (nultyp == 2)
+ memset(nularray, 0, (size_t) nelem); /* initialize nullarray */
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (elemincre < 0)
+ readcheck = -1; /* don't do range checking in this case */
+
+ if ( ffgcprll( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 )
+ return(*status);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ convert = 1;
+ if (tcode == TSHORT) /* Special Case: */
+ { /* no type convertion required, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+
+ if (nulcheck == 0 && scale == 1. && zero == 0.)
+ convert = 0; /* no need to scale data or find nulls */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer or to the number of pixels that remain in
+ the current vector, which ever is smaller.
+ */
+ ntodo = (long) minvalue(remain, maxelem);
+ if (elemincre >= 0)
+ {
+ ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
+ }
+ else
+ {
+ ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
+ }
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, &array[next], status);
+ if (convert)
+ fffi2i2(&array[next], ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONGLONG):
+
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8i2( (LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
+ status);
+ fffi1i2((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
+ status);
+ fffi4i2((INT32BIT *) buffer, ntodo, scale, zero, nulcheck,
+ (INT32BIT) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4i2((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8i2((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ fffstri2((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read numbers from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgcli).",
+ dtemp+1, dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgcli).",
+ dtemp+1, dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ else if (elemnum < 0) /* completed a row; start on a previous row */
+ {
+ rowincre = (-elemnum - 1) / repeat + 1;
+ rownum -= rowincre;
+ elemnum = (rowincre * repeat) + elemnum;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1i2(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (short) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2i2(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ memcpy(output, input, ntodo * sizeof(short) );
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4i2(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < SHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < SHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8i2(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < SHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < SHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4i2(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (zero > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8i2(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (zero > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstri2(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1; /* set flag to show there was a decimal point */
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ dvalue = dvalue * scale + zero; /* apply the scaling */
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) dvalue;
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getcolj.c b/src/plugins/cfitsio/getcolj.c
new file mode 100644
index 0000000..2d90913
--- /dev/null
+++ b/src/plugins/cfitsio/getcolj.c
@@ -0,0 +1,3726 @@
+/* This file, getcolj.c, contains routines that read data elements from */
+/* a FITS image or table, with long data type. */
+
+/* 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpvj( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ long nulval, /* I - value for undefined pixels */
+ long *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ long nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TLONG, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclj(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfj( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ long *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TLONG, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclj(fptr, 2, row, firstelem, nelem, 1, 2, 0L,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2dj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ long *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3dj(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3dj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ long *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1}, nfits, narray;
+ LONGLONG lpixel[3], nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TLONG, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgclj(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgclj(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvj(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ long nulval, /* I - value to set undefined pixels */
+ long *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dir[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ long nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TLONG, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ dir[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ if (hdutype == IMAGE_HDU)
+ {
+ dir[ii] = -1;
+ }
+ else
+ {
+ sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ dsize[ii] = dsize[ii] * dir[ii];
+ }
+ dsize[naxis] = dsize[naxis] * dir[naxis];
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
+ ninc = incr[0] * dir[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
+ {
+
+ felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
+ (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
+ (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
+ (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
+
+ if ( ffgclj(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfj(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ long *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ long nulval = 0;
+ int hdutype, anyf;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TLONG, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgclj(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpj( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ long *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclj(fptr, 1, row, firstelem, nelem, 1, 1, 0L,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvj(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 */
+ long nulval, /* I - value for null pixels */
+ long *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfj(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 */
+ long *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ long dummy = 0;
+
+ ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgclj( 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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ long nulval, /* I - value for null pixels if nultyp = 1 */
+ long *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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1., dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int convert, nulcheck, readcheck = 0;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ if (anynul)
+ *anynul = 0;
+
+ if (nultyp == 2)
+ memset(nularray, 0, (size_t) nelem); /* initialize nullarray */
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (elemincre < 0)
+ readcheck = -1; /* don't do range checking in this case */
+
+ if (ffgcprll(fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 )
+ return(*status);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ convert = 1;
+ if (tcode == TLONG) /* Special Case: */
+ { /* no type convertion required, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+
+ if (nulcheck == 0 && scale == 1. && zero == 0. && LONGSIZE == 32)
+ convert = 0; /* no need to scale data or find nulls */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer or to the number of pixels that remain in
+ the current vector, which ever is smaller.
+ */
+ ntodo = (long) minvalue(remain, maxelem);
+ if (elemincre >= 0)
+ {
+ ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
+ }
+ else
+ {
+ ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
+ }
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) &array[next],
+ status);
+ if (convert)
+ fffi4i4((INT32BIT *) &array[next], ntodo, scale, zero,
+ nulcheck, (INT32BIT) tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TLONGLONG):
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8i4((LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
+ status);
+ fffi1i4((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status);
+ fffi2i4((short *) buffer, ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4i4((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8i4((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ fffstri4((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read numbers from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgclj).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgclj).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ else if (elemnum < 0) /* completed a row; start on a previous row */
+ {
+ rowincre = (-elemnum - 1) / repeat + 1;
+ rownum -= rowincre;
+ elemnum = (rowincre * repeat) + elemnum;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1i4(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (long) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2i4(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (long) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4i4(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+
+ Process the array of data in reverse order, to handle the case where
+ the input data is 4-bytes and the output is 8-bytes and the conversion
+ is being done in place in the same array.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ output[ii] = (long) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = input[ii];
+
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8i4(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < LONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (input[ii] > LONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < LONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (input[ii] > LONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4i4(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (input[ii] > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (input[ii] > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (zero > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8i4(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (input[ii] > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (input[ii] > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (zero > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstri4(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1; /* set flag to show there was a decimal point */
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ dvalue = dvalue * scale + zero; /* apply the scaling */
+
+ if (dvalue < DLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MIN;
+ }
+ else if (dvalue > DLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONG_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
+
+/* ======================================================================== */
+/* the following routines support the 'long long' data type */
+/* ======================================================================== */
+
+/*--------------------------------------------------------------------------*/
+int ffgpvjj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ LONGLONG nulval, /* I - value for undefined pixels */
+ LONGLONG *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ LONGLONG nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TLONGLONG, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcljj(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfjj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ LONGLONG *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+ LONGLONG dummy = 0;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TLONGLONG, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcljj(fptr, 2, row, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2djj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG nulval ,/* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG *array,/* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3djj(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3djj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ LONGLONG *array,/* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1}, nfits, narray;
+ LONGLONG lpixel[3];
+ LONGLONG nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TLONGLONG, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgcljj(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgcljj(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvjj(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ LONGLONG nulval,/* I - value to set undefined pixels */
+ LONGLONG *array,/* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dir[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ LONGLONG nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TLONGLONG, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ dir[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ if (hdutype == IMAGE_HDU)
+ {
+ dir[ii] = -1;
+ }
+ else
+ {
+ sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ dsize[ii] = dsize[ii] * dir[ii];
+ }
+ dsize[naxis] = dsize[naxis] * dir[naxis];
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
+ ninc = incr[0] * dir[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
+ {
+
+ felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
+ (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
+ (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
+ (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
+
+ if ( ffgcljj(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfjj(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ LONGLONG *array,/* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ LONGLONG nulval = 0;
+ int hdutype, anyf;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TLONGLONG, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgcljj(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpjj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ LONGLONG *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ LONGLONG dummy = 0;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcljj(fptr, 1, row, firstelem, nelem, 1, 1, dummy,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvjj(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 */
+ LONGLONG nulval, /* I - value for null pixels */
+ LONGLONG *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfjj(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 */
+ LONGLONG *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ LONGLONG dummy = 0;
+
+ ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcljj( 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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ LONGLONG nulval, /* I - value for null pixels if nultyp = 1 */
+ LONGLONG *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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1., dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int convert, nulcheck, readcheck = 0;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ if (anynul)
+ *anynul = 0;
+
+ if (nultyp == 2)
+ memset(nularray, 0, (size_t) nelem); /* initialize nullarray */
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (elemincre < 0)
+ readcheck = -1; /* don't do range checking in this case */
+
+ if (ffgcprll(fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 )
+ return(*status);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ convert = 1;
+ if (tcode == TLONGLONG) /* Special Case: */
+ { /* no type convertion required, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+
+ if (nulcheck == 0 && scale == 1. && zero == 0.)
+ convert = 0; /* no need to scale data or find nulls */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer or to the number of pixels that remain in
+ the current vector, which ever is smaller.
+ */
+ ntodo = (long) minvalue(remain, maxelem);
+ if (elemincre >= 0)
+ {
+ ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
+ }
+ else
+ {
+ ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
+ }
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TLONGLONG):
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) &array[next],
+ status);
+ if (convert)
+ fffi8i8((LONGLONG *) &array[next], ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
+ status);
+ fffi4i8((INT32BIT *) buffer, ntodo, scale, zero,
+ nulcheck, (INT32BIT) tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
+ status);
+ fffi1i8((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status);
+ fffi2i8((short *) buffer, ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4i8((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8i8((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ fffstri8((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read numbers from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgclj).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgclj).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ else if (elemnum < 0) /* completed a row; start on a previous row */
+ {
+ rowincre = (-elemnum - 1) / repeat + 1;
+ rownum -= rowincre;
+ elemnum = (rowincre * repeat) + elemnum;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1i8(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ LONGLONG *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (LONGLONG) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (LONGLONG) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2i8(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ LONGLONG *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (LONGLONG) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (LONGLONG) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4i8(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ LONGLONG *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (LONGLONG) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (LONGLONG) input[ii];
+
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8i8(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ LONGLONG *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = input[ii];
+
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4i8(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ LONGLONG *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (input[ii] > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (input[ii] > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (zero > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8i8(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ LONGLONG *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (input[ii] > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (input[ii] > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (zero > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstri8(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ LONGLONG nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ LONGLONG *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1; /* set flag to show there was a decimal point */
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ dvalue = dvalue * scale + zero; /* apply the scaling */
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) dvalue;
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getcolk.c b/src/plugins/cfitsio/getcolk.c
new file mode 100644
index 0000000..4b4447e
--- /dev/null
+++ b/src/plugins/cfitsio/getcolk.c
@@ -0,0 +1,1894 @@
+/* This file, getcolk.c, contains routines that read data elements from */
+/* a FITS image or table, with 'int' data type. */
+
+/* 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpvk( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ int nulval, /* I - value for undefined pixels */
+ int *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ int nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TINT, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclk(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfk( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ int *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TINT, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclk(fptr, 2, row, firstelem, nelem, 1, 2, 0L,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2dk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ int nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ int *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3dk(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3dk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ int nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ int *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1}, nfits, narray;
+ LONGLONG lpixel[3];
+ int nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TINT, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgclk(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgclk(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvk(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ int nulval, /* I - value to set undefined pixels */
+ int *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dir[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ int nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TINT, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ dir[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ if (hdutype == IMAGE_HDU)
+ {
+ dir[ii] = -1;
+ }
+ else
+ {
+ sprintf(msg, "ffgsvk: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ dsize[ii] = dsize[ii] * dir[ii];
+ }
+ dsize[naxis] = dsize[naxis] * dir[naxis];
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
+ ninc = incr[0] * dir[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
+ {
+
+ felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
+ (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
+ (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
+ (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
+
+ if ( ffgclk(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfk(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ int *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ long nulval = 0;
+ int hdutype, anyf;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TINT, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgclk(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpk( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ int *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclk(fptr, 1, row, firstelem, nelem, 1, 1, 0L,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvk(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 nulval, /* I - value for null pixels */
+ int *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfk(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 *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ int dummy = 0;
+
+ ffgclk(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgclk( 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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ int nulval, /* I - value for null pixels if nultyp = 1 */
+ int *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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power, dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int convert, nulcheck, readcheck = 0;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* call the 'short' or 'long' version of this routine, if possible */
+ if (sizeof(int) == sizeof(short))
+ ffgcli(fptr, colnum, firstrow, firstelem, nelem, elemincre, nultyp,
+ (short) nulval, (short *) array, nularray, anynul, status);
+ else if (sizeof(int) == sizeof(long))
+ ffgclj(fptr, colnum, firstrow, firstelem, nelem, elemincre, nultyp,
+ (long) nulval, (long *) array, nularray, anynul, status);
+ else
+ {
+ /*
+ This is a special case: sizeof(int) is not equal to sizeof(short) or
+ sizeof(long). This occurs on Alpha OSF systems where short = 2 bytes,
+ int = 4 bytes, and long = 8 bytes.
+ */
+
+ buffer = cbuff;
+ power = 1.;
+
+ if (anynul)
+ *anynul = 0;
+
+ if (nultyp == 2)
+ memset(nularray, 0, (size_t) nelem); /* initialize nullarray */
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (elemincre < 0)
+ readcheck = -1; /* don't do range checking in this case */
+
+ if ( ffgcprll( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 )
+ return(*status);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ convert = 1;
+ if (tcode == TLONG) /* Special Case: */
+ { /* no type convertion required, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+
+ if (nulcheck == 0 && scale == 1. && zero == 0.)
+ convert = 0; /* no need to scale data or find nulls */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer or to the number of pixels that remain in
+ the current vector, which ever is smaller.
+ */
+ ntodo = (long) minvalue(remain, maxelem);
+ if (elemincre >= 0)
+ {
+ ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
+ }
+ else
+ {
+ ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
+ }
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) &array[next],
+ status);
+ if (convert)
+ fffi4int((INT32BIT *) &array[next], ntodo, scale, zero,
+ nulcheck, (INT32BIT) tnull, nulval,
+ &nularray[next], anynul, &array[next], status);
+ break;
+ case (TLONGLONG):
+
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8int( (LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
+ status);
+ fffi1int((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status);
+ fffi2int((short *) buffer, ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4int((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8int((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ fffstrint((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read numbers from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgclk).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgclk).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ else if (elemnum < 0) /* completed a row; start on a previous row */
+ {
+ rowincre = (-elemnum - 1) / repeat + 1;
+ rownum -= rowincre;
+ elemnum = (rowincre * repeat) + elemnum;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ } /* end of DEC Alpha special case */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1int(unsigned char *input,/* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (int) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2int(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (int) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4int(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (int) input[ii]; /* copy input to output */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (int) input[ii];
+
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8int(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < INT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (input[ii] > INT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < INT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (input[ii] > INT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4int(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (input[ii] > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (input[ii] > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (zero > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8int(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (input[ii] > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (input[ii] > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (zero > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstrint(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1; /* set flag to show there was a decimal point */
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ dvalue = dvalue * scale + zero; /* apply the scaling */
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getcoll.c b/src/plugins/cfitsio/getcoll.c
new file mode 100644
index 0000000..427247d
--- /dev/null
+++ b/src/plugins/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);
+}
diff --git a/src/plugins/cfitsio/getcols.c b/src/plugins/cfitsio/getcols.c
new file mode 100644
index 0000000..7033d6c
--- /dev/null
+++ b/src/plugins/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);
+}
+
diff --git a/src/plugins/cfitsio/getcolsb.c b/src/plugins/cfitsio/getcolsb.c
new file mode 100644
index 0000000..f750681
--- /dev/null
+++ b/src/plugins/cfitsio/getcolsb.c
@@ -0,0 +1,1991 @@
+/* This file, getcolsb.c, contains routines that read data elements from */
+/* a FITS image or table, with signed char (signed byte) data type. */
+
+/* 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpvsb(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ signed char nulval, /* I - value for undefined pixels */
+ signed char *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ signed char nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TSBYTE, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclsb(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfsb(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ signed char *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TSBYTE, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclsb(fptr, 2, row, firstelem, nelem, 1, 2, 0,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2dsb(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ signed char nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ signed char *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3dsb(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3dsb(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ signed char nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ signed char *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ LONGLONG nfits, narray;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1};
+ LONGLONG lpixel[3];
+ signed char nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TSBYTE, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgclsb(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgclsb(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvsb(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ signed char nulval, /* I - value to set undefined pixels */
+ signed char *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii, i0, i1, i2, i3, i4, i5, i6, i7, i8, row, rstr, rstp, rinc;
+ long str[9], stp[9], incr[9], dir[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ signed char nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvsb is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TSBYTE, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ dir[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ if (hdutype == IMAGE_HDU)
+ {
+ dir[ii] = -1;
+ }
+ else
+ {
+ sprintf(msg, "ffgsvsb: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ dsize[ii] = dsize[ii] * dir[ii];
+ }
+ dsize[naxis] = dsize[naxis] * dir[naxis];
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
+ ninc = incr[0] * dir[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
+ {
+
+ felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
+ (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
+ (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
+ (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
+
+ if ( ffgclsb(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfsb(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ signed char *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ int hdutype, anyf;
+ signed char nulval = 0;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvsb is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TSBYTE, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvsb: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgclsb(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpsb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ signed char *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclsb(fptr, 1, row, firstelem, nelem, 1, 1, 0,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvsb(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 */
+ signed char nulval, /* I - value for null pixels */
+ signed 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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfsb(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 */
+ signed char *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ signed char dummy = 0;
+
+ ffgclsb(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgclsb(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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ signed char nulval, /* I - value for null pixels if nultyp = 1 */
+ signed 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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1., dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int nulcheck, readcheck = 0;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ union u_tag {
+ char charval;
+ signed char scharval;
+ } u;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ if (anynul)
+ *anynul = 0;
+
+ if (nultyp == 2)
+ memset(nularray, 0, (size_t) nelem); /* initialize nullarray */
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (elemincre < 0)
+ readcheck = -1; /* don't do range checking in this case */
+
+ ffgcprll( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status);
+
+ /* special case: read column of T/F logicals */
+ if (tcode == TLOGICAL && elemincre == 1)
+ {
+ u.scharval = nulval;
+ ffgcll(fptr, colnum, firstrow, firstelem, nelem, nultyp,
+ u.charval, (char *) array, nularray, anynul, status);
+
+ return(*status);
+ }
+
+ if (strchr(tform,'A') != NULL)
+ {
+ if (*status == BAD_ELEM_NUM)
+ {
+ /* ignore this error message */
+ *status = 0;
+ ffcmsg(); /* clear error stack */
+ }
+
+ /* interpret a 'A' ASCII column as a 'B' byte column ('8A' == '8B') */
+ /* This is an undocumented 'feature' in CFITSIO */
+
+ /* we have to reset some of the values returned by ffgcpr */
+
+ tcode = TBYTE;
+ incre = 1; /* each element is 1 byte wide */
+ repeat = twidth; /* total no. of chars in the col */
+ twidth = 1; /* width of each element */
+ scale = 1.0; /* no scaling */
+ zero = 0.0;
+ tnull = NULL_UNDEFINED; /* don't test for nulls */
+ maxelem = DBUFFSIZE;
+ }
+
+ if (*status > 0)
+ return(*status);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING && hdutype == ASCII_TBL) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer or to the number of pixels that remain in
+ the current vector, which ever is smaller.
+ */
+ ntodo = (long) minvalue(remain, maxelem);
+ if (elemincre >= 0)
+ {
+ ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
+ }
+ else
+ {
+ ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
+ }
+
+ readptr = startpos + (rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) &array[next], status);
+ fffi1s1((unsigned char *)&array[next], ntodo, scale, zero,
+ nulcheck, (unsigned char) tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status);
+ fffi2s1((short *) buffer, ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
+ status);
+ fffi4s1((INT32BIT *) buffer, ntodo, scale, zero, nulcheck,
+ (INT32BIT) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONGLONG):
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8s1( (LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4s1((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8s1((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ /* interpret the string as an ASCII formated number */
+ fffstrs1((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read bytes from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgclsb).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgclsb).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ else if (elemnum < 0) /* completed a row; start on a previous row */
+ {
+ rowincre = (-elemnum - 1) / repeat + 1;
+ rownum -= rowincre;
+ elemnum = (rowincre * repeat) + elemnum;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1s1(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ signed char nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ signed char *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == -128.)
+ {
+ /* Instead of subtracting 128, it is more efficient */
+ /* to just flip the sign bit with the XOR operator */
+
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ( *(signed char *) &input[ii] ) ^ 0x80;
+ }
+ else if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] > 127)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii]; /* copy input */
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == -128.)
+ {
+ /* Instead of subtracting 128, it is more efficient */
+ /* to just flip the sign bit with the XOR operator */
+
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = ( *(signed char *) &input[ii] ) ^ 0x80;
+ }
+ }
+ else if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2s1(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ signed char nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ signed char *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < -128)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > 127)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+
+ else
+ {
+ if (input[ii] < -128)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > 127)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4s1(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ signed char nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ signed char *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < -128)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > 127)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < -128)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > 127)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8s1(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ signed char nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ signed char *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < -128)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > 127)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < -128)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > 127)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4s1(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ signed char nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ signed char *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ /* use redundant boolean logic in following statement */
+ /* to suppress irritating Borland compiler warning message */
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (zero > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8s1(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ signed char nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ signed char *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (input[ii] > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (zero > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstrs1(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ signed char nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ signed char *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1;
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ dvalue = dvalue * scale + zero; /* apply the scaling */
+
+ if (dvalue < DSCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = -128;
+ }
+ else if (dvalue > DSCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 127;
+ }
+ else
+ output[ii] = (signed char) dvalue;
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getcolui.c b/src/plugins/cfitsio/getcolui.c
new file mode 100644
index 0000000..6de4efc
--- /dev/null
+++ b/src/plugins/cfitsio/getcolui.c
@@ -0,0 +1,1907 @@
+/* This file, getcolui.c, contains routines that read data elements from */
+/* a FITS image or table, with unsigned short 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpvui( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ unsigned short nulval, /* I - value for undefined pixels */
+ unsigned short *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ unsigned short nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TUSHORT, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclui(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfui( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ unsigned short *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TUSHORT, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclui(fptr, 2, row, firstelem, nelem, 1, 2, 0,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2dui(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ unsigned short nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ unsigned short *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3dui(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3dui(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ unsigned short nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ unsigned short *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1}, nfits, narray;
+ LONGLONG lpixel[3];
+ unsigned short nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TUSHORT, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgclui(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgclui(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvui(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ unsigned short nulval, /* I - value to set undefined pixels */
+ unsigned short *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ unsigned short nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvui is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TUSHORT, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvui: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+ if ( ffgclui(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfui(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ unsigned short *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ int hdutype, anyf;
+ unsigned short nulval = 0;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvi is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TUSHORT, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvi: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgclui(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpui( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ unsigned short *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgclui(fptr, 1, row, firstelem, nelem, 1, 1, 0,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvui(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 */
+ unsigned short nulval, /* I - value for null pixels */
+ unsigned short *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfui(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 */
+ unsigned short *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ unsigned short dummy = 0;
+
+ ffgclui(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgclui( 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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ unsigned short nulval, /* I - value for null pixels if nultyp = 1 */
+ unsigned short *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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1., dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int nulcheck;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ 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);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ if (tcode == TSHORT) /* Special Case: */
+ { /* no type convertion required, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer 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 - 1)/elemincre +1));
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre,
+ (short *) &array[next], status);
+ fffi2u2((short *) &array[next], ntodo, scale,
+ zero, nulcheck, (short) tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TLONGLONG):
+
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8u2( (LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
+ status);
+ fffi1u2((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
+ status);
+ fffi4u2((INT32BIT *) buffer, ntodo, scale, zero, nulcheck,
+ (INT32BIT) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4u2((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8u2((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ fffstru2((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read numbers from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgclui).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgclui).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1u2(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (unsigned short) input[ii]; /* copy input */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (unsigned short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2u2(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 32768.)
+ {
+ /* Instead of adding 32768, it is more efficient */
+ /* to just flip the sign bit with the XOR operator */
+
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ( *(unsigned short *) &input[ii] ) ^ 0x8000;
+ }
+ else if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned short) input[ii]; /* copy input */
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 32768.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = ( *(unsigned short *) &input[ii] ) ^ 0x8000;
+ }
+ }
+ else if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned short) input[ii]; /* copy input */
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4u2(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > USHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > USHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8u2(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > USHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > USHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4u2(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (zero > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8u2(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (zero > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstru2(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ unsigned short nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned short *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1; /* set flag to show there was a decimal point */
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ dvalue = dvalue * scale + zero; /* apply the scaling */
+
+ if (dvalue < DUSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = USHRT_MAX;
+ }
+ else
+ output[ii] = (unsigned short) dvalue;
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getcoluj.c b/src/plugins/cfitsio/getcoluj.c
new file mode 100644
index 0000000..bb69134
--- /dev/null
+++ b/src/plugins/cfitsio/getcoluj.c
@@ -0,0 +1,1901 @@
+/* This file, getcoluj.c, contains routines that read data elements from */
+/* a FITS image or table, with unsigned long data type. */
+
+/* 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpvuj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ unsigned long nulval, /* I - value for undefined pixels */
+ unsigned long *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ unsigned long nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TULONG, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcluj(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfuj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ unsigned long *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TULONG, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcluj(fptr, 2, row, firstelem, nelem, 1, 2, 0L,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2duj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ unsigned long nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ unsigned long *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3duj(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3duj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ unsigned long nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ unsigned long *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1}, nfits, narray;
+ LONGLONG lpixel[3];
+ unsigned long nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TULONG, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgcluj(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgcluj(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvuj(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ unsigned long nulval, /* I - value to set undefined pixels */
+ unsigned long *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ unsigned long nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvuj is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TULONG, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvuj: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgcluj(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfuj(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ unsigned long *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ unsigned long nulval = 0;
+ int hdutype, anyf;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TULONG, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgcluj(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpuj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ unsigned long *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcluj(fptr, 1, row, firstelem, nelem, 1, 1, 0L,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvuj(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 */
+ unsigned long nulval, /* I - value for null pixels */
+ unsigned long *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfuj(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 */
+ unsigned long *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ unsigned long dummy = 0;
+
+ ffgcluj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcluj(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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ unsigned long nulval, /* I - value for null pixels if nultyp = 1 */
+ unsigned long *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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1., dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int nulcheck;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ 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);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ if (tcode == TLONG) /* Special Case: */
+ { /* no type convertion required, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer 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 - 1)/elemincre +1));
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) &array[next],
+ status);
+ fffi4u4((INT32BIT *) &array[next], ntodo, scale, zero,
+ nulcheck, (INT32BIT) tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TLONGLONG):
+
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8u4( (LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
+ status);
+ fffi1u4((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status);
+ fffi2u4((short *) buffer, ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4u4((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8u4((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ fffstru4((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read numbers from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgcluj).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgcluj).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1u4(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (unsigned long) input[ii]; /* copy input */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (unsigned long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2u4(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned long) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4u4(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+
+ Process the array of data in reverse order, to handle the case where
+ the input data is 4-bytes and the output is 8-bytes and the conversion
+ is being done in place in the same array.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 2147483648.)
+ {
+ /* Instead of adding 2147483648, it is more efficient */
+ /* to just flip the sign bit with the XOR operator */
+
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ output[ii] = ( *(unsigned int *) &input[ii] ) ^ 0x80000000;
+ }
+ else if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned long) input[ii]; /* copy input */
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 2147483648.)
+ {
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = ( *(unsigned int *) &input[ii] ) ^ 0x80000000;
+ }
+ }
+ else if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned long) input[ii]; /* copy input */
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = ntodo - 1; ii >= 0; ii--)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8u4(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > ULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > ULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4u4(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (zero > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8u4(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (zero > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstru4(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ unsigned long nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned long *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1; /* set flag to show there was a decimal point */
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ dvalue = dvalue * scale + zero; /* apply the scaling */
+
+ if (dvalue < DULONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DULONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = ULONG_MAX;
+ }
+ else
+ output[ii] = (unsigned long) dvalue;
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getcoluk.c b/src/plugins/cfitsio/getcoluk.c
new file mode 100644
index 0000000..36d32e0
--- /dev/null
+++ b/src/plugins/cfitsio/getcoluk.c
@@ -0,0 +1,1916 @@
+/* This file, getcolk.c, contains routines that read data elements from */
+/* a FITS image or table, with 'unsigned int' data type. */
+
+/* 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 <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffgpvuk( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ unsigned int nulval, /* I - value for undefined pixels */
+ unsigned int *array, /* O - array of values that are returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Undefined elements will be set equal to NULVAL, unless NULVAL=0
+ in which case no checking for undefined values will be performed.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ char cdummy;
+ int nullcheck = 1;
+ unsigned int nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_pixels(fptr, TUINT, firstelem, nelem,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcluk(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgpfuk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to read (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to read */
+ unsigned int *array, /* O - array of values that are returned */
+ char *nularray, /* O - array of null pixel flags */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+ Any undefined pixels in the returned array will be set = 0 and the
+ corresponding nularray value will be set = 1.
+ ANYNUL is returned with a value of .true. if any pixels are undefined.
+*/
+{
+ long row;
+ int nullcheck = 2;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_read_compressed_pixels(fptr, TUINT, firstelem, nelem,
+ nullcheck, NULL, array, nularray, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcluk(fptr, 2, row, firstelem, nelem, 1, 2, 0L,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg2duk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ unsigned int nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ unsigned int *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ /* call the 3D reading routine, with the 3rd dimension = 1 */
+
+ ffg3duk(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
+ anynul, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffg3duk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ unsigned int nulval, /* set undefined pixels equal to this */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ unsigned int *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an entire 3-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being read). Any null
+ values in the array will be set equal to the value of nulval, unless
+ nulval = 0 in which case no null checking will be performed.
+*/
+{
+ long tablerow, ii, jj;
+ char cdummy;
+ int nullcheck = 1;
+ long inc[] = {1,1,1};
+ LONGLONG fpixel[] = {1,1,1}, nfits, narray;
+ LONGLONG lpixel[3];
+ unsigned int nullvalue;
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ lpixel[0] = ncols;
+ lpixel[1] = nrows;
+ lpixel[2] = naxis3;
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TUINT, fpixel, lpixel, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so read all at once */
+ ffgcluk(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to read */
+ narray = 0; /* next pixel in output array to be filled */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* reading naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffgcluk(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
+ &array[narray], &cdummy, anynul, status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsvuk(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ unsigned int nulval, /* I - value to set undefined pixels */
+ unsigned int *array, /* O - array to be filled and returned */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9];
+ long nelem, nultyp, ninc, numcol;
+ LONGLONG felem, dsize[10], blcll[9], trcll[9];
+ int hdutype, anyf;
+ char ldummy, msg[FLEN_ERRMSG];
+ int nullcheck = 1;
+ unsigned int nullvalue;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvuk is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ nullvalue = nulval; /* set local variable */
+
+ fits_read_compressed_img(fptr, TUINT, blcll, trcll, inc,
+ nullcheck, &nullvalue, array, NULL, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 1;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvuk: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgcluk(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &ldummy, &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsfuk(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read (1 = 1st) */
+ int naxis, /* I - number of dimensions in the FITS array */
+ long *naxes, /* I - size of each dimension */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc, /* I - 'top right corner' of the subsection */
+ long *inc, /* I - increment to be applied in each dimension */
+ unsigned int *array, /* O - array to be filled and returned */
+ char *flagval, /* O - set to 1 if corresponding value is null */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a subsection of data values from an image or a table column.
+ This routine is set up to handle a maximum of nine dimensions.
+*/
+{
+ long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
+ long str[9],stp[9],incr[9],dsize[10];
+ LONGLONG blcll[9], trcll[9];
+ long felem, nelem, nultyp, ninc, numcol;
+ long nulval = 0;
+ int hdutype, anyf;
+ char msg[FLEN_ERRMSG];
+ int nullcheck = 2;
+
+ if (naxis < 1 || naxis > 9)
+ {
+ sprintf(msg, "NAXIS = %d in call to ffgsvj is out of range", naxis);
+ ffpmsg(msg);
+ return(*status = BAD_DIMEN);
+ }
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ for (ii=0; ii < naxis; ii++) {
+ blcll[ii] = blc[ii];
+ trcll[ii] = trc[ii];
+ }
+
+ fits_read_compressed_img(fptr, TUINT, blcll, trcll, inc,
+ nullcheck, NULL, array, flagval, anynul, status);
+ return(*status);
+ }
+
+/*
+ if this is a primary array, then the input COLNUM parameter should
+ be interpreted as the row number, and we will alway read the image
+ data from column 2 (any group parameters are in column 1).
+*/
+ if (ffghdt(fptr, &hdutype, status) > 0)
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ {
+ /* this is a primary array, or image extension */
+ if (colnum == 0)
+ {
+ rstr = 1;
+ rstp = 1;
+ }
+ else
+ {
+ rstr = colnum;
+ rstp = colnum;
+ }
+ rinc = 1;
+ numcol = 2;
+ }
+ else
+ {
+ /* this is a table, so the row info is in the (naxis+1) elements */
+ rstr = blc[naxis];
+ rstp = trc[naxis];
+ rinc = inc[naxis];
+ numcol = colnum;
+ }
+
+ nultyp = 2;
+ if (anynul)
+ *anynul = FALSE;
+
+ i0 = 0;
+ for (ii = 0; ii < 9; ii++)
+ {
+ str[ii] = 1;
+ stp[ii] = 1;
+ incr[ii] = 1;
+ dsize[ii] = 1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (trc[ii] < blc[ii])
+ {
+ sprintf(msg, "ffgsvj: illegal range specified for axis %ld", ii + 1);
+ ffpmsg(msg);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ str[ii] = blc[ii];
+ stp[ii] = trc[ii];
+ incr[ii] = inc[ii];
+ dsize[ii + 1] = dsize[ii] * naxes[ii];
+ }
+
+ if (naxis == 1 && naxes[0] == 1)
+ {
+ /* This is not a vector column, so read all the rows at once */
+ nelem = (rstp - rstr) / rinc + 1;
+ ninc = rinc;
+ rstp = rstr;
+ }
+ else
+ {
+ /* have to read each row individually, in all dimensions */
+ nelem = (stp[0] - str[0]) / inc[0] + 1;
+ ninc = incr[0];
+ }
+
+ for (row = rstr; row <= rstp; row += rinc)
+ {
+ for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
+ {
+ for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
+ {
+ for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
+ {
+ for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
+ {
+ for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
+ {
+ for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
+ {
+ for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
+ {
+ for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
+ {
+ felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
+ (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
+ (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
+ (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
+
+ if ( ffgcluk(fptr, numcol, row, felem, nelem, ninc, nultyp,
+ nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
+ return(*status);
+
+ if (anyf && anynul)
+ *anynul = TRUE;
+
+ i0 += nelem;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffggpuk( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to read (1 = 1st group) */
+ long firstelem, /* I - first vector element to read (1 = 1st) */
+ long nelem, /* I - number of values to read */
+ unsigned int *array, /* O - array of values that are returned */
+ int *status) /* IO - error status */
+/*
+ Read an array of group parameters from the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being read).
+*/
+{
+ long row;
+ int idummy;
+ char cdummy;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffgcluk(fptr, 1, row, firstelem, nelem, 1, 1, 0L,
+ array, &cdummy, &idummy, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcvuk(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 */
+ unsigned int nulval, /* I - value for null pixels */
+ unsigned int *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 values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ 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;
+
+ ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
+ array, &cdummy, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcfuk(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 */
+ unsigned int *array, /* O - array of values that are read */
+ char *nularray, /* O - array of flags: 1 if null pixel; else 0 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read an array of values from a column in the current FITS HDU. Automatic
+ datatype conversion will be performed if the datatype of the column does not
+ match the datatype of the array parameter. The output values will be scaled
+ by the FITS TSCALn and TZEROn values if these values have been defined.
+ Nularray will be set = 1 if the corresponding array pixel is undefined,
+ otherwise nularray will = 0.
+*/
+{
+ int dummy = 0;
+
+ ffgcluk(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
+ array, nularray, anynul, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcluk( 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 */
+ long elemincre, /* I - pixel increment; e.g., 2 = every other */
+ int nultyp, /* I - null value handling code: */
+ /* 1: set undefined pixels = nulval */
+ /* 2: set nularray=1 for undefined pixels */
+ unsigned int nulval, /* I - value for null pixels if nultyp = 1 */
+ unsigned int *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 values from a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer be a virtual column in a 1 or more grouped FITS primary
+ array or image extension. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The output array of values will be converted from the datatype of the column
+ and will be scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ double scale, zero, power = 1., dtemp;
+ int tcode, maxelem, hdutype, xcode, decimals;
+ long twidth, incre;
+ long ii, xwidth, ntodo;
+ int nulcheck;
+ LONGLONG repeat, startpos, elemnum, readptr, tnull;
+ LONGLONG rowlen, rownum, remain, next, rowincre;
+ char tform[20];
+ char message[81];
+ char snull[20]; /* the FITS null value if reading from ASCII table */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0 || nelem == 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* call the 'short' or 'long' version of this routine, if possible */
+ if (sizeof(int) == sizeof(short))
+ ffgclui(fptr, colnum, firstrow, firstelem, nelem, elemincre, nultyp,
+ (unsigned short) nulval, (unsigned short *) array, nularray, anynul,
+ status);
+ else if (sizeof(int) == sizeof(long))
+ ffgcluj(fptr, colnum, firstrow, firstelem, nelem, elemincre, nultyp,
+ (unsigned long) nulval, (unsigned long *) array, nularray, anynul,
+ status);
+ else
+ {
+ /*
+ This is a special case: sizeof(int) is not equal to sizeof(short) or
+ sizeof(long). This occurs on Alpha OSF systems where short = 2 bytes,
+ int = 4 bytes, and long = 8 bytes.
+ */
+
+ buffer = cbuff;
+
+ 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);
+
+ incre *= elemincre; /* multiply incre to just get every nth pixel */
+
+ if (tcode == TSTRING) /* setup for ASCII tables */
+ {
+ /* get the number of implied decimal places if no explicit decmal point */
+ ffasfm(tform, &xcode, &xwidth, &decimals, status);
+ for(ii = 0; ii < decimals; ii++)
+ power *= 10.;
+ }
+ /*------------------------------------------------------------------*/
+ /* 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 (tcode%10 == 1 && /* if reading an integer column, and */
+ tnull == NULL_UNDEFINED) /* if a null value is not defined, */
+ nulcheck = 0; /* then do not check for null values. */
+
+ else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
+ nulcheck = 0; /* Impossible null value */
+
+ else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
+ nulcheck = 0;
+
+ /*----------------------------------------------------------------------*/
+ /* If FITS column and output data array have same datatype, then we do */
+ /* not need to use a temporary buffer to store intermediate datatype. */
+ /*----------------------------------------------------------------------*/
+ if (tcode == TLONG) /* Special Case: */
+ { /* data are 4-bytes long, so read */
+ maxelem = (int) nelem; /* data directly into output buffer. */
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now read the pixels from the FITS column. If the column does not */
+ /* have the same datatype as the output array, then we have to read */
+ /* the raw values into a temporary buffer (of limited size). In */
+ /* the case of a vector colum read only 1 vector of values at a time */
+ /* then skip to the next row if more values need to be read. */
+ /* After reading the raw values, then call the fffXXYY routine to (1) */
+ /* test for undefined values, (2) convert the datatype if necessary, */
+ /* and (3) scale the values by the FITS TSCALn and TZEROn linear */
+ /* scaling parameters. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to read */
+ next = 0; /* next element in array to be read */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to read at one time to the number that
+ will fit in the buffer 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 - 1)/elemincre +1));
+
+ readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
+
+ switch (tcode)
+ {
+ case (TLONG):
+ ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) &array[next],
+ status);
+ fffi4uint((INT32BIT *) &array[next], ntodo, scale, zero,
+ nulcheck, (INT32BIT) tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TLONGLONG):
+
+ ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
+ fffi8uint( (LONGLONG *) buffer, ntodo, scale, zero,
+ nulcheck, tnull, nulval, &nularray[next],
+ anynul, &array[next], status);
+ break;
+ case (TBYTE):
+ ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
+ status);
+ fffi1uint((unsigned char *) buffer, ntodo, scale, zero,nulcheck,
+ (unsigned char) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSHORT):
+ ffgi2b(fptr, readptr, ntodo, incre, (short *) buffer, status);
+ fffi2uint((short *) buffer, ntodo, scale, zero, nulcheck,
+ (short) tnull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TFLOAT):
+ ffgr4b(fptr, readptr, ntodo, incre, (float *) buffer, status);
+ fffr4uint((float *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TDOUBLE):
+ ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
+ fffr8uint((double *) buffer, ntodo, scale, zero, nulcheck,
+ nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+ case (TSTRING):
+ ffmbyt(fptr, readptr, REPORT_EOF, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffgbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ fffstruint((char *) buffer, ntodo, scale, zero, twidth, power,
+ nulcheck, snull, nulval, &nularray[next], anynul,
+ &array[next], status);
+ break;
+
+ default: /* error trap for invalid column format */
+ sprintf(message,
+ "Cannot read numbers from column %d which has format %s",
+ colnum, tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous read operation */
+ {
+ dtemp = (double) next;
+ if (hdutype > 0)
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from column %d (ffgcluk).",
+ dtemp+1., dtemp+ntodo, colnum);
+ else
+ sprintf(message,
+ "Error reading elements %.0f thru %.0f from image (ffgcluk).",
+ dtemp+1., dtemp+ntodo);
+
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum = elemnum + (ntodo * elemincre);
+
+ if (elemnum >= repeat) /* completed a row; start on later row */
+ {
+ rowincre = elemnum / repeat;
+ rownum += rowincre;
+ elemnum = elemnum - (rowincre * repeat);
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while reading FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ } /* end of DEC Alpha special case */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi1uint(unsigned char *input,/* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (unsigned int) input[ii]; /* copy input */
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi2uint(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi4uint(INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 2147483648.)
+ {
+ /* Instead of adding 2147483648, it is more efficient */
+ /* to just flip the sign bit with the XOR operator */
+
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ( *(unsigned int *) &input[ii] ) ^ 0x80000000;
+ }
+ else if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned int) input[ii]; /* copy to output */
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 2147483648.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ output[ii] = ( *(unsigned int *) &input[ii] ) ^ 0x80000000;
+ }
+ }
+ else if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffi8uint(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ LONGLONG tnull, /* I - value of FITS TNULLn keyword if any */
+ unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to tnull. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr4uint(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr++; /* point to MSBs */
+#endif
+
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 2)
+ {
+ if (0 != (iret = fnan(*sptr) ) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (zero > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffr8uint(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file.
+ Check for null values and do datatype conversion and scaling if required.
+ The nullcheck code value determines how any null values in the input array
+ are treated. A null value is an input pixel that is equal to NaN. If
+ nullcheck = 0, then no checking for nulls is performed and any null values
+ will be transformed just like any other pixel. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ long ii;
+ double dvalue;
+ short *sptr, iret;
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ sptr = (short *) input;
+
+#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
+ sptr += 3; /* point to MSBs */
+#endif
+ if (scale == 1. && zero == 0.) /* no scaling */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ output[ii] = 0;
+ }
+ else
+ {
+ if (input[ii] < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) input[ii];
+ }
+ }
+ }
+ else /* must scale the data */
+ {
+ for (ii = 0; ii < ntodo; ii++, sptr += 4)
+ {
+ if (0 != (iret = dnan(*sptr)) ) /* test for NaN or underflow */
+ {
+ if (iret == 1) /* is it a NaN? */
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else /* it's an underflow */
+ {
+ if (zero < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (zero > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) zero;
+ }
+ }
+ else
+ {
+ dvalue = input[ii] * scale + zero;
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (unsigned int) dvalue;
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffstruint(char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ long twidth, /* I - width of each substring of chars */
+ double implipower, /* I - power of 10 of implied decimal */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ char *snull, /* I - value of FITS null string, if any */
+ unsigned int nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ unsigned int *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Copy input to output following reading of the input from a FITS file. Check
+ for null values and do scaling if required. The nullcheck code value
+ determines how any null values in the input array are treated. A null
+ value is an input pixel that is equal to snull. If nullcheck= 0, then
+ no special checking for nulls is performed. If nullcheck = 1, then the
+ output pixel will be set = nullval if the corresponding input pixel is null.
+ If nullcheck = 2, then if the pixel is null then the corresponding value of
+ nullarray will be set to 1; the value of nullarray for non-null pixels
+ will = 0. The anynull parameter will be set = 1 if any of the returned
+ pixels are null, otherwise anynull will be returned with a value = 0;
+*/
+{
+ int nullen;
+ long ii;
+ double dvalue;
+ char *cstring, message[81];
+ char *cptr, *tpos;
+ char tempstore, chrzero = '0';
+ double val, power;
+ int exponent, sign, esign, decpt;
+
+ nullen = strlen(snull);
+ cptr = input; /* pointer to start of input string */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ cstring = cptr;
+ /* temporarily insert a null terminator at end of the string */
+ tpos = cptr + twidth;
+ tempstore = *tpos;
+ *tpos = 0;
+
+ /* check if null value is defined, and if the */
+ /* column string is identical to the null string */
+ if (snull[0] != ASCII_NULL_UNDEFINED &&
+ !strncmp(snull, cptr, nullen) )
+ {
+ if (nullcheck)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ cptr += twidth;
+ }
+ else
+ {
+ /* value is not the null value, so decode it */
+ /* remove any embedded blank characters from the string */
+
+ decpt = 0;
+ sign = 1;
+ val = 0.;
+ power = 1.;
+ exponent = 0;
+ esign = 1;
+
+ while (*cptr == ' ') /* skip leading blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for leading sign */
+ {
+ if (*cptr == '-')
+ sign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and value */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+
+ if (*cptr == '.' || *cptr == ',') /* check for decimal point */
+ {
+ decpt = 1; /* set flag to show there was a decimal point */
+ cptr++;
+ while (*cptr == ' ') /* skip any blanks */
+ cptr++;
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ val = val * 10. + *cptr - chrzero; /* accumulate the value */
+ power = power * 10.;
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks in the value */
+ cptr++;
+ }
+ }
+
+ if (*cptr == 'E' || *cptr == 'D') /* check for exponent */
+ {
+ cptr++;
+ while (*cptr == ' ') /* skip blanks */
+ cptr++;
+
+ if (*cptr == '-' || *cptr == '+') /* check for exponent sign */
+ {
+ if (*cptr == '-')
+ esign = -1;
+
+ cptr++;
+
+ while (*cptr == ' ') /* skip blanks between sign and exp */
+ cptr++;
+ }
+
+ while (*cptr >= '0' && *cptr <= '9')
+ {
+ exponent = exponent * 10 + *cptr - chrzero; /* accumulate exp */
+ cptr++;
+
+ while (*cptr == ' ') /* skip embedded blanks */
+ cptr++;
+ }
+ }
+
+ if (*cptr != 0) /* should end up at the null terminator */
+ {
+ sprintf(message, "Cannot read number from ASCII table");
+ ffpmsg(message);
+ sprintf(message, "Column field = %s.", cstring);
+ ffpmsg(message);
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ return(*status = BAD_C2D);
+ }
+
+ if (!decpt) /* if no explicit decimal, use implied */
+ power = implipower;
+
+ dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
+
+ dvalue = dvalue * scale + zero; /* apply the scaling */
+
+ if (dvalue < DUINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UINT_MAX;
+ }
+ else
+ output[ii] = (long) dvalue;
+ }
+ /* restore the char that was overwritten by the null */
+ *tpos = tempstore;
+ }
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/getkey.c b/src/plugins/cfitsio/getkey.c
new file mode 100644
index 0000000..3184779
--- /dev/null
+++ b/src/plugins/cfitsio/getkey.c
@@ -0,0 +1,3241 @@
+/* This file, getkey.c, contains routines that read keywords from */
+/* a FITS header. */
+
+/* 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 <limits.h>
+#include <stdlib.h>
+#include <ctype.h>
+/* stddef.h is apparently needed to define size_t */
+#include <stddef.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffghsp(fitsfile *fptr, /* I - FITS file pointer */
+ int *nexist, /* O - number of existing keywords in header */
+ int *nmore, /* O - how many more keywords will fit */
+ int *status) /* IO - error status */
+/*
+ returns the number of existing keywords (not counting the END keyword)
+ and the number of more keyword that will fit in the current header
+ without having to insert more FITS blocks.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if (nexist)
+ *nexist = (int) (( ((fptr->Fptr)->headend) -
+ ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) ) / 80);
+
+ if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if (nmore)
+ *nmore = -1; /* data not written yet, so room for any keywords */
+ }
+ else
+ {
+ /* calculate space available between the data and the END card */
+ if (nmore)
+ *nmore = (int) (((fptr->Fptr)->datastart - (fptr->Fptr)->headend) / 80 - 1);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghps(fitsfile *fptr, /* I - FITS file pointer */
+ int *nexist, /* O - number of existing keywords in header */
+ int *position, /* O - position of next keyword to be read */
+ int *status) /* IO - error status */
+/*
+ return the number of existing keywords and the position of the next
+ keyword that will be read.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ *nexist = (int) (( ((fptr->Fptr)->headend) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) ) / 80);
+ *position = (int) (( ((fptr->Fptr)->nextkey) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) ) / 80 + 1);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffnchk(fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ function returns the position of the first null character (ASCII 0), if
+ any, in the current header. Null characters are illegal, but the other
+ CFITSIO routines that read the header will not detect this error, because
+ the null gets interpreted as a normal end of string character.
+*/
+{
+ long ii, nblock;
+ LONGLONG bytepos;
+ int length, nullpos;
+ char block[2881];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ return(0); /* Don't check a file that is just being created. */
+ /* It cannot contain nulls since CFITSIO wrote it. */
+ }
+ else
+ {
+ /* calculate number of blocks in the header */
+ nblock = (long) (( (fptr->Fptr)->datastart -
+ (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) / 2880);
+ }
+
+ bytepos = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu];
+ ffmbyt(fptr, bytepos, REPORT_EOF, status); /* move to read pos. */
+
+ block[2880] = '\0';
+ for (ii = 0; ii < nblock; ii++)
+ {
+ if (ffgbyt(fptr, 2880, block, status) > 0)
+ return(0); /* read error of some sort */
+
+ length = strlen(block);
+ if (length != 2880)
+ {
+ nullpos = (ii * 2880) + length + 1;
+ return(nullpos);
+ }
+ }
+
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int ffmaky(fitsfile *fptr, /* I - FITS file pointer */
+ int nrec, /* I - one-based keyword number to move to */
+ int *status) /* IO - error status */
+{
+/*
+ move pointer to the specified absolute keyword position. E.g. this keyword
+ will then be read by the next call to ffgnky.
+*/
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] + ( (nrec - 1) * 80);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmrky(fitsfile *fptr, /* I - FITS file pointer */
+ int nmove, /* I - relative number of keywords to move */
+ int *status) /* IO - error status */
+{
+/*
+ move pointer to the specified keyword position relative to the current
+ position. E.g. this keyword will then be read by the next call to ffgnky.
+*/
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ (fptr->Fptr)->nextkey += (nmove * 80);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgnky(fitsfile *fptr, /* I - FITS file pointer */
+ char *card, /* O - card string */
+ int *status) /* IO - error status */
+/*
+ read the next keyword from the header - used internally by cfitsio
+*/
+{
+ int jj, nrec;
+ LONGLONG bytepos, endhead;
+ char message[FLEN_ERRMSG];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ card[0] = '\0'; /* make sure card is terminated, even affer read error */
+
+/*
+ Check that nextkey points to a legal keyword position. Note that headend
+ is the current end of the header, i.e., the position where a new keyword
+ would be appended, however, if there are more than 1 FITS block worth of
+ blank keywords at the end of the header (36 keywords per 2880 byte block)
+ then the actual physical END card must be located at a starting position
+ which is just 2880 bytes prior to the start of the data unit.
+*/
+
+ bytepos = (fptr->Fptr)->nextkey;
+ endhead = maxvalue( ((fptr->Fptr)->headend), ((fptr->Fptr)->datastart - 2880) );
+
+ /* nextkey must be < endhead and > than headstart */
+ if (bytepos > endhead ||
+ bytepos < (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+ {
+ nrec= (int) ((bytepos - (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) / 80 + 1);
+ sprintf(message, "Cannot get keyword number %d. It does not exist.",
+ nrec);
+ ffpmsg(message);
+ return(*status = KEY_OUT_BOUNDS);
+ }
+
+ ffmbyt(fptr, bytepos, REPORT_EOF, status); /* move to read pos. */
+
+ card[80] = '\0'; /* make sure card is terminate, even if ffgbyt fails */
+
+ if (ffgbyt(fptr, 80, card, status) <= 0)
+ {
+ (fptr->Fptr)->nextkey += 80; /* increment pointer to next keyword */
+
+ /* strip off trailing blanks with terminated string */
+ jj = 79;
+ while (jj >= 0 && card[jj] == ' ')
+ jj--;
+
+ card[jj + 1] = '\0';
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgnxk( fitsfile *fptr, /* I - FITS file pointer */
+ char **inclist, /* I - list of included keyword names */
+ int ninc, /* I - number of names in inclist */
+ char **exclist, /* I - list of excluded keyword names */
+ int nexc, /* I - number of names in exclist */
+ char *card, /* O - first matching keyword */
+ int *status) /* IO - error status */
+/*
+ Return the next keyword that matches one of the names in inclist
+ but does not match any of the names in exclist. The search
+ goes from the current position to the end of the header, only.
+ Wild card characters may be used in the name lists ('*', '?' and '#').
+*/
+{
+ int casesn, match, exact, namelen;
+ long ii, jj;
+ char keybuf[FLEN_CARD], keyname[FLEN_KEYWORD];
+
+ card[0] = '\0';
+ if (*status > 0)
+ return(*status);
+
+ casesn = FALSE;
+
+ /* get next card, and return with an error if hit end of header */
+ while( ffgcrd(fptr, "*", keybuf, status) <= 0)
+ {
+ ffgknm(keybuf, keyname, &namelen, status); /* get the keyword name */
+
+ /* does keyword match any names in the include list? */
+ for (ii = 0; ii < ninc; ii++)
+ {
+ ffcmps(inclist[ii], keyname, casesn, &match, &exact);
+ if (match)
+ {
+ /* does keyword match any names in the exclusion list? */
+ jj = -1;
+ while ( ++jj < nexc )
+ {
+ ffcmps(exclist[jj], keyname, casesn, &match, &exact);
+ if (match)
+ break;
+ }
+
+ if (jj >= nexc)
+ {
+ /* not in exclusion list, so return this keyword */
+ strcat(card, keybuf);
+ return(*status);
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgky( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ const char *keyname, /* I - name of keyword to read */
+ void *value, /* O - keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the keyword value and comment from the FITS header.
+ Reads a keyword value with the datatype specified by the 2nd argument.
+*/
+{
+ long longval;
+ double doubleval;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (datatype == TSTRING)
+ {
+ ffgkys(fptr, keyname, (char *) value, comm, status);
+ }
+ else if (datatype == TBYTE)
+ {
+ if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0)
+ {
+ if (longval > UCHAR_MAX || longval < 0)
+ *status = NUM_OVERFLOW;
+ else
+ *(unsigned char *) value = (unsigned char) longval;
+ }
+ }
+ else if (datatype == TSBYTE)
+ {
+ if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0)
+ {
+ if (longval > 127 || longval < -128)
+ *status = NUM_OVERFLOW;
+ else
+ *(signed char *) value = (signed char) longval;
+ }
+ }
+ else if (datatype == TUSHORT)
+ {
+ if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0)
+ {
+ if (longval > (long) USHRT_MAX || longval < 0)
+ *status = NUM_OVERFLOW;
+ else
+ *(unsigned short *) value = (unsigned short) longval;
+ }
+ }
+ else if (datatype == TSHORT)
+ {
+ if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0)
+ {
+ if (longval > SHRT_MAX || longval < SHRT_MIN)
+ *status = NUM_OVERFLOW;
+ else
+ *(short *) value = (short) longval;
+ }
+ }
+ else if (datatype == TUINT)
+ {
+ if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0)
+ {
+ if (longval > (long) UINT_MAX || longval < 0)
+ *status = NUM_OVERFLOW;
+ else
+ *(unsigned int *) value = longval;
+ }
+ }
+ else if (datatype == TINT)
+ {
+ if (ffgkyj(fptr, keyname, &longval, comm, status) <= 0)
+ {
+ if (longval > INT_MAX || longval < INT_MIN)
+ *status = NUM_OVERFLOW;
+ else
+ *(int *) value = longval;
+ }
+ }
+ else if (datatype == TLOGICAL)
+ {
+ ffgkyl(fptr, keyname, (int *) value, comm, status);
+ }
+ else if (datatype == TULONG)
+ {
+ if (ffgkyd(fptr, keyname, &doubleval, comm, status) <= 0)
+ {
+ if (doubleval > (double) ULONG_MAX || doubleval < 0)
+ *status = NUM_OVERFLOW;
+ else
+ *(unsigned long *) value = (unsigned long) doubleval;
+ }
+ }
+ else if (datatype == TLONG)
+ {
+ ffgkyj(fptr, keyname, (long *) value, comm, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffgkyjj(fptr, keyname, (LONGLONG *) value, comm, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffgkye(fptr, keyname, (float *) value, comm, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffgkyd(fptr, keyname, (double *) value, comm, status);
+ }
+ else if (datatype == TCOMPLEX)
+ {
+ ffgkyc(fptr, keyname, (float *) value, comm, status);
+ }
+ else if (datatype == TDBLCOMPLEX)
+ {
+ ffgkym(fptr, keyname, (double *) value, comm, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkey( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ char *keyval, /* O - keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the keyword value and comment.
+ The value is just the literal string of characters in the value field
+ of the keyword. In the case of a string valued keyword, the returned
+ value includes the leading and closing quote characters. The value may be
+ up to 70 characters long, and the comment may be up to 72 characters long.
+ If the keyword has no value (no equal sign in column 9) then a null value
+ is returned.
+*/
+{
+ char card[FLEN_CARD];
+
+ keyval[0] = '\0';
+ if (comm)
+ comm[0] = '\0';
+
+ if (*status > 0)
+ return(*status);
+
+ if (ffgcrd(fptr, keyname, card, status) > 0) /* get the 80-byte card */
+ return(*status);
+
+ ffpsvc(card, keyval, comm, status); /* parse the value and comment */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgrec( fitsfile *fptr, /* I - FITS file pointer */
+ int nrec, /* I - number of keyword to read */
+ char *card, /* O - keyword card */
+ int *status) /* IO - error status */
+/*
+ Read (get) the nrec-th keyword, returning the entire keyword card up to
+ 80 characters long. The first keyword in the header has nrec = 1, not 0.
+ The returned card value is null terminated with any trailing blank
+ characters removed. If nrec = 0, then this routine simply moves the
+ current header pointer to the top of the header.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ if (nrec == 0)
+ {
+ ffmaky(fptr, 1, status); /* simply move to beginning of header */
+ if (card)
+ card[0] = '\0'; /* and return null card */
+ }
+ else if (nrec > 0)
+ {
+ ffmaky(fptr, nrec, status);
+ ffgnky(fptr, card, status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgcrd( fitsfile *fptr, /* I - FITS file pointer */
+ const char *name, /* I - name of keyword to read */
+ char *card, /* O - keyword card */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the entire keyword card up to
+ 80 characters long.
+ The returned card value is null terminated with any trailing blank
+ characters removed.
+
+ If the input name contains wild cards ('?' matches any single char
+ and '*' matches any sequence of chars, # matches any string of decimal
+ digits) then the search ends once the end of header is reached and does
+ not automatically resume from the top of the header.
+*/
+{
+ int nkeys, nextkey, ntodo, namelen, namelen_limit, namelenminus1, cardlen;
+ int ii = 0, jj, kk, wild, match, exact, hier = 0;
+ char keyname[FLEN_KEYWORD], cardname[FLEN_KEYWORD];
+ char *ptr1, *ptr2, *gotstar;
+
+ if (*status > 0)
+ return(*status);
+
+ *keyname = '\0';
+
+ while (name[ii] == ' ') /* skip leading blanks in name */
+ ii++;
+
+ strncat(keyname, &name[ii], FLEN_KEYWORD - 1);
+
+ namelen = strlen(keyname);
+
+ while (namelen > 0 && keyname[namelen - 1] == ' ')
+ namelen--; /* ignore trailing blanks in name */
+
+ keyname[namelen] = '\0'; /* terminate the name */
+
+ for (ii=0; ii < namelen; ii++)
+ keyname[ii] = toupper(keyname[ii]); /* make upper case */
+
+ if (FSTRNCMP("HIERARCH", keyname, 8) == 0)
+ {
+ if (namelen == 8)
+ {
+ /* special case: just looking for any HIERARCH keyword */
+ hier = 1;
+ }
+ else
+ {
+ /* ignore the leading HIERARCH and look for the 'real' name */
+ /* starting with first non-blank character following HIERARCH */
+ ptr1 = keyname;
+ ptr2 = &keyname[8];
+
+ while(*ptr2 == ' ')
+ ptr2++;
+
+ namelen = 0;
+ while(*ptr2)
+ {
+ *ptr1 = *ptr2;
+ ptr1++;
+ ptr2++;
+ namelen++;
+ }
+ *ptr1 = '\0';
+ }
+ }
+
+ /* does input name contain wild card chars? ('?', '*', or '#') */
+ /* wild cards are currently not supported with HIERARCH keywords */
+
+ namelen_limit = namelen;
+ gotstar = 0;
+ if (namelen < 9 &&
+ (strchr(keyname,'?') || (gotstar = strchr(keyname,'*')) ||
+ strchr(keyname,'#')) )
+ {
+ wild = 1;
+
+ /* if we found a '*' wild card in the name, there might be */
+ /* more than one. Support up to 2 '*' in the template. */
+ /* Thus we need to compare keywords whose names have at least */
+ /* namelen - 2 characters. */
+ if (gotstar)
+ namelen_limit -= 2;
+ }
+ else
+ wild = 0;
+
+ ffghps(fptr, &nkeys, &nextkey, status); /* get no. keywords and position */
+
+ namelenminus1 = maxvalue(namelen - 1, 1);
+ ntodo = nkeys - nextkey + 1; /* first, read from next keyword to end */
+ for (jj=0; jj < 2; jj++)
+ {
+ for (kk = 0; kk < ntodo; kk++)
+ {
+ ffgnky(fptr, card, status); /* get next keyword */
+
+ if (hier)
+ {
+ if (FSTRNCMP("HIERARCH", card, 8) == 0)
+ return(*status); /* found a HIERARCH keyword */
+ }
+ else
+ {
+ ffgknm(card, cardname, &cardlen, status); /* get the keyword name */
+
+ if (cardlen >= namelen_limit) /* can't match if card < name */
+ {
+ /* if there are no wild cards, lengths must be the same */
+ if (!( !wild && cardlen != namelen) )
+ {
+ for (ii=0; ii < cardlen; ii++)
+ {
+ /* make sure keyword is in uppercase */
+ if (cardname[ii] > 96)
+ {
+ /* This assumes the ASCII character set in which */
+ /* upper case characters start at ASCII(97) */
+ /* Timing tests showed that this is 20% faster */
+ /* than calling the isupper function. */
+
+ cardname[ii] = toupper(cardname[ii]); /* make upper case */
+ }
+ }
+
+ if (wild)
+ {
+ ffcmps(keyname, cardname, 1, &match, &exact);
+ if (match)
+ return(*status); /* found a matching keyword */
+ }
+ else if (keyname[namelenminus1] == cardname[namelenminus1])
+ {
+ /* test the last character of the keyword name first, on */
+ /* the theory that it is less likely to match then the first */
+ /* character since many keywords begin with 'T', for example */
+
+ if (FSTRNCMP(keyname, cardname, namelenminus1) == 0)
+ {
+ return(*status); /* found the matching keyword */
+ }
+ }
+ else if (namelen == 0 && cardlen == 0)
+ {
+ /* matched a blank keyword */
+ return(*status);
+ }
+ }
+ }
+ }
+ }
+
+ if (wild || jj == 1)
+ break; /* stop at end of header if template contains wildcards */
+
+ ffmaky(fptr, 1, status); /* reset pointer to beginning of header */
+ ntodo = nextkey - 1; /* number of keyword to read */
+ }
+
+ return(*status = KEY_NO_EXIST); /* couldn't find the keyword */
+}
+/*--------------------------------------------------------------------------*/
+int ffgstr( fitsfile *fptr, /* I - FITS file pointer */
+ const char *string, /* I - string to match */
+ char *card, /* O - keyword card */
+ int *status) /* IO - error status */
+/*
+ Read (get) the next keyword record that contains the input character string,
+ returning the entire keyword card up to 80 characters long.
+ The returned card value is null terminated with any trailing blank
+ characters removed.
+*/
+{
+ int nkeys, nextkey, ntodo, stringlen;
+ int jj, kk;
+
+ if (*status > 0)
+ return(*status);
+
+ stringlen = strlen(string);
+ if (stringlen > 80) {
+ return(*status = KEY_NO_EXIST); /* matching string is too long to exist */
+ }
+
+ ffghps(fptr, &nkeys, &nextkey, status); /* get no. keywords and position */
+ ntodo = nkeys - nextkey + 1; /* first, read from next keyword to end */
+
+ for (jj=0; jj < 2; jj++)
+ {
+ for (kk = 0; kk < ntodo; kk++)
+ {
+ ffgnky(fptr, card, status); /* get next keyword */
+ if (strstr(card, string) != 0) {
+ return(*status); /* found the matching string */
+ }
+ }
+
+ ffmaky(fptr, 1, status); /* reset pointer to beginning of header */
+ ntodo = nextkey - 1; /* number of keyword to read */
+ }
+
+ return(*status = KEY_NO_EXIST); /* couldn't find the keyword */
+}
+/*--------------------------------------------------------------------------*/
+int ffgknm( char *card, /* I - keyword card */
+ char *name, /* O - name of the keyword */
+ int *length, /* O - length of the keyword name */
+ int *status) /* IO - error status */
+
+/*
+ Return the name of the keyword, and the name length. This supports the
+ ESO HIERARCH convention where keyword names may be > 8 characters long.
+*/
+{
+ char *ptr1, *ptr2;
+ int ii;
+
+ *name = '\0';
+ *length = 0;
+
+ /* support for ESO HIERARCH keywords; find the '=' */
+ if (FSTRNCMP(card, "HIERARCH ", 9) == 0)
+ {
+ ptr2 = strchr(card, '=');
+
+ if (!ptr2) /* no value indicator ??? */
+ {
+ /* this probably indicates an error, so just return FITS name */
+ strcat(name, "HIERARCH");
+ *length = 8;
+ return(*status);
+ }
+
+ /* find the start and end of the HIERARCH name */
+ ptr1 = &card[9];
+ while (*ptr1 == ' ') /* skip spaces */
+ ptr1++;
+
+ strncat(name, ptr1, ptr2 - ptr1);
+ ii = ptr2 - ptr1;
+
+ while (ii > 0 && name[ii - 1] == ' ') /* remove trailing spaces */
+ ii--;
+
+ name[ii] = '\0';
+ *length = ii;
+ }
+ else
+ {
+ for (ii = 0; ii < 8; ii++)
+ {
+ /* look for string terminator, or a blank */
+ if (*(card+ii) != ' ' && *(card+ii) !='\0')
+ {
+ *(name+ii) = *(card+ii);
+ }
+ else
+ {
+ name[ii] = '\0';
+ *length = ii;
+ return(*status);
+ }
+ }
+
+ /* if we got here, keyword is 8 characters long */
+ name[8] = '\0';
+ *length = 8;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgunt( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ char *unit, /* O - keyword units */
+ int *status) /* IO - error status */
+/*
+ Read (get) the units string from the comment field of the existing
+ keyword. This routine uses a local FITS convention (not defined in the
+ official FITS standard) in which the units are enclosed in
+ square brackets following the '/' comment field delimiter, e.g.:
+
+ KEYWORD = 12 / [kpc] comment string goes here
+*/
+{
+ char valstring[FLEN_VALUE];
+ char comm[FLEN_COMMENT];
+ char *loc;
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+
+ if (comm[0] == '[')
+ {
+ loc = strchr(comm, ']'); /* find the closing bracket */
+ if (loc)
+ *loc = '\0'; /* terminate the string */
+
+ strcpy(unit, &comm[1]); /* copy the string */
+ }
+ else
+ unit[0] = '\0';
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkys( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ char *value, /* O - keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Get KeYword with a String value:
+ Read (get) a simple string valued keyword. The returned value may be up to
+ 68 chars long ( + 1 null terminator char). The routine does not support the
+ HEASARC convention for continuing long string values over multiple keywords.
+ The ffgkls routine may be used to read long continued strings. The returned
+ comment string may be up to 69 characters long (including null terminator).
+*/
+{
+ char valstring[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+ value[0] = '\0';
+ ffc2s(valstring, value, status); /* remove quotes from string */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkls( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ char **value, /* O - pointer to keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Get Keyword with possible Long String value:
+ Read (get) the named keyword, returning the value and comment.
+ The returned value string may be arbitrarily long (by using the HEASARC
+ convention for continuing long string values over multiple keywords) so
+ this routine allocates the required memory for the returned string value.
+ It is up to the calling routine to free the memory once it is finished
+ with the value string. The returned comment string may be up to 69
+ characters long.
+*/
+{
+ char valstring[FLEN_VALUE];
+ int contin;
+ size_t len;
+
+ if (*status > 0)
+ return(*status);
+
+ *value = NULL; /* initialize a null pointer in case of error */
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+
+ if (*status > 0)
+ return(*status);
+
+ if (!valstring[0]) /* null value string? */
+ {
+ *value = (char *) malloc(1); /* allocate and return a null string */
+ **value = '\0';
+ }
+ else
+ {
+ /* allocate space, plus 1 for null */
+ *value = (char *) malloc(strlen(valstring) + 1);
+
+ ffc2s(valstring, *value, status); /* convert string to value */
+ len = strlen(*value);
+
+ /* If last character is a & then value may be continued on next keyword */
+ contin = 1;
+ while (contin)
+ {
+ if (len && *(*value+len-1) == '&') /* is last char an anpersand? */
+ {
+ ffgcnt(fptr, valstring, status);
+ if (*valstring) /* a null valstring indicates no continuation */
+ {
+ *(*value+len-1) = '\0'; /* erase the trailing & char */
+ len += strlen(valstring) - 1;
+ *value = (char *) realloc(*value, len + 1); /* increase size */
+ strcat(*value, valstring); /* append the continued chars */
+ }
+ else
+ contin = 0;
+ }
+ else
+ contin = 0;
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fffree( char *value, /* I - pointer to keyword value */
+ int *status) /* IO - error status */
+/*
+ Free the memory that was allocated by ffgkls for the long string keyword value.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ if (value)
+ free(value);
+
+ return(*status);
+}
+ /*--------------------------------------------------------------------------*/
+int ffgcnt( fitsfile *fptr, /* I - FITS file pointer */
+ char *value, /* O - continued string value */
+ int *status) /* IO - error status */
+/*
+ Attempt to read the next keyword, returning the string value
+ if it is a continuation of the previous string keyword value.
+ This uses the HEASARC convention for continuing long string values
+ over multiple keywords. Each continued string is terminated with a
+ backslash character, and the continuation follows on the next keyword
+ which must have the name CONTINUE without an equal sign in column 9
+ of the card. If the next card is not a continuation, then the returned
+ value string will be null.
+*/
+{
+ int tstatus;
+ char card[FLEN_CARD], strval[FLEN_VALUE], comm[FLEN_COMMENT];
+
+ if (*status > 0)
+ return(*status);
+
+ tstatus = 0;
+ value[0] = '\0';
+
+ if (ffgnky(fptr, card, &tstatus) > 0) /* read next keyword */
+ return(*status); /* hit end of header */
+
+ if (strncmp(card, "CONTINUE ", 10) == 0) /* a continuation card? */
+ {
+ strncpy(card, "D2345678= ", 10); /* overwrite a dummy keyword name */
+ ffpsvc(card, strval, comm, &tstatus); /* get the string value */
+ ffc2s(strval, value, &tstatus); /* remove the surrounding quotes */
+
+ if (tstatus) /* return null if error status was returned */
+ value[0] = '\0';
+ }
+ else
+ ffmrky(fptr, -1, status); /* reset the keyword pointer */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkyl( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ int *value, /* O - keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the value and comment.
+ The returned value = 1 if the keyword is true, else = 0 if false.
+ The comment may be up to 69 characters long.
+*/
+{
+ char valstring[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+ ffc2l(valstring, value, status); /* convert string to value */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkyj( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ long *value, /* O - keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the value and comment.
+ The value will be implicitly converted to a (long) integer if it not
+ already of this datatype. The comment may be up to 69 characters long.
+*/
+{
+ char valstring[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+ ffc2i(valstring, value, status); /* convert string to value */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkyjj( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ LONGLONG *value, /* O - keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the value and comment.
+ The value will be implicitly converted to a (long) integer if it not
+ already of this datatype. The comment may be up to 69 characters long.
+*/
+{
+ char valstring[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+ ffc2j(valstring, value, status); /* convert string to value */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkye( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ float *value, /* O - keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the value and comment.
+ The value will be implicitly converted to a float if it not
+ already of this datatype. The comment may be up to 69 characters long.
+*/
+{
+ char valstring[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+ ffc2r(valstring, value, status); /* convert string to value */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkyd( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ double *value, /* O - keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the value and comment.
+ The value will be implicitly converted to a double if it not
+ already of this datatype. The comment may be up to 69 characters long.
+*/
+{
+ char valstring[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+ ffc2d(valstring, value, status); /* convert string to value */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkyc( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ float *value, /* O - keyword value (real,imag) */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the value and comment.
+ The keyword must have a complex value. No implicit data conversion
+ will be performed.
+*/
+{
+ char valstring[FLEN_VALUE], message[81];
+ int len;
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+
+ if (valstring[0] != '(' ) /* test that this is a complex keyword */
+ {
+ sprintf(message, "keyword %s does not have a complex value (ffgkyc):",
+ keyname);
+ ffpmsg(message);
+ ffpmsg(valstring);
+ return(*status = BAD_C2F);
+ }
+
+ valstring[0] = ' '; /* delete the opening parenthesis */
+ len = strcspn(valstring, ")" );
+ valstring[len] = '\0'; /* delete the closing parenthesis */
+
+ len = strcspn(valstring, ",");
+ valstring[len] = '\0';
+
+ ffc2r(valstring, &value[0], status); /* convert the real part */
+ ffc2r(&valstring[len + 1], &value[1], status); /* convert imag. part */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkym( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ double *value, /* O - keyword value (real,imag) */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the value and comment.
+ The keyword must have a complex value. No implicit data conversion
+ will be performed.
+*/
+{
+ char valstring[FLEN_VALUE], message[81];
+ int len;
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+
+ if (valstring[0] != '(' ) /* test that this is a complex keyword */
+ {
+ sprintf(message, "keyword %s does not have a complex value (ffgkym):",
+ keyname);
+ ffpmsg(message);
+ ffpmsg(valstring);
+ return(*status = BAD_C2D);
+ }
+
+ valstring[0] = ' '; /* delete the opening parenthesis */
+ len = strcspn(valstring, ")" );
+ valstring[len] = '\0'; /* delete the closing parenthesis */
+
+ len = strcspn(valstring, ",");
+ valstring[len] = '\0';
+
+ ffc2d(valstring, &value[0], status); /* convert the real part */
+ ffc2d(&valstring[len + 1], &value[1], status); /* convert the imag. part */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkyt( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to read */
+ long *ivalue, /* O - integer part of keyword value */
+ double *fraction, /* O - fractional part of keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the named keyword, returning the value and comment.
+ The integer and fractional parts of the value are returned in separate
+ variables, to allow more numerical precision to be passed. This
+ effectively passes a 'triple' precision value, with a 4-byte integer
+ and an 8-byte fraction. The comment may be up to 69 characters long.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char *loc;
+
+ if (*status > 0)
+ return(*status);
+
+ ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */
+
+ /* read the entire value string as a double, to get the integer part */
+ ffc2d(valstring, fraction, status);
+
+ *ivalue = (long) *fraction;
+
+ *fraction = *fraction - *ivalue;
+
+ /* see if we need to read the fractional part again with more precision */
+ /* look for decimal point, without an exponential E or D character */
+
+ loc = strchr(valstring, '.');
+ if (loc)
+ {
+ if (!strchr(valstring, 'E') && !strchr(valstring, 'D'))
+ ffc2d(loc, fraction, status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkyn( fitsfile *fptr, /* I - FITS file pointer */
+ int nkey, /* I - number of the keyword to read */
+ char *keyname, /* O - name of the keyword */
+ char *value, /* O - keyword value */
+ char *comm, /* O - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Read (get) the nkey-th keyword returning the keyword name, value and comment.
+ The value is just the literal string of characters in the value field
+ of the keyword. In the case of a string valued keyword, the returned
+ value includes the leading and closing quote characters. The value may be
+ up to 70 characters long, and the comment may be up to 72 characters long.
+ If the keyword has no value (no equal sign in column 9) then a null value
+ is returned. If comm = NULL, then do not return the comment string.
+*/
+{
+ char card[FLEN_CARD], sbuff[FLEN_CARD];
+ int namelen;
+
+ keyname[0] = '\0';
+ value[0] = '\0';
+ if (comm)
+ comm[0] = '\0';
+
+ if (*status > 0)
+ return(*status);
+
+ if (ffgrec(fptr, nkey, card, status) > 0 ) /* get the 80-byte card */
+ return(*status);
+
+ ffgknm(card, keyname, &namelen, status); /* get the keyword name */
+
+ if (ffpsvc(card, value, comm, status) > 0) /* parse value and comment */
+ return(*status);
+
+ if (fftrec(keyname, status) > 0) /* test keyword name; catches no END */
+ {
+ sprintf(sbuff,"Name of keyword no. %d contains illegal character(s): %s",
+ nkey, keyname);
+ ffpmsg(sbuff);
+
+ if (nkey % 36 == 0) /* test if at beginning of 36-card FITS record */
+ ffpmsg(" (This may indicate a missing END keyword).");
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkns( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - root name of keywords to read */
+ int nstart, /* I - starting index number */
+ int nmax, /* I - maximum number of keywords to return */
+ char *value[], /* O - array of pointers to keyword values */
+ int *nfound, /* O - number of values that were returned */
+ int *status) /* IO - error status */
+/*
+ Read (get) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NMAX -1) inclusive.
+ This routine does NOT support the HEASARC long string convention.
+*/
+{
+ int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval;
+ long ival;
+ char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD];
+ char svalue[FLEN_VALUE], comm[FLEN_COMMENT];
+
+ if (*status > 0)
+ return(*status);
+
+ *nfound = 0;
+ nend = nstart + nmax - 1;
+
+ keyroot[0] = '\0';
+ strncat(keyroot, keyname, 8);
+
+ lenroot = strlen(keyroot);
+ if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */
+ return(*status);
+
+ for (ii=0; ii < lenroot; ii++) /* make sure upper case */
+ keyroot[ii] = toupper(keyroot[ii]);
+
+ ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */
+
+ undefinedval = FALSE;
+ for (ii=3; ii <= nkeys; ii++)
+ {
+ if (ffgrec(fptr, ii, card, status) > 0) /* get next keyword */
+ return(*status);
+
+ if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */
+ {
+ keyindex[0] = '\0';
+ strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */
+
+ tstatus = 0;
+ if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */
+ {
+ if (ival <= nend && ival >= nstart)
+ {
+ ffpsvc(card, svalue, comm, status); /* parse the value */
+ ffc2s(svalue, value[ival-nstart], status); /* convert */
+ if (ival - nstart + 1 > *nfound)
+ *nfound = ival - nstart + 1; /* max found */
+
+ if (*status == VALUE_UNDEFINED)
+ {
+ undefinedval = TRUE;
+ *status = 0; /* reset status to read remaining values */
+ }
+ }
+ }
+ }
+ }
+ if (undefinedval && (*status <= 0) )
+ *status = VALUE_UNDEFINED; /* report at least 1 value undefined */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgknl( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - root name of keywords to read */
+ int nstart, /* I - starting index number */
+ int nmax, /* I - maximum number of keywords to return */
+ int *value, /* O - array of keyword values */
+ int *nfound, /* O - number of values that were returned */
+ int *status) /* IO - error status */
+/*
+ Read (get) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NMAX -1) inclusive.
+ The returned value = 1 if the keyword is true, else = 0 if false.
+*/
+{
+ int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval;
+ long ival;
+ char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD];
+ char svalue[FLEN_VALUE], comm[FLEN_COMMENT];
+
+ if (*status > 0)
+ return(*status);
+
+ *nfound = 0;
+ nend = nstart + nmax - 1;
+
+ keyroot[0] = '\0';
+ strncat(keyroot, keyname, 8);
+
+ lenroot = strlen(keyroot);
+ if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */
+ return(*status);
+
+ for (ii=0; ii < lenroot; ii++) /* make sure upper case */
+ keyroot[ii] = toupper(keyroot[ii]);
+
+ ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */
+
+ ffmaky(fptr, 3, status); /* move to 3rd keyword (skip 1st 2 keywords) */
+
+ undefinedval = FALSE;
+ for (ii=3; ii <= nkeys; ii++)
+ {
+ if (ffgnky(fptr, card, status) > 0) /* get next keyword */
+ return(*status);
+
+ if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */
+ {
+ keyindex[0] = '\0';
+ strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */
+
+ tstatus = 0;
+ if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */
+ {
+ if (ival <= nend && ival >= nstart)
+ {
+ ffpsvc(card, svalue, comm, status); /* parse the value */
+ ffc2l(svalue, &value[ival-nstart], status); /* convert*/
+ if (ival - nstart + 1 > *nfound)
+ *nfound = ival - nstart + 1; /* max found */
+
+ if (*status == VALUE_UNDEFINED)
+ {
+ undefinedval = TRUE;
+ *status = 0; /* reset status to read remaining values */
+ }
+ }
+ }
+ }
+ }
+ if (undefinedval && (*status <= 0) )
+ *status = VALUE_UNDEFINED; /* report at least 1 value undefined */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgknj( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - root name of keywords to read */
+ int nstart, /* I - starting index number */
+ int nmax, /* I - maximum number of keywords to return */
+ long *value, /* O - array of keyword values */
+ int *nfound, /* O - number of values that were returned */
+ int *status) /* IO - error status */
+/*
+ Read (get) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NMAX -1) inclusive.
+*/
+{
+ int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval;
+ long ival;
+ char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD];
+ char svalue[FLEN_VALUE], comm[FLEN_COMMENT];
+
+ if (*status > 0)
+ return(*status);
+
+ *nfound = 0;
+ nend = nstart + nmax - 1;
+
+ keyroot[0] = '\0';
+ strncat(keyroot, keyname, 8);
+
+ lenroot = strlen(keyroot);
+ if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */
+ return(*status);
+
+ for (ii=0; ii < lenroot; ii++) /* make sure upper case */
+ keyroot[ii] = toupper(keyroot[ii]);
+
+ ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */
+
+ ffmaky(fptr, 3, status); /* move to 3rd keyword (skip 1st 2 keywords) */
+
+ undefinedval = FALSE;
+ for (ii=3; ii <= nkeys; ii++)
+ {
+ if (ffgnky(fptr, card, status) > 0) /* get next keyword */
+ return(*status);
+
+ if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */
+ {
+ keyindex[0] = '\0';
+ strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */
+
+ tstatus = 0;
+ if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */
+ {
+ if (ival <= nend && ival >= nstart)
+ {
+ ffpsvc(card, svalue, comm, status); /* parse the value */
+ ffc2i(svalue, &value[ival-nstart], status); /* convert */
+ if (ival - nstart + 1 > *nfound)
+ *nfound = ival - nstart + 1; /* max found */
+
+ if (*status == VALUE_UNDEFINED)
+ {
+ undefinedval = TRUE;
+ *status = 0; /* reset status to read remaining values */
+ }
+ }
+ }
+ }
+ }
+ if (undefinedval && (*status <= 0) )
+ *status = VALUE_UNDEFINED; /* report at least 1 value undefined */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgknjj( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - root name of keywords to read */
+ int nstart, /* I - starting index number */
+ int nmax, /* I - maximum number of keywords to return */
+ LONGLONG *value, /* O - array of keyword values */
+ int *nfound, /* O - number of values that were returned */
+ int *status) /* IO - error status */
+/*
+ Read (get) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NMAX -1) inclusive.
+*/
+{
+ int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval;
+ long ival;
+ char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD];
+ char svalue[FLEN_VALUE], comm[FLEN_COMMENT];
+
+ if (*status > 0)
+ return(*status);
+
+ *nfound = 0;
+ nend = nstart + nmax - 1;
+
+ keyroot[0] = '\0';
+ strncat(keyroot, keyname, 8);
+
+ lenroot = strlen(keyroot);
+ if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */
+ return(*status);
+
+ for (ii=0; ii < lenroot; ii++) /* make sure upper case */
+ keyroot[ii] = toupper(keyroot[ii]);
+
+ ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */
+
+ ffmaky(fptr, 3, status); /* move to 3rd keyword (skip 1st 2 keywords) */
+
+ undefinedval = FALSE;
+ for (ii=3; ii <= nkeys; ii++)
+ {
+ if (ffgnky(fptr, card, status) > 0) /* get next keyword */
+ return(*status);
+
+ if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */
+ {
+ keyindex[0] = '\0';
+ strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */
+
+ tstatus = 0;
+ if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */
+ {
+ if (ival <= nend && ival >= nstart)
+ {
+ ffpsvc(card, svalue, comm, status); /* parse the value */
+ ffc2j(svalue, &value[ival-nstart], status); /* convert */
+ if (ival - nstart + 1 > *nfound)
+ *nfound = ival - nstart + 1; /* max found */
+
+ if (*status == VALUE_UNDEFINED)
+ {
+ undefinedval = TRUE;
+ *status = 0; /* reset status to read remaining values */
+ }
+ }
+ }
+ }
+ }
+ if (undefinedval && (*status <= 0) )
+ *status = VALUE_UNDEFINED; /* report at least 1 value undefined */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgkne( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - root name of keywords to read */
+ int nstart, /* I - starting index number */
+ int nmax, /* I - maximum number of keywords to return */
+ float *value, /* O - array of keyword values */
+ int *nfound, /* O - number of values that were returned */
+ int *status) /* IO - error status */
+/*
+ Read (get) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NMAX -1) inclusive.
+*/
+{
+ int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval;
+ long ival;
+ char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD];
+ char svalue[FLEN_VALUE], comm[FLEN_COMMENT];
+
+ if (*status > 0)
+ return(*status);
+
+ *nfound = 0;
+ nend = nstart + nmax - 1;
+
+ keyroot[0] = '\0';
+ strncat(keyroot, keyname, 8);
+
+ lenroot = strlen(keyroot);
+ if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */
+ return(*status);
+
+ for (ii=0; ii < lenroot; ii++) /* make sure upper case */
+ keyroot[ii] = toupper(keyroot[ii]);
+
+ ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */
+
+ ffmaky(fptr, 3, status); /* move to 3rd keyword (skip 1st 2 keywords) */
+
+ undefinedval = FALSE;
+ for (ii=3; ii <= nkeys; ii++)
+ {
+ if (ffgnky(fptr, card, status) > 0) /* get next keyword */
+ return(*status);
+
+ if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */
+ {
+ keyindex[0] = '\0';
+ strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */
+
+ tstatus = 0;
+ if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */
+ {
+ if (ival <= nend && ival >= nstart)
+ {
+ ffpsvc(card, svalue, comm, status); /* parse the value */
+ ffc2r(svalue, &value[ival-nstart], status); /* convert */
+ if (ival - nstart + 1 > *nfound)
+ *nfound = ival - nstart + 1; /* max found */
+
+ if (*status == VALUE_UNDEFINED)
+ {
+ undefinedval = TRUE;
+ *status = 0; /* reset status to read remaining values */
+ }
+ }
+ }
+ }
+ }
+ if (undefinedval && (*status <= 0) )
+ *status = VALUE_UNDEFINED; /* report at least 1 value undefined */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgknd( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - root name of keywords to read */
+ int nstart, /* I - starting index number */
+ int nmax, /* I - maximum number of keywords to return */
+ double *value, /* O - array of keyword values */
+ int *nfound, /* O - number of values that were returned */
+ int *status) /* IO - error status */
+/*
+ Read (get) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NMAX -1) inclusive.
+*/
+{
+ int nend, lenroot, ii, nkeys, mkeys, tstatus, undefinedval;
+ long ival;
+ char keyroot[FLEN_KEYWORD], keyindex[8], card[FLEN_CARD];
+ char svalue[FLEN_VALUE], comm[FLEN_COMMENT];
+
+ if (*status > 0)
+ return(*status);
+
+ *nfound = 0;
+ nend = nstart + nmax - 1;
+
+ keyroot[0] = '\0';
+ strncat(keyroot, keyname, 8);
+
+ lenroot = strlen(keyroot);
+ if (lenroot == 0 || lenroot > 7) /* root must be 1 - 7 chars long */
+ return(*status);
+
+ for (ii=0; ii < lenroot; ii++) /* make sure upper case */
+ keyroot[ii] = toupper(keyroot[ii]);
+
+ ffghps(fptr, &nkeys, &mkeys, status); /* get the number of keywords */
+
+ ffmaky(fptr, 3, status); /* move to 3rd keyword (skip 1st 2 keywords) */
+
+ undefinedval = FALSE;
+ for (ii=3; ii <= nkeys; ii++)
+ {
+ if (ffgnky(fptr, card, status) > 0) /* get next keyword */
+ return(*status);
+
+ if (strncmp(keyroot, card, lenroot) == 0) /* see if keyword matches */
+ {
+ keyindex[0] = '\0';
+ strncat(keyindex, &card[lenroot], 8-lenroot); /* copy suffix */
+
+ tstatus = 0;
+ if (ffc2ii(keyindex, &ival, &tstatus) <= 0) /* test suffix */
+ {
+ if (ival <= nend && ival >= nstart) /* is index within range? */
+ {
+ ffpsvc(card, svalue, comm, status); /* parse the value */
+ ffc2d(svalue, &value[ival-nstart], status); /* convert */
+ if (ival - nstart + 1 > *nfound)
+ *nfound = ival - nstart + 1; /* max found */
+
+ if (*status == VALUE_UNDEFINED)
+ {
+ undefinedval = TRUE;
+ *status = 0; /* reset status to read remaining values */
+ }
+ }
+ }
+ }
+ }
+ if (undefinedval && (*status <= 0) )
+ *status = VALUE_UNDEFINED; /* report at least 1 value undefined */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtdm(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read */
+ int maxdim, /* I - maximum no. of dimensions to read; */
+ int *naxis, /* O - number of axes in the data array */
+ long naxes[], /* O - length of each data axis */
+ int *status) /* IO - error status */
+/*
+ read and parse the TDIMnnn keyword to get the dimensionality of a column
+*/
+{
+ int tstatus = 0;
+ char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ ffkeyn("TDIM", colnum, keyname, status); /* construct keyword name */
+
+ ffgkys(fptr, keyname, tdimstr, NULL, &tstatus); /* try reading keyword */
+
+ ffdtdm(fptr, tdimstr, colnum, maxdim,naxis, naxes, status); /* decode it */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtdmll(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of the column to read */
+ int maxdim, /* I - maximum no. of dimensions to read; */
+ int *naxis, /* O - number of axes in the data array */
+ LONGLONG naxes[], /* O - length of each data axis */
+ int *status) /* IO - error status */
+/*
+ read and parse the TDIMnnn keyword to get the dimensionality of a column
+*/
+{
+ int tstatus = 0;
+ char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ ffkeyn("TDIM", colnum, keyname, status); /* construct keyword name */
+
+ ffgkys(fptr, keyname, tdimstr, NULL, &tstatus); /* try reading keyword */
+
+ ffdtdmll(fptr, tdimstr, colnum, maxdim,naxis, naxes, status); /* decode it */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdtdm(fitsfile *fptr, /* I - FITS file pointer */
+ char *tdimstr, /* I - TDIMn keyword value string. e.g. (10,10) */
+ int colnum, /* I - number of the column */
+ int maxdim, /* I - maximum no. of dimensions to read; */
+ int *naxis, /* O - number of axes in the data array */
+ long naxes[], /* O - length of each data axis */
+ int *status) /* IO - error status */
+/*
+ decode the TDIMnnn keyword to get the dimensionality of a column.
+ Check that the value is legal and consistent with the TFORM value.
+*/
+{
+ long dimsize, totalpix = 1;
+ char *loc, *lastloc, message[81];
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+ return(*status = BAD_COL_NUM);
+
+ colptr = (fptr->Fptr)->tableptr; /* set pointer to the first column */
+ colptr += (colnum - 1); /* increment to the correct column */
+
+ if (!tdimstr[0]) /* TDIMn keyword doesn't exist? */
+ {
+ *naxis = 1; /* default = 1 dimensional */
+ if (maxdim > 0)
+ naxes[0] = (long) colptr->trepeat; /* default length = repeat */
+ }
+ else
+ {
+ *naxis = 0;
+
+ loc = strchr(tdimstr, '(' ); /* find the opening quote */
+ if (!loc)
+ {
+ sprintf(message, "Illegal TDIM keyword value: %s", tdimstr);
+ return(*status = BAD_TDIM);
+ }
+
+ while (loc)
+ {
+ loc++;
+ dimsize = strtol(loc, &loc, 10); /* read size of next dimension */
+ if (*naxis < maxdim)
+ naxes[*naxis] = dimsize;
+
+ if (dimsize < 0)
+ {
+ ffpmsg("one or more TDIM values are less than 0 (ffdtdm)");
+ ffpmsg(tdimstr);
+ return(*status = BAD_TDIM);
+ }
+
+ totalpix *= dimsize;
+ (*naxis)++;
+ lastloc = loc;
+ loc = strchr(loc, ','); /* look for comma before next dimension */
+ }
+
+ loc = strchr(lastloc, ')' ); /* check for the closing quote */
+ if (!loc)
+ {
+ sprintf(message, "Illegal TDIM keyword value: %s", tdimstr);
+ return(*status = BAD_TDIM);
+ }
+
+ if ((colptr->tdatatype > 0) && ((long) colptr->trepeat != totalpix))
+ {
+ sprintf(message,
+ "column vector length, %ld, does not equal TDIMn array size, %ld",
+ (long) colptr->trepeat, totalpix);
+ ffpmsg(message);
+ ffpmsg(tdimstr);
+ return(*status = BAD_TDIM);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdtdmll(fitsfile *fptr, /* I - FITS file pointer */
+ char *tdimstr, /* I - TDIMn keyword value string. e.g. (10,10) */
+ int colnum, /* I - number of the column */
+ int maxdim, /* I - maximum no. of dimensions to read; */
+ int *naxis, /* O - number of axes in the data array */
+ LONGLONG naxes[], /* O - length of each data axis */
+ int *status) /* IO - error status */
+/*
+ decode the TDIMnnn keyword to get the dimensionality of a column.
+ Check that the value is legal and consistent with the TFORM value.
+*/
+{
+ LONGLONG dimsize;
+ LONGLONG totalpix = 1;
+ char *loc, *lastloc, message[81];
+ tcolumn *colptr;
+ double doublesize;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
+ return(*status = BAD_COL_NUM);
+
+ colptr = (fptr->Fptr)->tableptr; /* set pointer to the first column */
+ colptr += (colnum - 1); /* increment to the correct column */
+
+ if (!tdimstr[0]) /* TDIMn keyword doesn't exist? */
+ {
+ *naxis = 1; /* default = 1 dimensional */
+ if (maxdim > 0)
+ naxes[0] = colptr->trepeat; /* default length = repeat */
+ }
+ else
+ {
+ *naxis = 0;
+
+ loc = strchr(tdimstr, '(' ); /* find the opening quote */
+ if (!loc)
+ {
+ sprintf(message, "Illegal TDIM keyword value: %s", tdimstr);
+ return(*status = BAD_TDIM);
+ }
+
+ while (loc)
+ {
+ loc++;
+
+ /* Read value as a double because the string to 64-bit int function is */
+ /* platform dependent (strtoll, strtol, _atoI64). This still gives */
+ /* about 48 bits of precision, which is plenty for this purpose. */
+
+ doublesize = strtod(loc, &loc);
+ dimsize = (LONGLONG) (doublesize + 0.1);
+
+ if (*naxis < maxdim)
+ naxes[*naxis] = dimsize;
+
+ if (dimsize < 0)
+ {
+ ffpmsg("one or more TDIM values are less than 0 (ffdtdm)");
+ ffpmsg(tdimstr);
+ return(*status = BAD_TDIM);
+ }
+
+ totalpix *= dimsize;
+ (*naxis)++;
+ lastloc = loc;
+ loc = strchr(loc, ','); /* look for comma before next dimension */
+ }
+
+ loc = strchr(lastloc, ')' ); /* check for the closing quote */
+ if (!loc)
+ {
+ sprintf(message, "Illegal TDIM keyword value: %s", tdimstr);
+ return(*status = BAD_TDIM);
+ }
+
+ if ((colptr->tdatatype > 0) && (colptr->trepeat != totalpix))
+ {
+ sprintf(message,
+ "column vector length, %.0f, does not equal TDIMn array size, %.0f",
+ (double) (colptr->trepeat), (double) totalpix);
+ ffpmsg(message);
+ ffpmsg(tdimstr);
+ return(*status = BAD_TDIM);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghpr(fitsfile *fptr, /* I - FITS file pointer */
+ int maxdim, /* I - maximum no. of dimensions to read; */
+ int *simple, /* O - does file conform to FITS standard? 1/0 */
+ int *bitpix, /* O - number of bits per data value pixel */
+ int *naxis, /* O - number of axes in the data array */
+ long naxes[], /* O - length of each data axis */
+ long *pcount, /* O - number of group parameters (usually 0) */
+ long *gcount, /* O - number of random groups (usually 1 or 0) */
+ int *extend, /* O - may FITS file haave extensions? */
+ int *status) /* IO - error status */
+/*
+ Get keywords from the Header of the PRimary array:
+ Check that the keywords conform to the FITS standard and return the
+ parameters which determine the size and structure of the primary array
+ or IMAGE extension.
+*/
+{
+ int idummy, ii;
+ LONGLONG lldummy;
+ double ddummy;
+ LONGLONG tnaxes[99];
+
+ ffgphd(fptr, maxdim, simple, bitpix, naxis, tnaxes, pcount, gcount, extend,
+ &ddummy, &ddummy, &lldummy, &idummy, status);
+
+ if (naxis && naxes) {
+ for (ii = 0; (ii < *naxis) && (ii < maxdim); ii++)
+ naxes[ii] = (long) tnaxes[ii];
+ } else if (naxes) {
+ for (ii = 0; ii < maxdim; ii++)
+ naxes[ii] = (long) tnaxes[ii];
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghprll(fitsfile *fptr, /* I - FITS file pointer */
+ int maxdim, /* I - maximum no. of dimensions to read; */
+ int *simple, /* O - does file conform to FITS standard? 1/0 */
+ int *bitpix, /* O - number of bits per data value pixel */
+ int *naxis, /* O - number of axes in the data array */
+ LONGLONG naxes[], /* O - length of each data axis */
+ long *pcount, /* O - number of group parameters (usually 0) */
+ long *gcount, /* O - number of random groups (usually 1 or 0) */
+ int *extend, /* O - may FITS file haave extensions? */
+ int *status) /* IO - error status */
+/*
+ Get keywords from the Header of the PRimary array:
+ Check that the keywords conform to the FITS standard and return the
+ parameters which determine the size and structure of the primary array
+ or IMAGE extension.
+*/
+{
+ int idummy;
+ LONGLONG lldummy;
+ double ddummy;
+
+ ffgphd(fptr, maxdim, simple, bitpix, naxis, naxes, pcount, gcount, extend,
+ &ddummy, &ddummy, &lldummy, &idummy, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghtb(fitsfile *fptr, /* I - FITS file pointer */
+ int maxfield, /* I - maximum no. of columns to read; */
+ long *naxis1, /* O - length of table row in bytes */
+ long *naxis2, /* O - number of rows in the table */
+ int *tfields, /* O - number of columns in the table */
+ char **ttype, /* O - name of each column */
+ long *tbcol, /* O - byte offset in row to each column */
+ char **tform, /* O - value of TFORMn keyword for each column */
+ char **tunit, /* O - value of TUNITn keyword for each column */
+ char *extnm, /* O - value of EXTNAME keyword, if any */
+ int *status) /* IO - error status */
+/*
+ Get keywords from the Header of the ASCII TaBle:
+ Check that the keywords conform to the FITS standard and return the
+ parameters which describe the table.
+*/
+{
+ int ii, maxf, nfound, tstatus;
+ long fields;
+ char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
+ char xtension[FLEN_VALUE], message[81];
+ LONGLONG llnaxis1, llnaxis2, pcount;
+
+ if (*status > 0)
+ return(*status);
+
+ /* read the first keyword of the extension */
+ ffgkyn(fptr, 1, name, value, comm, status);
+
+ if (!strcmp(name, "XTENSION"))
+ {
+ if (ffc2s(value, xtension, status) > 0) /* get the value string */
+ {
+ ffpmsg("Bad value string for XTENSION keyword:");
+ ffpmsg(value);
+ return(*status);
+ }
+
+ /* allow the quoted string value to begin in any column and */
+ /* allow any number of trailing blanks before the closing quote */
+ if ( (value[0] != '\'') || /* first char must be a quote */
+ ( strcmp(xtension, "TABLE") ) )
+ {
+ sprintf(message,
+ "This is not a TABLE extension: %s", value);
+ ffpmsg(message);
+ return(*status = NOT_ATABLE);
+ }
+ }
+
+ else /* error: 1st keyword of extension != XTENSION */
+ {
+ sprintf(message,
+ "First keyword of the extension is not XTENSION: %s", name);
+ ffpmsg(message);
+ return(*status = NO_XTENSION);
+ }
+
+ if (ffgttb(fptr, &llnaxis1, &llnaxis2, &pcount, &fields, status) > 0)
+ return(*status);
+
+ if (naxis1)
+ *naxis1 = (long) llnaxis1;
+
+ if (naxis2)
+ *naxis2 = (long) llnaxis2;
+
+ if (pcount != 0)
+ {
+ sprintf(message, "PCOUNT = %.0f is illegal in ASCII table; must = 0",
+ (double) pcount);
+ ffpmsg(message);
+ return(*status = BAD_PCOUNT);
+ }
+
+ if (tfields)
+ *tfields = fields;
+
+ if (maxfield < 0)
+ maxf = fields;
+ else
+ maxf = minvalue(maxfield, fields);
+
+ if (maxf > 0)
+ {
+ for (ii = 0; ii < maxf; ii++)
+ { /* initialize optional keyword values */
+ if (ttype)
+ *ttype[ii] = '\0';
+
+ if (tunit)
+ *tunit[ii] = '\0';
+ }
+
+
+ if (ttype)
+ ffgkns(fptr, "TTYPE", 1, maxf, ttype, &nfound, status);
+
+ if (tunit)
+ ffgkns(fptr, "TUNIT", 1, maxf, tunit, &nfound, status);
+
+ if (*status > 0)
+ return(*status);
+
+ if (tbcol)
+ {
+ ffgknj(fptr, "TBCOL", 1, maxf, tbcol, &nfound, status);
+
+ if (*status > 0 || nfound != maxf)
+ {
+ ffpmsg(
+ "Required TBCOL keyword(s) not found in ASCII table header (ffghtb).");
+ return(*status = NO_TBCOL);
+ }
+ }
+
+ if (tform)
+ {
+ ffgkns(fptr, "TFORM", 1, maxf, tform, &nfound, status);
+
+ if (*status > 0 || nfound != maxf)
+ {
+ ffpmsg(
+ "Required TFORM keyword(s) not found in ASCII table header (ffghtb).");
+ return(*status = NO_TFORM);
+ }
+ }
+ }
+
+ if (extnm)
+ {
+ extnm[0] = '\0';
+
+ tstatus = *status;
+ ffgkys(fptr, "EXTNAME", extnm, comm, status);
+
+ if (*status == KEY_NO_EXIST)
+ *status = tstatus; /* keyword not required, so ignore error */
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghtbll(fitsfile *fptr, /* I - FITS file pointer */
+ int maxfield, /* I - maximum no. of columns to read; */
+ LONGLONG *naxis1, /* O - length of table row in bytes */
+ LONGLONG *naxis2, /* O - number of rows in the table */
+ int *tfields, /* O - number of columns in the table */
+ char **ttype, /* O - name of each column */
+ LONGLONG *tbcol, /* O - byte offset in row to each column */
+ char **tform, /* O - value of TFORMn keyword for each column */
+ char **tunit, /* O - value of TUNITn keyword for each column */
+ char *extnm, /* O - value of EXTNAME keyword, if any */
+ int *status) /* IO - error status */
+/*
+ Get keywords from the Header of the ASCII TaBle:
+ Check that the keywords conform to the FITS standard and return the
+ parameters which describe the table.
+*/
+{
+ int ii, maxf, nfound, tstatus;
+ long fields;
+ char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
+ char xtension[FLEN_VALUE], message[81];
+ LONGLONG llnaxis1, llnaxis2, pcount;
+
+ if (*status > 0)
+ return(*status);
+
+ /* read the first keyword of the extension */
+ ffgkyn(fptr, 1, name, value, comm, status);
+
+ if (!strcmp(name, "XTENSION"))
+ {
+ if (ffc2s(value, xtension, status) > 0) /* get the value string */
+ {
+ ffpmsg("Bad value string for XTENSION keyword:");
+ ffpmsg(value);
+ return(*status);
+ }
+
+ /* allow the quoted string value to begin in any column and */
+ /* allow any number of trailing blanks before the closing quote */
+ if ( (value[0] != '\'') || /* first char must be a quote */
+ ( strcmp(xtension, "TABLE") ) )
+ {
+ sprintf(message,
+ "This is not a TABLE extension: %s", value);
+ ffpmsg(message);
+ return(*status = NOT_ATABLE);
+ }
+ }
+
+ else /* error: 1st keyword of extension != XTENSION */
+ {
+ sprintf(message,
+ "First keyword of the extension is not XTENSION: %s", name);
+ ffpmsg(message);
+ return(*status = NO_XTENSION);
+ }
+
+ if (ffgttb(fptr, &llnaxis1, &llnaxis2, &pcount, &fields, status) > 0)
+ return(*status);
+
+ if (naxis1)
+ *naxis1 = llnaxis1;
+
+ if (naxis2)
+ *naxis2 = llnaxis2;
+
+ if (pcount != 0)
+ {
+ sprintf(message, "PCOUNT = %.0f is illegal in ASCII table; must = 0",
+ (double) pcount);
+ ffpmsg(message);
+ return(*status = BAD_PCOUNT);
+ }
+
+ if (tfields)
+ *tfields = fields;
+
+ if (maxfield < 0)
+ maxf = fields;
+ else
+ maxf = minvalue(maxfield, fields);
+
+ if (maxf > 0)
+ {
+ for (ii = 0; ii < maxf; ii++)
+ { /* initialize optional keyword values */
+ if (ttype)
+ *ttype[ii] = '\0';
+
+ if (tunit)
+ *tunit[ii] = '\0';
+ }
+
+
+ if (ttype)
+ ffgkns(fptr, "TTYPE", 1, maxf, ttype, &nfound, status);
+
+ if (tunit)
+ ffgkns(fptr, "TUNIT", 1, maxf, tunit, &nfound, status);
+
+ if (*status > 0)
+ return(*status);
+
+ if (tbcol)
+ {
+ ffgknjj(fptr, "TBCOL", 1, maxf, tbcol, &nfound, status);
+
+ if (*status > 0 || nfound != maxf)
+ {
+ ffpmsg(
+ "Required TBCOL keyword(s) not found in ASCII table header (ffghtbll).");
+ return(*status = NO_TBCOL);
+ }
+ }
+
+ if (tform)
+ {
+ ffgkns(fptr, "TFORM", 1, maxf, tform, &nfound, status);
+
+ if (*status > 0 || nfound != maxf)
+ {
+ ffpmsg(
+ "Required TFORM keyword(s) not found in ASCII table header (ffghtbll).");
+ return(*status = NO_TFORM);
+ }
+ }
+ }
+
+ if (extnm)
+ {
+ extnm[0] = '\0';
+
+ tstatus = *status;
+ ffgkys(fptr, "EXTNAME", extnm, comm, status);
+
+ if (*status == KEY_NO_EXIST)
+ *status = tstatus; /* keyword not required, so ignore error */
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghbn(fitsfile *fptr, /* I - FITS file pointer */
+ int maxfield, /* I - maximum no. of columns to read; */
+ long *naxis2, /* O - number of rows in the table */
+ int *tfields, /* O - number of columns in the table */
+ char **ttype, /* O - name of each column */
+ char **tform, /* O - TFORMn value for each column */
+ char **tunit, /* O - TUNITn value for each column */
+ char *extnm, /* O - value of EXTNAME keyword, if any */
+ long *pcount, /* O - value of PCOUNT keyword */
+ int *status) /* IO - error status */
+/*
+ Get keywords from the Header of the BiNary table:
+ Check that the keywords conform to the FITS standard and return the
+ parameters which describe the table.
+*/
+{
+ int ii, maxf, nfound, tstatus;
+ long fields;
+ char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
+ char xtension[FLEN_VALUE], message[81];
+ LONGLONG naxis1ll, naxis2ll, pcountll;
+
+ if (*status > 0)
+ return(*status);
+
+ /* read the first keyword of the extension */
+ ffgkyn(fptr, 1, name, value, comm, status);
+
+ if (!strcmp(name, "XTENSION"))
+ {
+ if (ffc2s(value, xtension, status) > 0) /* get the value string */
+ {
+ ffpmsg("Bad value string for XTENSION keyword:");
+ ffpmsg(value);
+ return(*status);
+ }
+
+ /* allow the quoted string value to begin in any column and */
+ /* allow any number of trailing blanks before the closing quote */
+ if ( (value[0] != '\'') || /* first char must be a quote */
+ ( strcmp(xtension, "BINTABLE") &&
+ strcmp(xtension, "A3DTABLE") &&
+ strcmp(xtension, "3DTABLE")
+ ) )
+ {
+ sprintf(message,
+ "This is not a BINTABLE extension: %s", value);
+ ffpmsg(message);
+ return(*status = NOT_BTABLE);
+ }
+ }
+
+ else /* error: 1st keyword of extension != XTENSION */
+ {
+ sprintf(message,
+ "First keyword of the extension is not XTENSION: %s", name);
+ ffpmsg(message);
+ return(*status = NO_XTENSION);
+ }
+
+ if (ffgttb(fptr, &naxis1ll, &naxis2ll, &pcountll, &fields, status) > 0)
+ return(*status);
+
+ if (naxis2)
+ *naxis2 = (long) naxis2ll;
+
+ if (pcount)
+ *pcount = (long) pcountll;
+
+ if (tfields)
+ *tfields = fields;
+
+ if (maxfield < 0)
+ maxf = fields;
+ else
+ maxf = minvalue(maxfield, fields);
+
+ if (maxf > 0)
+ {
+ for (ii = 0; ii < maxf; ii++)
+ { /* initialize optional keyword values */
+ if (ttype)
+ *ttype[ii] = '\0';
+
+ if (tunit)
+ *tunit[ii] = '\0';
+ }
+
+ if (ttype)
+ ffgkns(fptr, "TTYPE", 1, maxf, ttype, &nfound, status);
+
+ if (tunit)
+ ffgkns(fptr, "TUNIT", 1, maxf, tunit, &nfound, status);
+
+ if (*status > 0)
+ return(*status);
+
+ if (tform)
+ {
+ ffgkns(fptr, "TFORM", 1, maxf, tform, &nfound, status);
+
+ if (*status > 0 || nfound != maxf)
+ {
+ ffpmsg(
+ "Required TFORM keyword(s) not found in binary table header (ffghbn).");
+ return(*status = NO_TFORM);
+ }
+ }
+ }
+
+ if (extnm)
+ {
+ extnm[0] = '\0';
+
+ tstatus = *status;
+ ffgkys(fptr, "EXTNAME", extnm, comm, status);
+
+ if (*status == KEY_NO_EXIST)
+ *status = tstatus; /* keyword not required, so ignore error */
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffghbnll(fitsfile *fptr, /* I - FITS file pointer */
+ int maxfield, /* I - maximum no. of columns to read; */
+ LONGLONG *naxis2, /* O - number of rows in the table */
+ int *tfields, /* O - number of columns in the table */
+ char **ttype, /* O - name of each column */
+ char **tform, /* O - TFORMn value for each column */
+ char **tunit, /* O - TUNITn value for each column */
+ char *extnm, /* O - value of EXTNAME keyword, if any */
+ LONGLONG *pcount, /* O - value of PCOUNT keyword */
+ int *status) /* IO - error status */
+/*
+ Get keywords from the Header of the BiNary table:
+ Check that the keywords conform to the FITS standard and return the
+ parameters which describe the table.
+*/
+{
+ int ii, maxf, nfound, tstatus;
+ long fields;
+ char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
+ char xtension[FLEN_VALUE], message[81];
+ LONGLONG naxis1ll, naxis2ll, pcountll;
+
+ if (*status > 0)
+ return(*status);
+
+ /* read the first keyword of the extension */
+ ffgkyn(fptr, 1, name, value, comm, status);
+
+ if (!strcmp(name, "XTENSION"))
+ {
+ if (ffc2s(value, xtension, status) > 0) /* get the value string */
+ {
+ ffpmsg("Bad value string for XTENSION keyword:");
+ ffpmsg(value);
+ return(*status);
+ }
+
+ /* allow the quoted string value to begin in any column and */
+ /* allow any number of trailing blanks before the closing quote */
+ if ( (value[0] != '\'') || /* first char must be a quote */
+ ( strcmp(xtension, "BINTABLE") &&
+ strcmp(xtension, "A3DTABLE") &&
+ strcmp(xtension, "3DTABLE")
+ ) )
+ {
+ sprintf(message,
+ "This is not a BINTABLE extension: %s", value);
+ ffpmsg(message);
+ return(*status = NOT_BTABLE);
+ }
+ }
+
+ else /* error: 1st keyword of extension != XTENSION */
+ {
+ sprintf(message,
+ "First keyword of the extension is not XTENSION: %s", name);
+ ffpmsg(message);
+ return(*status = NO_XTENSION);
+ }
+
+ if (ffgttb(fptr, &naxis1ll, &naxis2ll, &pcountll, &fields, status) > 0)
+ return(*status);
+
+ if (naxis2)
+ *naxis2 = naxis2ll;
+
+ if (pcount)
+ *pcount = pcountll;
+
+ if (tfields)
+ *tfields = fields;
+
+ if (maxfield < 0)
+ maxf = fields;
+ else
+ maxf = minvalue(maxfield, fields);
+
+ if (maxf > 0)
+ {
+ for (ii = 0; ii < maxf; ii++)
+ { /* initialize optional keyword values */
+ if (ttype)
+ *ttype[ii] = '\0';
+
+ if (tunit)
+ *tunit[ii] = '\0';
+ }
+
+ if (ttype)
+ ffgkns(fptr, "TTYPE", 1, maxf, ttype, &nfound, status);
+
+ if (tunit)
+ ffgkns(fptr, "TUNIT", 1, maxf, tunit, &nfound, status);
+
+ if (*status > 0)
+ return(*status);
+
+ if (tform)
+ {
+ ffgkns(fptr, "TFORM", 1, maxf, tform, &nfound, status);
+
+ if (*status > 0 || nfound != maxf)
+ {
+ ffpmsg(
+ "Required TFORM keyword(s) not found in binary table header (ffghbn).");
+ return(*status = NO_TFORM);
+ }
+ }
+ }
+
+ if (extnm)
+ {
+ extnm[0] = '\0';
+
+ tstatus = *status;
+ ffgkys(fptr, "EXTNAME", extnm, comm, status);
+
+ if (*status == KEY_NO_EXIST)
+ *status = tstatus; /* keyword not required, so ignore error */
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgphd(fitsfile *fptr, /* I - FITS file pointer */
+ int maxdim, /* I - maximum no. of dimensions to read; */
+ int *simple, /* O - does file conform to FITS standard? 1/0 */
+ int *bitpix, /* O - number of bits per data value pixel */
+ int *naxis, /* O - number of axes in the data array */
+ LONGLONG naxes[], /* O - length of each data axis */
+ long *pcount, /* O - number of group parameters (usually 0) */
+ long *gcount, /* O - number of random groups (usually 1 or 0) */
+ int *extend, /* O - may FITS file haave extensions? */
+ double *bscale, /* O - array pixel linear scaling factor */
+ double *bzero, /* O - array pixel linear scaling zero point */
+ LONGLONG *blank, /* O - value used to represent undefined pixels */
+ int *nspace, /* O - number of blank keywords prior to END */
+ int *status) /* IO - error status */
+{
+/*
+ Get the Primary HeaDer parameters. Check that the keywords conform to
+ the FITS standard and return the parameters which determine the size and
+ structure of the primary array or IMAGE extension.
+*/
+ int unknown, found_end, tstatus, ii, nextkey, namelen;
+ long longbitpix, longnaxis;
+ LONGLONG axislen;
+ char message[FLEN_ERRMSG], keyword[FLEN_KEYWORD];
+ char card[FLEN_CARD];
+ char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
+ char xtension[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if (simple)
+ *simple = 1;
+
+ unknown = 0;
+
+ /*--------------------------------------------------------------------*/
+ /* Get 1st keyword of HDU and test whether it is SIMPLE or XTENSION */
+ /*--------------------------------------------------------------------*/
+ ffgkyn(fptr, 1, name, value, comm, status);
+
+ if ((fptr->Fptr)->curhdu == 0) /* Is this the beginning of the FITS file? */
+ {
+ if (!strcmp(name, "SIMPLE"))
+ {
+ if (value[0] == 'F')
+ {
+ if (simple)
+ *simple=0; /* not a simple FITS file */
+ }
+ else if (value[0] != 'T')
+ return(*status = BAD_SIMPLE);
+ }
+
+ else
+ {
+ sprintf(message,
+ "First keyword of the file is not SIMPLE: %s", name);
+ ffpmsg(message);
+ return(*status = NO_SIMPLE);
+ }
+ }
+
+ else /* not beginning of the file, so presumably an IMAGE extension */
+ { /* or it could be a compressed image in a binary table */
+
+ if (!strcmp(name, "XTENSION"))
+ {
+ if (ffc2s(value, xtension, status) > 0) /* get the value string */
+ {
+ ffpmsg("Bad value string for XTENSION keyword:");
+ ffpmsg(value);
+ return(*status);
+ }
+
+ /* allow the quoted string value to begin in any column and */
+ /* allow any number of trailing blanks before the closing quote */
+ if ( (value[0] != '\'') || /* first char must be a quote */
+ ( strcmp(xtension, "IMAGE") &&
+ strcmp(xtension, "IUEIMAGE") ) )
+ {
+ unknown = 1; /* unknown type of extension; press on anyway */
+ sprintf(message,
+ "This is not an IMAGE extension: %s", value);
+ ffpmsg(message);
+ }
+ }
+
+ else /* error: 1st keyword of extension != XTENSION */
+ {
+ sprintf(message,
+ "First keyword of the extension is not XTENSION: %s", name);
+ ffpmsg(message);
+ return(*status = NO_XTENSION);
+ }
+ }
+
+ if (unknown && (fptr->Fptr)->compressimg)
+ {
+ /* this is a compressed image, so read ZBITPIX, ZNAXIS keywords */
+ unknown = 0; /* reset flag */
+ ffxmsg(3, message); /* clear previous spurious error message */
+
+ if (bitpix)
+ {
+ ffgidt(fptr, bitpix, status); /* get bitpix value */
+
+ if (*status > 0)
+ {
+ ffpmsg("Error reading BITPIX value of compressed image");
+ return(*status);
+ }
+ }
+
+ if (naxis)
+ {
+ ffgidm(fptr, naxis, status); /* get NAXIS value */
+
+ if (*status > 0)
+ {
+ ffpmsg("Error reading NAXIS value of compressed image");
+ return(*status);
+ }
+ }
+
+ if (naxes)
+ {
+ ffgiszll(fptr, maxdim, naxes, status); /* get NAXISn value */
+
+ if (*status > 0)
+ {
+ ffpmsg("Error reading NAXISn values of compressed image");
+ return(*status);
+ }
+ }
+
+ nextkey = 9; /* skip required table keywords in the following search */
+ }
+ else
+ {
+
+ /*----------------------------------------------------------------*/
+ /* Get 2nd keyword; test whether it is BITPIX with legal value */
+ /*----------------------------------------------------------------*/
+ ffgkyn(fptr, 2, name, value, comm, status); /* BITPIX = 2nd keyword */
+
+ if (strcmp(name, "BITPIX"))
+ {
+ sprintf(message,
+ "Second keyword of the extension is not BITPIX: %s", name);
+ ffpmsg(message);
+ return(*status = NO_BITPIX);
+ }
+
+ if (ffc2ii(value, &longbitpix, status) > 0)
+ {
+ sprintf(message,
+ "Value of BITPIX keyword is not an integer: %s", value);
+ ffpmsg(message);
+ return(*status = BAD_BITPIX);
+ }
+ else if (longbitpix != BYTE_IMG && longbitpix != SHORT_IMG &&
+ longbitpix != LONG_IMG && longbitpix != LONGLONG_IMG &&
+ longbitpix != FLOAT_IMG && longbitpix != DOUBLE_IMG)
+ {
+ sprintf(message,
+ "Illegal value for BITPIX keyword: %s", value);
+ ffpmsg(message);
+ return(*status = BAD_BITPIX);
+ }
+ if (bitpix)
+ *bitpix = longbitpix; /* do explicit type conversion */
+
+ /*---------------------------------------------------------------*/
+ /* Get 3rd keyword; test whether it is NAXIS with legal value */
+ /*---------------------------------------------------------------*/
+ ffgtkn(fptr, 3, "NAXIS", &longnaxis, status);
+
+ if (*status == BAD_ORDER)
+ return(*status = NO_NAXIS);
+ else if (*status == NOT_POS_INT || longnaxis > 999)
+ {
+ sprintf(message,"NAXIS = %ld is illegal", longnaxis);
+ ffpmsg(message);
+ return(*status = BAD_NAXIS);
+ }
+ else
+ if (naxis)
+ *naxis = longnaxis; /* do explicit type conversion */
+
+ /*---------------------------------------------------------*/
+ /* Get the next NAXISn keywords and test for legal values */
+ /*---------------------------------------------------------*/
+ for (ii=0, nextkey=4; ii < longnaxis; ii++, nextkey++)
+ {
+ ffkeyn("NAXIS", ii+1, keyword, status);
+ ffgtknjj(fptr, 4+ii, keyword, &axislen, status);
+
+ if (*status == BAD_ORDER)
+ return(*status = NO_NAXES);
+ else if (*status == NOT_POS_INT)
+ return(*status = BAD_NAXES);
+ else if (ii < maxdim)
+ if (naxes)
+ naxes[ii] = axislen;
+ }
+ }
+
+ /*---------------------------------------------------------*/
+ /* now look for other keywords of interest: */
+ /* BSCALE, BZERO, BLANK, PCOUNT, GCOUNT, EXTEND, and END */
+ /*---------------------------------------------------------*/
+
+ /* initialize default values in case keyword is not present */
+ if (bscale)
+ *bscale = 1.0;
+ if (bzero)
+ *bzero = 0.0;
+ if (pcount)
+ *pcount = 0;
+ if (gcount)
+ *gcount = 1;
+ if (extend)
+ *extend = 0;
+ if (blank)
+ *blank = NULL_UNDEFINED; /* no default null value for BITPIX=8,16,32 */
+
+ *nspace = 0;
+ found_end = 0;
+ tstatus = *status;
+
+ for (; !found_end; nextkey++)
+ {
+ /* get next keyword */
+ /* don't use ffgkyn here because it trys to parse the card to read */
+ /* the value string, thus failing to read the file just because of */
+ /* minor syntax errors in optional keywords. */
+
+ if (ffgrec(fptr, nextkey, card, status) > 0 ) /* get the 80-byte card */
+ {
+ if (*status == KEY_OUT_BOUNDS)
+ {
+ found_end = 1; /* simply hit the end of the header */
+ *status = tstatus; /* reset error status */
+ }
+ else
+ {
+ ffpmsg("Failed to find the END keyword in header (ffgphd).");
+ }
+ }
+ else /* got the next keyword without error */
+ {
+ ffgknm(card, name, &namelen, status); /* get the keyword name */
+
+ if (fftrec(name, status) > 0) /* test keyword name; catches no END */
+ {
+ sprintf(message,
+ "Name of keyword no. %d contains illegal character(s): %s",
+ nextkey, name);
+ ffpmsg(message);
+
+ if (nextkey % 36 == 0) /* test if at beginning of 36-card record */
+ ffpmsg(" (This may indicate a missing END keyword).");
+ }
+
+ if (!strcmp(name, "BSCALE") && bscale)
+ {
+ *nspace = 0; /* reset count of blank keywords */
+ ffpsvc(card, value, comm, status); /* parse value and comment */
+
+ if (ffc2dd(value, bscale, status) > 0) /* convert to double */
+ {
+ /* reset error status and continue, but still issue warning */
+ *status = tstatus;
+ *bscale = 1.0;
+
+ sprintf(message,
+ "Error reading BSCALE keyword value as a double: %s", value);
+ ffpmsg(message);
+ }
+ }
+
+ else if (!strcmp(name, "BZERO") && bzero)
+ {
+ *nspace = 0; /* reset count of blank keywords */
+ ffpsvc(card, value, comm, status); /* parse value and comment */
+
+ if (ffc2dd(value, bzero, status) > 0) /* convert to double */
+ {
+ /* reset error status and continue, but still issue warning */
+ *status = tstatus;
+ *bzero = 0.0;
+
+ sprintf(message,
+ "Error reading BZERO keyword value as a double: %s", value);
+ ffpmsg(message);
+ }
+ }
+
+ else if (!strcmp(name, "BLANK") && blank)
+ {
+ *nspace = 0; /* reset count of blank keywords */
+ ffpsvc(card, value, comm, status); /* parse value and comment */
+
+ if (ffc2jj(value, blank, status) > 0) /* convert to LONGLONG */
+ {
+ /* reset error status and continue, but still issue warning */
+ *status = tstatus;
+ *blank = NULL_UNDEFINED;
+
+ sprintf(message,
+ "Error reading BLANK keyword value as an integer: %s", value);
+ ffpmsg(message);
+ }
+ }
+
+ else if (!strcmp(name, "PCOUNT") && pcount)
+ {
+ *nspace = 0; /* reset count of blank keywords */
+ ffpsvc(card, value, comm, status); /* parse value and comment */
+
+ if (ffc2ii(value, pcount, status) > 0) /* convert to long */
+ {
+ sprintf(message,
+ "Error reading PCOUNT keyword value as an integer: %s", value);
+ ffpmsg(message);
+ }
+ }
+
+ else if (!strcmp(name, "GCOUNT") && gcount)
+ {
+ *nspace = 0; /* reset count of blank keywords */
+ ffpsvc(card, value, comm, status); /* parse value and comment */
+
+ if (ffc2ii(value, gcount, status) > 0) /* convert to long */
+ {
+ sprintf(message,
+ "Error reading GCOUNT keyword value as an integer: %s", value);
+ ffpmsg(message);
+ }
+ }
+
+ else if (!strcmp(name, "EXTEND") && extend)
+ {
+ *nspace = 0; /* reset count of blank keywords */
+ ffpsvc(card, value, comm, status); /* parse value and comment */
+
+ if (ffc2ll(value, extend, status) > 0) /* convert to logical */
+ {
+ /* reset error status and continue, but still issue warning */
+ *status = tstatus;
+ *extend = 0;
+
+ sprintf(message,
+ "Error reading EXTEND keyword value as a logical: %s", value);
+ ffpmsg(message);
+ }
+ }
+
+ else if (!strcmp(name, "END"))
+ found_end = 1;
+
+ else if (!card[0] )
+ *nspace = *nspace + 1; /* this is a blank card in the header */
+
+ else
+ *nspace = 0; /* reset count of blank keywords immediately
+ before the END keyword to zero */
+ }
+
+ if (*status > 0) /* exit on error after writing error message */
+ {
+ if ((fptr->Fptr)->curhdu == 0)
+ ffpmsg(
+ "Failed to read the required primary array header keywords.");
+ else
+ ffpmsg(
+ "Failed to read the required image extension header keywords.");
+
+ return(*status);
+ }
+ }
+
+ if (unknown)
+ *status = NOT_IMAGE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgttb(fitsfile *fptr, /* I - FITS file pointer*/
+ LONGLONG *rowlen, /* O - length of a table row, in bytes */
+ LONGLONG *nrows, /* O - number of rows in the table */
+ LONGLONG *pcount, /* O - value of PCOUNT keyword */
+ long *tfields, /* O - number of fields in the table */
+ int *status) /* IO - error status */
+{
+/*
+ Get and Test TaBle;
+ Test that this is a legal ASCII or binary table and get some keyword values.
+ We assume that the calling routine has already tested the 1st keyword
+ of the extension to ensure that this is really a table extension.
+*/
+ if (*status > 0)
+ return(*status);
+
+ if (fftkyn(fptr, 2, "BITPIX", "8", status) == BAD_ORDER) /* 2nd keyword */
+ return(*status = NO_BITPIX); /* keyword not BITPIX */
+ else if (*status == NOT_POS_INT)
+ return(*status = BAD_BITPIX); /* value != 8 */
+
+ if (fftkyn(fptr, 3, "NAXIS", "2", status) == BAD_ORDER) /* 3rd keyword */
+ return(*status = NO_NAXIS); /* keyword not NAXIS */
+ else if (*status == NOT_POS_INT)
+ return(*status = BAD_NAXIS); /* value != 2 */
+
+ if (ffgtknjj(fptr, 4, "NAXIS1", rowlen, status) == BAD_ORDER) /* 4th key */
+ return(*status = NO_NAXES); /* keyword not NAXIS1 */
+ else if (*status == NOT_POS_INT)
+ return(*status == BAD_NAXES); /* bad NAXIS1 value */
+
+ if (ffgtknjj(fptr, 5, "NAXIS2", nrows, status) == BAD_ORDER) /* 5th key */
+ return(*status = NO_NAXES); /* keyword not NAXIS2 */
+ else if (*status == NOT_POS_INT)
+ return(*status == BAD_NAXES); /* bad NAXIS2 value */
+
+ if (ffgtknjj(fptr, 6, "PCOUNT", pcount, status) == BAD_ORDER) /* 6th key */
+ return(*status = NO_PCOUNT); /* keyword not PCOUNT */
+ else if (*status == NOT_POS_INT)
+ return(*status = BAD_PCOUNT); /* bad PCOUNT value */
+
+ if (fftkyn(fptr, 7, "GCOUNT", "1", status) == BAD_ORDER) /* 7th keyword */
+ return(*status = NO_GCOUNT); /* keyword not GCOUNT */
+ else if (*status == NOT_POS_INT)
+ return(*status = BAD_GCOUNT); /* value != 1 */
+
+ if (ffgtkn(fptr, 8, "TFIELDS", tfields, status) == BAD_ORDER) /* 8th key*/
+ return(*status = NO_TFIELDS); /* keyword not TFIELDS */
+ else if (*status == NOT_POS_INT || *tfields > 999)
+ return(*status == BAD_TFIELDS); /* bad TFIELDS value */
+
+
+ if (*status > 0)
+ ffpmsg(
+ "Error reading required keywords in the table header (FTGTTB).");
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtkn(fitsfile *fptr, /* I - FITS file pointer */
+ int numkey, /* I - number of the keyword to read */
+ char *name, /* I - expected name of the keyword */
+ long *value, /* O - integer value of the keyword */
+ int *status) /* IO - error status */
+{
+/*
+ test that keyword number NUMKEY has the expected name and get the
+ integer value of the keyword. Return an error if the keyword
+ name does not match the input name, or if the value of the
+ keyword is not a positive integer.
+*/
+ char keyname[FLEN_KEYWORD], valuestring[FLEN_VALUE];
+ char comm[FLEN_COMMENT], message[FLEN_ERRMSG];
+
+ if (*status > 0)
+ return(*status);
+
+ keyname[0] = '\0';
+ valuestring[0] = '\0';
+
+ if (ffgkyn(fptr, numkey, keyname, valuestring, comm, status) <= 0)
+ {
+ if (strcmp(keyname, name) )
+ *status = BAD_ORDER; /* incorrect keyword name */
+
+ else
+ {
+ ffc2ii(valuestring, value, status); /* convert to integer */
+
+ if (*status > 0 || *value < 0 )
+ *status = NOT_POS_INT;
+ }
+
+ if (*status > 0)
+ {
+ sprintf(message,
+ "ffgtkn found unexpected keyword or value for keyword no. %d.",
+ numkey);
+ ffpmsg(message);
+
+ sprintf(message,
+ " Expected positive integer keyword %s, but instead", name);
+ ffpmsg(message);
+
+ sprintf(message,
+ " found keyword %s with value %s", keyname, valuestring);
+ ffpmsg(message);
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtknjj(fitsfile *fptr, /* I - FITS file pointer */
+ int numkey, /* I - number of the keyword to read */
+ char *name, /* I - expected name of the keyword */
+ LONGLONG *value, /* O - integer value of the keyword */
+ int *status) /* IO - error status */
+{
+/*
+ test that keyword number NUMKEY has the expected name and get the
+ integer value of the keyword. Return an error if the keyword
+ name does not match the input name, or if the value of the
+ keyword is not a positive integer.
+*/
+ char keyname[FLEN_KEYWORD], valuestring[FLEN_VALUE];
+ char comm[FLEN_COMMENT], message[FLEN_ERRMSG];
+
+ if (*status > 0)
+ return(*status);
+
+ keyname[0] = '\0';
+ valuestring[0] = '\0';
+
+ if (ffgkyn(fptr, numkey, keyname, valuestring, comm, status) <= 0)
+ {
+ if (strcmp(keyname, name) )
+ *status = BAD_ORDER; /* incorrect keyword name */
+
+ else
+ {
+ ffc2jj(valuestring, value, status); /* convert to integer */
+
+ if (*status > 0 || *value < 0 )
+ *status = NOT_POS_INT;
+ }
+
+ if (*status > 0)
+ {
+ sprintf(message,
+ "ffgtknjj found unexpected keyword or value for keyword no. %d.",
+ numkey);
+ ffpmsg(message);
+
+ sprintf(message,
+ " Expected positive integer keyword %s, but instead", name);
+ ffpmsg(message);
+
+ sprintf(message,
+ " found keyword %s with value %s", keyname, valuestring);
+ ffpmsg(message);
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fftkyn(fitsfile *fptr, /* I - FITS file pointer */
+ int numkey, /* I - number of the keyword to read */
+ char *name, /* I - expected name of the keyword */
+ char *value, /* I - expected value of the keyword */
+ int *status) /* IO - error status */
+{
+/*
+ test that keyword number NUMKEY has the expected name and the
+ expected value string.
+*/
+ char keyname[FLEN_KEYWORD], valuestring[FLEN_VALUE];
+ char comm[FLEN_COMMENT], message[FLEN_ERRMSG];
+
+ if (*status > 0)
+ return(*status);
+
+ keyname[0] = '\0';
+ valuestring[0] = '\0';
+
+ if (ffgkyn(fptr, numkey, keyname, valuestring, comm, status) <= 0)
+ {
+ if (strcmp(keyname, name) )
+ *status = BAD_ORDER; /* incorrect keyword name */
+
+ if (strcmp(value, valuestring) )
+ *status = NOT_POS_INT; /* incorrect keyword value */
+ }
+
+ if (*status > 0)
+ {
+ sprintf(message,
+ "fftkyn found unexpected keyword or value for keyword no. %d.",
+ numkey);
+ ffpmsg(message);
+
+ sprintf(message,
+ " Expected keyword %s with value %s, but", name, value);
+ ffpmsg(message);
+
+ sprintf(message,
+ " found keyword %s with value %s", keyname, valuestring);
+ ffpmsg(message);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffh2st(fitsfile *fptr, /* I - FITS file pointer */
+ char **header, /* O - returned header string */
+ int *status) /* IO - error status */
+
+/*
+ read header keywords into a long string of chars. This routine allocates
+ memory for the string, so the calling routine must eventually free the
+ memory when it is not needed any more.
+*/
+{
+ int nkeys;
+ long nrec;
+ LONGLONG headstart;
+
+ if (*status > 0)
+ return(*status);
+
+ /* get number of keywords in the header (doesn't include END) */
+ if (ffghsp(fptr, &nkeys, NULL, status) > 0)
+ return(*status);
+
+ nrec = (nkeys / 36 + 1);
+
+ /* allocate memory for all the keywords (multiple of 2880 bytes) */
+ *header = (char *) calloc ( nrec * 2880 + 1, 1);
+ if (!(*header))
+ {
+ *status = MEMORY_ALLOCATION;
+ ffpmsg("failed to allocate memory to hold all the header keywords");
+ return(*status);
+ }
+
+ ffghadll(fptr, &headstart, NULL, NULL, status); /* get header address */
+ ffmbyt(fptr, headstart, REPORT_EOF, status); /* move to header */
+ ffgbyt(fptr, nrec * 2880, *header, status); /* copy header */
+ *(*header + (nrec * 2880)) = '\0';
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffhdr2str( fitsfile *fptr, /* I - FITS file pointer */
+ int exclude_comm, /* I - if TRUE, exclude commentary keywords */
+ char **exclist, /* I - list of excluded keyword names */
+ int nexc, /* I - number of names in exclist */
+ char **header, /* O - returned header string */
+ int *nkeys, /* O - returned number of 80-char keywords */
+ int *status) /* IO - error status */
+/*
+ read header keywords into a long string of chars. This routine allocates
+ memory for the string, so the calling routine must eventually free the
+ memory when it is not needed any more. If exclude_comm is TRUE, then all
+ the COMMENT, HISTORY, and <blank> keywords will be excluded from the output
+ string of keywords. Any other list of keywords to be excluded may be
+ specified with the exclist parameter.
+*/
+{
+ int casesn, match, exact, totkeys;
+ long ii, jj;
+ char keybuf[162], keyname[FLEN_KEYWORD], *headptr;
+
+ *nkeys = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* get number of keywords in the header (doesn't include END) */
+ if (ffghsp(fptr, &totkeys, NULL, status) > 0)
+ return(*status);
+
+ /* allocate memory for all the keywords */
+ /* (will reallocate it later to minimize the memory size) */
+
+ *header = (char *) calloc ( (totkeys + 1) * 80 + 1, 1);
+ if (!(*header))
+ {
+ *status = MEMORY_ALLOCATION;
+ ffpmsg("failed to allocate memory to hold all the header keywords");
+ return(*status);
+ }
+
+ headptr = *header;
+ casesn = FALSE;
+
+ /* read every keyword */
+ for (ii = 1; ii <= totkeys; ii++)
+ {
+ ffgrec(fptr, ii, keybuf, status);
+ /* pad record with blanks so that it is at least 80 chars long */
+ strcat(keybuf,
+ " ");
+
+ keyname[0] = '\0';
+ strncat(keyname, keybuf, 8); /* copy the keyword name */
+
+ if (exclude_comm)
+ {
+ if (!FSTRCMP("COMMENT ", keyname) ||
+ !FSTRCMP("HISTORY ", keyname) ||
+ !FSTRCMP(" ", keyname) )
+ continue; /* skip this commentary keyword */
+ }
+
+ /* does keyword match any names in the exclusion list? */
+ for (jj = 0; jj < nexc; jj++ )
+ {
+ ffcmps(exclist[jj], keyname, casesn, &match, &exact);
+ if (match)
+ break;
+ }
+
+ if (jj == nexc)
+ {
+ /* not in exclusion list, add this keyword to the string */
+ strcpy(headptr, keybuf);
+ headptr += 80;
+ (*nkeys)++;
+ }
+ }
+
+ /* add the END keyword */
+ strcpy(headptr,
+ "END ");
+ headptr += 80;
+ (*nkeys)++;
+
+ *headptr = '\0'; /* terminate the header string */
+ /* minimize the allocated memory */
+ *header = (char *) realloc(*header, (*nkeys *80) + 1);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcnvthdr2str( fitsfile *fptr, /* I - FITS file pointer */
+ int exclude_comm, /* I - if TRUE, exclude commentary keywords */
+ char **exclist, /* I - list of excluded keyword names */
+ int nexc, /* I - number of names in exclist */
+ char **header, /* O - returned header string */
+ int *nkeys, /* O - returned number of 80-char keywords */
+ int *status) /* IO - error status */
+/*
+ Same as ffhdr2str, except that if the input HDU is a tile compressed image
+ (stored in a binary table) then it will first convert that header back
+ to that of a normal uncompressed FITS image before concatenating the header
+ keyword records.
+*/
+{
+ fitsfile *tempfptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status) )
+ {
+ /* this is a tile compressed image, so need to make an uncompressed */
+ /* copy of the image header in memory before concatenating the keywords */
+ if (fits_create_file(&tempfptr, "mem://", status) > 0) {
+ return(*status);
+ }
+
+ if (fits_img_decompress_header(fptr, tempfptr, status) > 0) {
+ fits_delete_file(tempfptr, status);
+ return(*status);
+ }
+
+ ffhdr2str(tempfptr, exclude_comm, exclist, nexc, header, nkeys, status);
+ fits_close_file(tempfptr, status);
+
+ } else {
+ ffhdr2str(fptr, exclude_comm, exclist, nexc, header, nkeys, status);
+ }
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/group.c b/src/plugins/cfitsio/group.c
new file mode 100644
index 0000000..2883e72
--- /dev/null
+++ b/src/plugins/cfitsio/group.c
@@ -0,0 +1,6463 @@
+/* This file, group.c, contains the grouping convention suport routines. */
+
+/* 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. */
+/* */
+/* The group.c module of CFITSIO was written by Donald G. Jennings of */
+/* the INTEGRAL Science Data Centre (ISDC) under NASA contract task */
+/* 66002J6. The above copyright laws apply. Copyright guidelines of The */
+/* University of Geneva might also apply. */
+
+/* The following routines are designed to create, read, and manipulate */
+/* FITS Grouping Tables as defined in the FITS Grouping Convention paper */
+/* by Jennings, Pence, Folk and Schlesinger. The development of the */
+/* grouping structure was partially funded under the NASA AISRP Program. */
+
+#include "fitsio2.h"
+#include "group.h"
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+
+#if defined(WIN32) || defined(__WIN32__)
+#include <direct.h> /* defines the getcwd function on Windows PCs */
+#endif
+
+#if defined(unix) || defined(__unix__) || defined(__unix)
+#include <unistd.h> /* needed for getcwd prototype on unix machines */
+#endif
+
+#define HEX_ESCAPE '%'
+
+/*---------------------------------------------------------------------------
+ Change record:
+
+D. Jennings, 18/06/98, version 1.0 of group module delivered to B. Pence for
+ integration into CFITSIO 2.005
+
+D. Jennings, 17/11/98, fixed bug in ffgtcpr(). Now use fits_find_nextkey()
+ correctly and insert auxiliary keyword records
+ directly before the TTYPE1 keyword in the copied
+ group table.
+
+D. Jennings, 22/01/99, ffgmop() now looks for relative file paths when
+ the MEMBER_LOCATION information is given in a
+ grouping table.
+
+D. Jennings, 01/02/99, ffgtop() now looks for relatve file paths when
+ the GRPLCn keyword value is supplied in the member
+ HDU header.
+
+D. Jennings, 01/02/99, ffgtam() now trys to construct relative file paths
+ from the member's file to the group table's file
+ (and visa versa) when both the member's file and
+ group table file are of access type FILE://.
+
+D. Jennings, 05/05/99, removed the ffgtcn() function; made obsolete by
+ fits_get_url().
+
+D. Jennings, 05/05/99, updated entire module to handle partial URLs and
+ absolute URLs more robustly. Host dependent directory
+ paths are now converted to true URLs before being
+ read from/written to grouping tables.
+
+D. Jennings, 05/05/99, added the following new functions (note, none of these
+ are directly callable by the application)
+
+ int fits_path2url()
+ int fits_url2path()
+ int fits_get_cwd()
+ int fits_get_url()
+ int fits_clean_url()
+ int fits_relurl2url()
+ int fits_encode_url()
+ int fits_unencode_url()
+ int fits_is_url_absolute()
+
+-----------------------------------------------------------------------------*/
+
+/*---------------------------------------------------------------------------*/
+int ffgtcr(fitsfile *fptr, /* FITS file pointer */
+ char *grpname, /* name of the grouping table */
+ int grouptype, /* code specifying the type of
+ grouping table information:
+ GT_ID_ALL_URI 0 ==> defualt (all columns)
+ GT_ID_REF 1 ==> ID by reference
+ GT_ID_POS 2 ==> ID by position
+ GT_ID_ALL 3 ==> ID by ref. and position
+ GT_ID_REF_URI 11 ==> (1) + URI info
+ GT_ID_POS_URI 12 ==> (2) + URI info */
+ int *status )/* return status code */
+
+/*
+ create a grouping table at the end of the current FITS file. This
+ function makes the last HDU in the file the CHDU, then calls the
+ fits_insert_group() function to actually create the new grouping table.
+*/
+
+{
+ int hdutype;
+ int hdunum;
+
+
+ if(*status != 0) return(*status);
+
+
+ *status = fits_get_num_hdus(fptr,&hdunum,status);
+
+ /* If hdunum is 0 then we are at the beginning of the file and
+ we actually haven't closed the first header yet, so don't do
+ anything more */
+
+ if (0 != hdunum) {
+
+ *status = fits_movabs_hdu(fptr,hdunum,&hdutype,status);
+ }
+
+ /* Now, the whole point of the above two fits_ calls was to get to
+ the end of file. Let's ignore errors at this point and keep
+ going since any error is likely to mean that we are already at the
+ EOF, or the file is fatally corrupted. If we are at the EOF then
+ the next fits_ call will be ok. If it's corrupted then the
+ next call will fail, but that's not big deal at this point.
+ */
+
+ if (0 != *status ) *status = 0;
+
+ *status = fits_insert_group(fptr,grpname,grouptype,status);
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgtis(fitsfile *fptr, /* FITS file pointer */
+ char *grpname, /* name of the grouping table */
+ int grouptype, /* code specifying the type of
+ grouping table information:
+ GT_ID_ALL_URI 0 ==> defualt (all columns)
+ GT_ID_REF 1 ==> ID by reference
+ GT_ID_POS 2 ==> ID by position
+ GT_ID_ALL 3 ==> ID by ref. and position
+ GT_ID_REF_URI 11 ==> (1) + URI info
+ GT_ID_POS_URI 12 ==> (2) + URI info */
+ int *status) /* return status code */
+
+/*
+ insert a grouping table just after the current HDU of the current FITS file.
+ This is the same as fits_create_group() only it allows the user to select
+ the place within the FITS file to add the grouping table.
+*/
+
+{
+
+ int tfields = 0;
+ int hdunum = 0;
+ int hdutype = 0;
+ int extver;
+ int i;
+
+ long pcount = 0;
+
+ char *ttype[6];
+ char *tform[6];
+
+ char ttypeBuff[102];
+ char tformBuff[54];
+
+ char extname[] = "GROUPING";
+ char keyword[FLEN_KEYWORD];
+ char keyvalue[FLEN_VALUE];
+ char comment[FLEN_COMMENT];
+
+ do
+ {
+
+ /* set up the ttype and tform character buffers */
+
+ for(i = 0; i < 6; ++i)
+ {
+ ttype[i] = ttypeBuff+(i*17);
+ tform[i] = tformBuff+(i*9);
+ }
+
+ /* define the columns required according to the grouptype parameter */
+
+ *status = ffgtdc(grouptype,0,0,0,0,0,0,ttype,tform,&tfields,status);
+
+ /* create the grouping table using the columns defined above */
+
+ *status = fits_insert_btbl(fptr,0,tfields,ttype,tform,NULL,
+ NULL,pcount,status);
+
+ if(*status != 0) continue;
+
+ /*
+ retrieve the hdu position of the new grouping table for
+ future use
+ */
+
+ fits_get_hdu_num(fptr,&hdunum);
+
+ /*
+ add the EXTNAME and EXTVER keywords to the HDU just after the
+ TFIELDS keyword; for now the EXTVER value is set to 0, it will be
+ set to the correct value later on
+ */
+
+ fits_read_keyword(fptr,"TFIELDS",keyvalue,comment,status);
+
+ fits_insert_key_str(fptr,"EXTNAME",extname,
+ "HDU contains a Grouping Table",status);
+ fits_insert_key_lng(fptr,"EXTVER",0,"Grouping Table vers. (this file)",
+ status);
+
+ /*
+ if the grpname parameter value was defined (Non NULL and non zero
+ length) then add the GRPNAME keyword and value
+ */
+
+ if(grpname != NULL && strlen(grpname) > 0)
+ fits_insert_key_str(fptr,"GRPNAME",grpname,"Grouping Table name",
+ status);
+
+ /*
+ add the TNULL keywords and values for each integer column defined;
+ integer null values are zero (0) for the MEMBER_POSITION and
+ MEMBER_VERSION columns.
+ */
+
+ for(i = 0; i < tfields && *status == 0; ++i)
+ {
+ if(strcasecmp(ttype[i],"MEMBER_POSITION") == 0 ||
+ strcasecmp(ttype[i],"MEMBER_VERSION") == 0)
+ {
+ sprintf(keyword,"TFORM%d",i+1);
+ *status = fits_read_key_str(fptr,keyword,keyvalue,comment,
+ status);
+
+ sprintf(keyword,"TNULL%d",i+1);
+
+ *status = fits_insert_key_lng(fptr,keyword,0,"Column Null Value",
+ status);
+ }
+ }
+
+ /*
+ determine the correct EXTVER value for the new grouping table
+ by finding the highest numbered grouping table EXTVER value
+ the currently exists
+ */
+
+ for(extver = 1;
+ (fits_movnam_hdu(fptr,ANY_HDU,"GROUPING",extver,status)) == 0;
+ ++extver);
+
+ if(*status == BAD_HDU_NUM) *status = 0;
+
+ /*
+ move back to the new grouping table HDU and update the EXTVER
+ keyword value
+ */
+
+ fits_movabs_hdu(fptr,hdunum,&hdutype,status);
+
+ fits_modify_key_lng(fptr,"EXTVER",extver,"&",status);
+
+ }while(0);
+
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgtch(fitsfile *gfptr, /* FITS pointer to group */
+ int grouptype, /* code specifying the type of
+ grouping table information:
+ GT_ID_ALL_URI 0 ==> defualt (all columns)
+ GT_ID_REF 1 ==> ID by reference
+ GT_ID_POS 2 ==> ID by position
+ GT_ID_ALL 3 ==> ID by ref. and position
+ GT_ID_REF_URI 11 ==> (1) + URI info
+ GT_ID_POS_URI 12 ==> (2) + URI info */
+ int *status) /* return status code */
+
+
+/*
+ Change the grouping table structure of the grouping table pointed to by
+ gfptr. The grouptype code specifies the new structure of the table. This
+ operation only adds or removes grouping table columns, it does not add
+ or delete group members (i.e., table rows). If the grouping table already
+ has the desired structure then no operations are performed and function
+ simply returns with a (0) success status code. If the requested structure
+ change creates new grouping table columns, then the column values for all
+ existing members will be filled with the appropriate null values.
+*/
+
+{
+ int xtensionCol, extnameCol, extverCol, positionCol, locationCol, uriCol;
+ int ncols = 0;
+ int colnum = 0;
+ int nrows = 0;
+ int grptype = 0;
+ int i,j;
+
+ long intNull = 0;
+ long tfields = 0;
+
+ char *tform[6];
+ char *ttype[6];
+
+ unsigned char charNull[1] = {'\0'};
+
+ char ttypeBuff[102];
+ char tformBuff[54];
+
+ char keyword[FLEN_KEYWORD];
+ char keyvalue[FLEN_VALUE];
+ char comment[FLEN_COMMENT];
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /* set up the ttype and tform character buffers */
+
+ for(i = 0; i < 6; ++i)
+ {
+ ttype[i] = ttypeBuff+(i*17);
+ tform[i] = tformBuff+(i*9);
+ }
+
+ /* retrieve positions of all Grouping table reserved columns */
+
+ *status = ffgtgc(gfptr,&xtensionCol,&extnameCol,&extverCol,&positionCol,
+ &locationCol,&uriCol,&grptype,status);
+
+ if(*status != 0) continue;
+
+ /* determine the total number of grouping table columns */
+
+ *status = fits_read_key_lng(gfptr,"TFIELDS",&tfields,comment,status);
+
+ /* define grouping table columns to be added to the configuration */
+
+ *status = ffgtdc(grouptype,xtensionCol,extnameCol,extverCol,positionCol,
+ locationCol,uriCol,ttype,tform,&ncols,status);
+
+ /*
+ delete any grouping tables columns that exist but do not belong to
+ new desired configuration; note that we delete before creating new
+ columns for (file size) efficiency reasons
+ */
+
+ switch(grouptype)
+ {
+
+ case GT_ID_ALL_URI:
+
+ /* no columns to be deleted in this case */
+
+ break;
+
+ case GT_ID_REF:
+
+ if(positionCol != 0)
+ {
+ *status = fits_delete_col(gfptr,positionCol,status);
+ --tfields;
+ if(uriCol > positionCol) --uriCol;
+ if(locationCol > positionCol) --locationCol;
+ }
+ if(uriCol != 0)
+ {
+ *status = fits_delete_col(gfptr,uriCol,status);
+ --tfields;
+ if(locationCol > uriCol) --locationCol;
+ }
+ if(locationCol != 0)
+ *status = fits_delete_col(gfptr,locationCol,status);
+
+ break;
+
+ case GT_ID_POS:
+
+ if(xtensionCol != 0)
+ {
+ *status = fits_delete_col(gfptr,xtensionCol,status);
+ --tfields;
+ if(extnameCol > xtensionCol) --extnameCol;
+ if(extverCol > xtensionCol) --extverCol;
+ if(uriCol > xtensionCol) --uriCol;
+ if(locationCol > xtensionCol) --locationCol;
+ }
+ if(extnameCol != 0)
+ {
+ *status = fits_delete_col(gfptr,extnameCol,status);
+ --tfields;
+ if(extverCol > extnameCol) --extverCol;
+ if(uriCol > extnameCol) --uriCol;
+ if(locationCol > extnameCol) --locationCol;
+ }
+ if(extverCol != 0)
+ {
+ *status = fits_delete_col(gfptr,extverCol,status);
+ --tfields;
+ if(uriCol > extverCol) --uriCol;
+ if(locationCol > extverCol) --locationCol;
+ }
+ if(uriCol != 0)
+ {
+ *status = fits_delete_col(gfptr,uriCol,status);
+ --tfields;
+ if(locationCol > uriCol) --locationCol;
+ }
+ if(locationCol != 0)
+ {
+ *status = fits_delete_col(gfptr,locationCol,status);
+ --tfields;
+ }
+
+ break;
+
+ case GT_ID_ALL:
+
+ if(uriCol != 0)
+ {
+ *status = fits_delete_col(gfptr,uriCol,status);
+ --tfields;
+ if(locationCol > uriCol) --locationCol;
+ }
+ if(locationCol != 0)
+ {
+ *status = fits_delete_col(gfptr,locationCol,status);
+ --tfields;
+ }
+
+ break;
+
+ case GT_ID_REF_URI:
+
+ if(positionCol != 0)
+ {
+ *status = fits_delete_col(gfptr,positionCol,status);
+ --tfields;
+ }
+
+ break;
+
+ case GT_ID_POS_URI:
+
+ if(xtensionCol != 0)
+ {
+ *status = fits_delete_col(gfptr,xtensionCol,status);
+ --tfields;
+ if(extnameCol > xtensionCol) --extnameCol;
+ if(extverCol > xtensionCol) --extverCol;
+ }
+ if(extnameCol != 0)
+ {
+ *status = fits_delete_col(gfptr,extnameCol,status);
+ --tfields;
+ if(extverCol > extnameCol) --extverCol;
+ }
+ if(extverCol != 0)
+ {
+ *status = fits_delete_col(gfptr,extverCol,status);
+ --tfields;
+ }
+
+ break;
+
+ default:
+
+ *status = BAD_OPTION;
+ ffpmsg("Invalid value for grouptype parameter specified (ffgtch)");
+ break;
+
+ }
+
+ /*
+ add all the new grouping table columns that were not there
+ previously but are called for by the grouptype parameter
+ */
+
+ for(i = 0; i < ncols && *status == 0; ++i)
+ *status = fits_insert_col(gfptr,tfields+i+1,ttype[i],tform[i],status);
+
+ /*
+ add the TNULL keywords and values for each new integer column defined;
+ integer null values are zero (0) for the MEMBER_POSITION and
+ MEMBER_VERSION columns. Insert a null ("/0") into each new string
+ column defined: MEMBER_XTENSION, MEMBER_NAME, MEMBER_URI_TYPE and
+ MEMBER_LOCATION. Note that by convention a null string is the
+ TNULL value for character fields so no TNULL is required.
+ */
+
+ for(i = 0; i < ncols && *status == 0; ++i)
+ {
+ if(strcasecmp(ttype[i],"MEMBER_POSITION") == 0 ||
+ strcasecmp(ttype[i],"MEMBER_VERSION") == 0)
+ {
+ /* col contains int data; set TNULL and insert 0 for each col */
+
+ *status = fits_get_colnum(gfptr,CASESEN,ttype[i],&colnum,
+ status);
+
+ sprintf(keyword,"TFORM%d",colnum);
+
+ *status = fits_read_key_str(gfptr,keyword,keyvalue,comment,
+ status);
+
+ sprintf(keyword,"TNULL%d",colnum);
+
+ *status = fits_insert_key_lng(gfptr,keyword,0,
+ "Column Null Value",status);
+
+ for(j = 1; j <= nrows && *status == 0; ++j)
+ *status = fits_write_col_lng(gfptr,colnum,j,1,1,&intNull,
+ status);
+ }
+ else if(strcasecmp(ttype[i],"MEMBER_XTENSION") == 0 ||
+ strcasecmp(ttype[i],"MEMBER_NAME") == 0 ||
+ strcasecmp(ttype[i],"MEMBER_URI_TYPE") == 0 ||
+ strcasecmp(ttype[i],"MEMBER_LOCATION") == 0)
+ {
+
+ /* new col contains character data; insert NULLs into each col */
+
+ *status = fits_get_colnum(gfptr,CASESEN,ttype[i],&colnum,
+ status);
+
+ for(j = 1; j <= nrows && *status == 0; ++j)
+ /* WILL THIS WORK FOR VAR LENTH CHAR COLS??????*/
+ *status = fits_write_col_byt(gfptr,colnum,j,1,1,charNull,
+ status);
+ }
+ }
+
+ }while(0);
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgtrm(fitsfile *gfptr, /* FITS file pointer to group */
+ int rmopt, /* code specifying if member
+ elements are to be deleted:
+ OPT_RM_GPT ==> remove only group table
+ OPT_RM_ALL ==> recursively remove members
+ and their members (if groups) */
+ int *status) /* return status code */
+
+/*
+ remove a grouping table, and optionally all its members. Any groups
+ containing the grouping table are updated, and all members (if not
+ deleted) have their GRPIDn and GRPLCn keywords updated accordingly.
+ If the (deleted) members are members of another grouping table then those
+ tables are also updated. The CHDU of the FITS file pointed to by gfptr must
+ be positioned to the grouping table to be deleted.
+*/
+
+{
+ int hdutype;
+
+ long i;
+ long nmembers = 0;
+
+ HDUtracker HDU;
+
+
+ if(*status != 0) return(*status);
+
+ /*
+ remove the grouping table depending upon the rmopt parameter
+ */
+
+ switch(rmopt)
+ {
+
+ case OPT_RM_GPT:
+
+ /*
+ for this option, the grouping table is deleted, but the member
+ HDUs remain; in this case we only have to remove each member from
+ the grouping table by calling fits_remove_member() with the
+ OPT_RM_ENTRY option
+ */
+
+ /* get the number of members contained by this table */
+
+ *status = fits_get_num_members(gfptr,&nmembers,status);
+
+ /* loop over all grouping table members and remove them */
+
+ for(i = nmembers; i > 0 && *status == 0; --i)
+ *status = fits_remove_member(gfptr,i,OPT_RM_ENTRY,status);
+
+ break;
+
+ case OPT_RM_ALL:
+
+ /*
+ for this option the entire Group is deleted -- this includes all
+ members and their members (if grouping tables themselves). Call
+ the recursive form of this function to perform the removal.
+ */
+
+ /* add the current grouping table to the HDUtracker struct */
+
+ HDU.nHDU = 0;
+
+ *status = fftsad(gfptr,&HDU,NULL,NULL);
+
+ /* call the recursive group remove function */
+
+ *status = ffgtrmr(gfptr,&HDU,status);
+
+ /* free the memory allocated to the HDUtracker struct */
+
+ for(i = 0; i < HDU.nHDU; ++i)
+ {
+ free(HDU.filename[i]);
+ free(HDU.newFilename[i]);
+ }
+
+ break;
+
+ default:
+
+ *status = BAD_OPTION;
+ ffpmsg("Invalid value for the rmopt parameter specified (ffgtrm)");
+ break;
+
+ }
+
+ /*
+ if all went well then unlink and delete the grouping table HDU
+ */
+
+ *status = ffgmul(gfptr,0,status);
+
+ *status = fits_delete_hdu(gfptr,&hdutype,status);
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgtcp(fitsfile *infptr, /* input FITS file pointer */
+ fitsfile *outfptr, /* output FITS file pointer */
+ int cpopt, /* code specifying copy options:
+ OPT_GCP_GPT (0) ==> copy only grouping table
+ OPT_GCP_ALL (2) ==> recusrively copy members
+ and their members (if
+ groups) */
+ int *status) /* return status code */
+
+/*
+ copy a grouping table, and optionally all its members, to a new FITS file.
+ If the cpopt is set to OPT_GCP_GPT (copy grouping table only) then the
+ existing members have their GRPIDn and GRPLCn keywords updated to reflect
+ the existance of the new group, since they now belong to another group. If
+ cpopt is set to OPT_GCP_ALL (copy grouping table and members recursively)
+ then the original members are not updated; the new grouping table is
+ modified to include only the copied member HDUs and not the original members.
+
+ Note that the recursive version of this function, ffgtcpr(), is called
+ to perform the group table copy. In the case of cpopt == OPT_GCP_GPT
+ ffgtcpr() does not actually use recursion.
+*/
+
+{
+ int i;
+
+ HDUtracker HDU;
+
+
+ if(*status != 0) return(*status);
+
+ /* make sure infptr and outfptr are not the same pointer */
+
+ if(infptr == outfptr) *status = IDENTICAL_POINTERS;
+ else
+ {
+
+ /* initialize the HDUtracker struct */
+
+ HDU.nHDU = 0;
+
+ *status = fftsad(infptr,&HDU,NULL,NULL);
+
+ /*
+ call the recursive form of this function to copy the grouping table.
+ If the cpopt is OPT_GCP_GPT then there is actually no recursion
+ performed
+ */
+
+ *status = ffgtcpr(infptr,outfptr,cpopt,&HDU,status);
+
+ /* free memory allocated for the HDUtracker struct */
+
+ for(i = 0; i < HDU.nHDU; ++i)
+ {
+ free(HDU.filename[i]);
+ free(HDU.newFilename[i]);
+ }
+ }
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgtmg(fitsfile *infptr, /* FITS file ptr to source grouping table */
+ fitsfile *outfptr, /* FITS file ptr to target grouping table */
+ int mgopt, /* code specifying merge options:
+ OPT_MRG_COPY (0) ==> copy members to target
+ group, leaving source
+ group in place
+ OPT_MRG_MOV (1) ==> move members to target
+ group, source group is
+ deleted after merge */
+ int *status) /* return status code */
+
+
+/*
+ merge two grouping tables by combining their members into a single table.
+ The source grouping table must be the CHDU of the fitsfile pointed to by
+ infptr, and the target grouping table must be the CHDU of the fitsfile to by
+ outfptr. All members of the source grouping table shall be copied to the
+ target grouping table. If the mgopt parameter is OPT_MRG_COPY then the source
+ grouping table continues to exist after the merge. If the mgopt parameter
+ is OPT_MRG_MOV then the source grouping table is deleted after the merge,
+ and all member HDUs are updated accordingly.
+*/
+{
+ long i ;
+ long nmembers = 0;
+
+ fitsfile *tmpfptr = NULL;
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+
+ *status = fits_get_num_members(infptr,&nmembers,status);
+
+ for(i = 1; i <= nmembers && *status == 0; ++i)
+ {
+ *status = fits_open_member(infptr,i,&tmpfptr,status);
+ *status = fits_add_group_member(outfptr,tmpfptr,0,status);
+
+ if(*status == HDU_ALREADY_MEMBER) *status = 0;
+
+ if(tmpfptr != NULL)
+ {
+ fits_close_file(tmpfptr,status);
+ tmpfptr = NULL;
+ }
+ }
+
+ if(*status != 0) continue;
+
+ if(mgopt == OPT_MRG_MOV)
+ *status = fits_remove_group(infptr,OPT_RM_GPT,status);
+
+ }while(0);
+
+ if(tmpfptr != NULL)
+ {
+ fits_close_file(tmpfptr,status);
+ }
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgtcm(fitsfile *gfptr, /* FITS file pointer to grouping table */
+ int cmopt, /* code specifying compact options
+ OPT_CMT_MBR (1) ==> compact only direct
+ members (if groups)
+ OPT_CMT_MBR_DEL (11) ==> (1) + delete all
+ compacted groups */
+ int *status) /* return status code */
+
+/*
+ "Compact" a group pointed to by the FITS file pointer gfptr. This
+ is achieved by flattening the tree structure of a group and its
+ (grouping table) members. All members HDUs of a grouping table which is
+ itself a member of the grouping table gfptr are added to gfptr. Optionally,
+ the grouping tables which are "compacted" are deleted. If the grouping
+ table contains no members that are themselves grouping tables then this
+ function performs a NOOP.
+*/
+
+{
+ long i;
+ long nmembers = 0;
+
+ char keyvalue[FLEN_VALUE];
+ char comment[FLEN_COMMENT];
+
+ fitsfile *mfptr = NULL;
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ if(cmopt != OPT_CMT_MBR && cmopt != OPT_CMT_MBR_DEL)
+ {
+ *status = BAD_OPTION;
+ ffpmsg("Invalid value for cmopt parameter specified (ffgtcm)");
+ continue;
+ }
+
+ /* reteive the number of grouping table members */
+
+ *status = fits_get_num_members(gfptr,&nmembers,status);
+
+ /*
+ loop over all the grouping table members; if the member is a
+ grouping table then merge its members with the parent grouping
+ table
+ */
+
+ for(i = 1; i <= nmembers && *status == 0; ++i)
+ {
+ *status = fits_open_member(gfptr,i,&mfptr,status);
+
+ if(*status != 0) continue;
+
+ *status = fits_read_key_str(mfptr,"EXTNAME",keyvalue,comment,status);
+
+ /* if no EXTNAME keyword then cannot be a grouping table */
+
+ if(*status == KEY_NO_EXIST)
+ {
+ *status = 0;
+ continue;
+ }
+ prepare_keyvalue(keyvalue);
+
+ if(*status != 0) continue;
+
+ /* if EXTNAME == "GROUPING" then process member as grouping table */
+
+ if(strcasecmp(keyvalue,"GROUPING") == 0)
+ {
+ /* merge the member (grouping table) into the grouping table */
+
+ *status = fits_merge_groups(mfptr,gfptr,OPT_MRG_COPY,status);
+
+ *status = fits_close_file(mfptr,status);
+ mfptr = NULL;
+
+ /*
+ remove the member from the grouping table now that all of
+ its members have been transferred; if cmopt is set to
+ OPT_CMT_MBR_DEL then remove and delete the member
+ */
+
+ if(cmopt == OPT_CMT_MBR)
+ *status = fits_remove_member(gfptr,i,OPT_RM_ENTRY,status);
+ else
+ *status = fits_remove_member(gfptr,i,OPT_RM_MBR,status);
+ }
+ else
+ {
+ /* not a grouping table; just close the opened member */
+
+ *status = fits_close_file(mfptr,status);
+ mfptr = NULL;
+ }
+ }
+
+ }while(0);
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int ffgtvf(fitsfile *gfptr, /* FITS file pointer to group */
+ long *firstfailed, /* Member ID (if positive) of first failed
+ member HDU verify check or GRPID index
+ (if negitive) of first failed group
+ link verify check. */
+ int *status) /* return status code */
+
+/*
+ check the integrity of a grouping table to make sure that all group members
+ are accessible and all the links to other grouping tables are valid. The
+ firstfailed parameter returns the member ID of the first member HDU to fail
+ verification if positive or the first group link to fail if negative;
+ otherwise firstfailed contains a return value of 0.
+*/
+
+{
+ long i;
+ long nmembers = 0;
+ long ngroups = 0;
+
+ char errstr[FLEN_VALUE];
+
+ fitsfile *fptr = NULL;
+
+
+ if(*status != 0) return(*status);
+
+ *firstfailed = 0;
+
+ do
+ {
+ /*
+ attempt to open all the members of the grouping table. We stop
+ at the first member which cannot be opened (which implies that it
+ cannot be located)
+ */
+
+ *status = fits_get_num_members(gfptr,&nmembers,status);
+
+ for(i = 1; i <= nmembers && *status == 0; ++i)
+ {
+ *status = fits_open_member(gfptr,i,&fptr,status);
+ fits_close_file(fptr,status);
+ }
+
+ /*
+ if the status is non-zero from the above loop then record the
+ member index that caused the error
+ */
+
+ if(*status != 0)
+ {
+ *firstfailed = i;
+ sprintf(errstr,"Group table verify failed for member %ld (ffgtvf)",
+ i);
+ ffpmsg(errstr);
+ continue;
+ }
+
+ /*
+ attempt to open all the groups linked to this grouping table. We stop
+ at the first group which cannot be opened (which implies that it
+ cannot be located)
+ */
+
+ *status = fits_get_num_groups(gfptr,&ngroups,status);
+
+ for(i = 1; i <= ngroups && *status == 0; ++i)
+ {
+ *status = fits_open_group(gfptr,i,&fptr,status);
+ fits_close_file(fptr,status);
+ }
+
+ /*
+ if the status from the above loop is non-zero, then record the
+ GRPIDn index of the group that caused the failure
+ */
+
+ if(*status != 0)
+ {
+ *firstfailed = -1*i;
+ sprintf(errstr,
+ "Group table verify failed for GRPID index %ld (ffgtvf)",i);
+ ffpmsg(errstr);
+ continue;
+ }
+
+ }while(0);
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgtop(fitsfile *mfptr, /* FITS file pointer to the member HDU */
+ int grpid, /* group ID (GRPIDn index) within member HDU */
+ fitsfile **gfptr, /* FITS file pointer to grouping table HDU */
+ int *status) /* return status code */
+
+/*
+ open the grouping table that contains the member HDU. The member HDU must
+ be the CHDU of the FITS file pointed to by mfptr, and the grouping table
+ is identified by the Nth index number of the GRPIDn keywords specified in
+ the member HDU's header. The fitsfile gfptr pointer is positioned with the
+ appropriate FITS file with the grouping table as the CHDU. If the group
+ grouping table resides in a file other than the member then an attempt
+ is first made to open the file readwrite, and failing that readonly.
+
+ Note that it is possible for the GRPIDn/GRPLCn keywords in a member
+ header to be non-continuous, e.g., GRPID1, GRPID2, GRPID5, GRPID6. In
+ such cases, the grpid index value specified in the function call shall
+ identify the (grpid)th GRPID value. In the above example, if grpid == 3,
+ then the group specified by GRPID5 would be opened.
+*/
+{
+ int i;
+ int found;
+
+ long ngroups = 0;
+ long grpExtver = 0;
+
+ char keyword[FLEN_KEYWORD];
+ char keyvalue[FLEN_FILENAME];
+ char *tkeyvalue;
+ char location[FLEN_FILENAME];
+ char location1[FLEN_FILENAME];
+ char location2[FLEN_FILENAME];
+ char comment[FLEN_COMMENT];
+
+ char *url[2];
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /* set the grouping table pointer to NULL for error checking later */
+
+ *gfptr = NULL;
+
+ /*
+ make sure that the group ID requested is valid ==> cannot be
+ larger than the number of GRPIDn keywords in the member HDU header
+ */
+
+ *status = fits_get_num_groups(mfptr,&ngroups,status);
+
+ if(grpid > ngroups)
+ {
+ *status = BAD_GROUP_ID;
+ sprintf(comment,
+ "GRPID index %d larger total GRPID keywords %ld (ffgtop)",
+ grpid,ngroups);
+ ffpmsg(comment);
+ continue;
+ }
+
+ /*
+ find the (grpid)th group that the member HDU belongs to and read
+ the value of the GRPID(grpid) keyword; fits_get_num_groups()
+ automatically re-enumerates the GRPIDn/GRPLCn keywords to fill in
+ any gaps
+ */
+
+ sprintf(keyword,"GRPID%d",grpid);
+
+ *status = fits_read_key_lng(mfptr,keyword,&grpExtver,comment,status);
+
+ if(*status != 0) continue;
+
+ /*
+ if the value of the GRPIDn keyword is positive then the member is
+ in the same FITS file as the grouping table and we only have to
+ reopen the current FITS file. Else the member and grouping table
+ HDUs reside in different files and another FITS file must be opened
+ as specified by the corresponding GRPLCn keyword
+
+ The DO WHILE loop only executes once and is used to control the
+ file opening logic.
+ */
+
+ do
+ {
+ if(grpExtver > 0)
+ {
+ /*
+ the member resides in the same file as the grouping
+ table, so just reopen the grouping table file
+ */
+
+ *status = fits_reopen_file(mfptr,gfptr,status);
+ continue;
+ }
+
+ else if(grpExtver == 0)
+ {
+ /* a GRPIDn value of zero (0) is undefined */
+
+ *status = BAD_GROUP_ID;
+ sprintf(comment,"Invalid value of %ld for GRPID%d (ffgtop)",
+ grpExtver,grpid);
+ ffpmsg(comment);
+ continue;
+ }
+
+ /*
+ The GRPLCn keyword value is negative, which implies that
+ the grouping table must reside in another FITS file;
+ search for the corresponding GRPLCn keyword
+ */
+
+ /* set the grpExtver value positive */
+
+ grpExtver = -1*grpExtver;
+
+ /* read the GRPLCn keyword value */
+
+ sprintf(keyword,"GRPLC%d",grpid);
+ /* SPR 1738 */
+ *status = fits_read_key_longstr(mfptr,keyword,&tkeyvalue,comment,
+ status);
+ if (0 == *status) {
+ strcpy(keyvalue,tkeyvalue);
+ free(tkeyvalue);
+ }
+
+
+ /* if the GRPLCn keyword was not found then there is a problem */
+
+ if(*status == KEY_NO_EXIST)
+ {
+ *status = BAD_GROUP_ID;
+
+ sprintf(comment,"Cannot find GRPLC%d keyword (ffgtop)",
+ grpid);
+ ffpmsg(comment);
+
+ continue;
+ }
+
+ prepare_keyvalue(keyvalue);
+
+ /*
+ if the GRPLCn keyword value specifies an absolute URL then
+ try to open the file; we cannot attempt any relative URL
+ or host-dependent file path reconstruction
+ */
+
+ if(fits_is_url_absolute(keyvalue))
+ {
+ ffpmsg("Try to open group table file as absolute URL (ffgtop)");
+
+ *status = fits_open_file(gfptr,keyvalue,READWRITE,status);
+
+ /* if the open was successful then continue */
+
+ if(*status == 0) continue;
+
+ /* if READWRITE failed then try opening it READONLY */
+
+ ffpmsg("OK, try open group table file as READONLY (ffgtop)");
+
+ *status = 0;
+ *status = fits_open_file(gfptr,keyvalue,READONLY,status);
+
+ /* continue regardless of the outcome */
+
+ continue;
+ }
+
+ /*
+ see if the URL gives a file path that is absolute on the
+ host machine
+ */
+
+ *status = fits_url2path(keyvalue,location1,status);
+
+ *status = fits_open_file(gfptr,location1,READWRITE,status);
+
+ /* if the file opened then continue */
+
+ if(*status == 0) continue;
+
+ /* if READWRITE failed then try opening it READONLY */
+
+ ffpmsg("OK, try open group table file as READONLY (ffgtop)");
+
+ *status = 0;
+ *status = fits_open_file(gfptr,location1,READONLY,status);
+
+ /* if the file opened then continue */
+
+ if(*status == 0) continue;
+
+ /*
+ the grouping table location given by GRPLCn must specify a
+ relative URL. We assume that this URL is relative to the
+ member HDU's FITS file. Try to construct a full URL location
+ for the grouping table's FITS file and then open it
+ */
+
+ *status = 0;
+
+ /* retrieve the URL information for the member HDU's file */
+
+ url[0] = location1; url[1] = location2;
+
+ *status = fits_get_url(mfptr,url[0],url[1],NULL,NULL,NULL,status);
+
+ /*
+ It is possible that the member HDU file has an initial
+ URL it was opened with and a real URL that the file actually
+ exists at (e.g., an HTTP accessed file copied to a local
+ file). For each possible URL try to construct a
+ */
+
+ for(i = 0, found = 0, *gfptr = NULL; i < 2 && !found; ++i)
+ {
+
+ /* the url string could be empty */
+
+ if(*url[i] == 0) continue;
+
+ /*
+ create a full URL from the partial and the member
+ HDU file URL
+ */
+
+ *status = fits_relurl2url(url[i],keyvalue,location,status);
+
+ /* if an error occured then contniue */
+
+ if(*status != 0)
+ {
+ *status = 0;
+ continue;
+ }
+
+ /*
+ if the location does not specify an access method
+ then turn it into a host dependent path
+ */
+
+ if(! fits_is_url_absolute(location))
+ {
+ *status = fits_url2path(location,url[i],status);
+ strcpy(location,url[i]);
+ }
+
+ /* try to open the grouping table file READWRITE */
+
+ *status = fits_open_file(gfptr,location,READWRITE,status);
+
+ if(*status != 0)
+ {
+ /* try to open the grouping table file READONLY */
+
+ ffpmsg("opening file as READWRITE failed (ffgtop)");
+ ffpmsg("OK, try to open file as READONLY (ffgtop)");
+ *status = 0;
+ *status = fits_open_file(gfptr,location,READONLY,status);
+ }
+
+ /* either set the found flag or reset the status flag */
+
+ if(*status == 0)
+ found = 1;
+ else
+ *status = 0;
+ }
+
+ }while(0); /* end of file opening loop */
+
+ /* if an error occured with the file opening then exit */
+
+ if(*status != 0) continue;
+
+ if(*gfptr == NULL)
+ {
+ ffpmsg("Cannot open or find grouping table FITS file (ffgtop)");
+ *status = GROUP_NOT_FOUND;
+ continue;
+ }
+
+ /* search for the grouping table in its FITS file */
+
+ *status = fits_movnam_hdu(*gfptr,ANY_HDU,"GROUPING",(int)grpExtver,
+ status);
+
+ if(*status != 0) *status = GROUP_NOT_FOUND;
+
+ }while(0);
+
+ if(*status != 0 && *gfptr != NULL)
+ {
+ fits_close_file(*gfptr,status);
+ *gfptr = NULL;
+ }
+
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int ffgtam(fitsfile *gfptr, /* FITS file pointer to grouping table HDU */
+ fitsfile *mfptr, /* FITS file pointer to member HDU */
+ int hdupos, /* member HDU position IF in the same file as
+ the grouping table AND mfptr == NULL */
+ int *status) /* return status code */
+
+/*
+ add a member HDU to an existing grouping table. The fitsfile pointer gfptr
+ must be positioned with the grouping table as the CHDU. The member HDU
+ may either be identifed with the fitsfile *mfptr (which must be positioned
+ to the member HDU) or the hdupos parameter (the HDU number of the member
+ HDU) if both reside in the same FITS file. The hdupos value is only used
+ if the mfptr parameter has a value of NULL (0). The new member HDU shall
+ have the appropriate GRPIDn and GRPLCn keywords created in its header.
+
+ Note that if the member HDU to be added to the grouping table is already
+ a member of the group then it will not be added a sceond time.
+*/
+
+{
+ int xtensionCol,extnameCol,extverCol,positionCol,locationCol,uriCol;
+ int memberPosition = 0;
+ int grptype = 0;
+ int hdutype = 0;
+ int useLocation = 0;
+ int nkeys = 6;
+ int found;
+ int i;
+
+ int memberIOstate;
+ int groupIOstate;
+ int iomode;
+
+ long memberExtver = 0;
+ long groupExtver = 0;
+ long memberID = 0;
+ long nmembers = 0;
+ long ngroups = 0;
+ long grpid = 0;
+
+ char memberAccess1[FLEN_VALUE];
+ char memberAccess2[FLEN_VALUE];
+ char memberFileName[FLEN_FILENAME];
+ char memberLocation[FLEN_FILENAME];
+ char grplc[FLEN_FILENAME];
+ char *tgrplc;
+ char memberHDUtype[FLEN_VALUE];
+ char memberExtname[FLEN_VALUE];
+ char memberURI[] = "URL";
+
+ char groupAccess1[FLEN_VALUE];
+ char groupAccess2[FLEN_VALUE];
+ char groupFileName[FLEN_FILENAME];
+ char groupLocation[FLEN_FILENAME];
+ char tmprootname[FLEN_FILENAME], grootname[FLEN_FILENAME];
+ char cwd[FLEN_FILENAME];
+
+ char *keys[] = {"GRPNAME","EXTVER","EXTNAME","TFIELDS","GCOUNT","EXTEND"};
+ char *tmpPtr[1];
+
+ char keyword[FLEN_KEYWORD];
+ char card[FLEN_CARD];
+
+ unsigned char charNull[] = {'\0'};
+
+ fitsfile *tmpfptr = NULL;
+
+ int parentStatus = 0;
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /*
+ make sure the grouping table can be modified before proceeding
+ */
+
+ fits_file_mode(gfptr,&iomode,status);
+
+ if(iomode != READWRITE)
+ {
+ ffpmsg("cannot modify grouping table (ffgtam)");
+ *status = BAD_GROUP_ATTACH;
+ continue;
+ }
+
+ /*
+ if the calling function supplied the HDU position of the member
+ HDU instead of fitsfile pointer then get a fitsfile pointer
+ */
+
+ if(mfptr == NULL)
+ {
+ *status = fits_reopen_file(gfptr,&tmpfptr,status);
+ *status = fits_movabs_hdu(tmpfptr,hdupos,&hdutype,status);
+
+ if(*status != 0) continue;
+ }
+ else
+ tmpfptr = mfptr;
+
+ /*
+ determine all the information about the member HDU that will
+ be needed later; note that we establish the default values for
+ all information values that are not explicitly found
+ */
+
+ *status = fits_read_key_str(tmpfptr,"XTENSION",memberHDUtype,card,
+ status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ strcpy(memberHDUtype,"PRIMARY");
+ *status = 0;
+ }
+ prepare_keyvalue(memberHDUtype);
+
+ *status = fits_read_key_lng(tmpfptr,"EXTVER",&memberExtver,card,status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ memberExtver = 1;
+ *status = 0;
+ }
+
+ *status = fits_read_key_str(tmpfptr,"EXTNAME",memberExtname,card,
+ status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ memberExtname[0] = 0;
+ *status = 0;
+ }
+ prepare_keyvalue(memberExtname);
+
+ fits_get_hdu_num(tmpfptr,&memberPosition);
+
+ /*
+ Determine if the member HDU's FITS file location needs to be
+ taken into account when building its grouping table reference
+
+ If the member location needs to be used (==> grouping table and member
+ HDU reside in different files) then create an appropriate URL for
+ the member HDU's file and grouping table's file. Note that the logic
+ for this is rather complicated
+ */
+
+ /* SPR 3463, don't do this
+ if(tmpfptr->Fptr == gfptr->Fptr)
+ { */
+ /*
+ member HDU and grouping table reside in the same file, no need
+ to use the location information */
+
+ /* printf ("same file\n");
+
+ useLocation = 0;
+ memberIOstate = 1;
+ *memberFileName = 0;
+ }
+ else
+ { */
+ /*
+ the member HDU and grouping table FITS file location information
+ must be used.
+
+ First determine the correct driver and file name for the group
+ table and member HDU files. If either are disk files then
+ construct an absolute file path for them. Finally, if both are
+ disk files construct relative file paths from the group(member)
+ file to the member(group) file.
+
+ */
+
+ /* set the USELOCATION flag to true */
+
+ useLocation = 1;
+
+ /*
+ get the location, access type and iostate (RO, RW) of the
+ member HDU file
+ */
+
+ *status = fits_get_url(tmpfptr,memberFileName,memberLocation,
+ memberAccess1,memberAccess2,&memberIOstate,
+ status);
+
+ /*
+ if the memberFileName string is empty then use the values of
+ the memberLocation string. This corresponds to a file where
+ the "real" file is a temporary memory file, and we must assume
+ the the application really wants the original file to be the
+ group member
+ */
+
+ if(strlen(memberFileName) == 0)
+ {
+ strcpy(memberFileName,memberLocation);
+ strcpy(memberAccess1,memberAccess2);
+ }
+
+ /*
+ get the location, access type and iostate (RO, RW) of the
+ grouping table file
+ */
+
+ *status = fits_get_url(gfptr,groupFileName,groupLocation,
+ groupAccess1,groupAccess2,&groupIOstate,
+ status);
+
+ if(*status != 0) continue;
+
+ /*
+ the grouping table file must be writable to continue
+ */
+
+ if(groupIOstate == 0)
+ {
+ ffpmsg("cannot modify grouping table (ffgtam)");
+ *status = BAD_GROUP_ATTACH;
+ continue;
+ }
+
+ /*
+ determine how to construct the resulting URLs for the member and
+ group files
+ */
+
+ if(strcasecmp(groupAccess1,"file://") &&
+ strcasecmp(memberAccess1,"file://"))
+ {
+ *cwd = 0;
+ /*
+ nothing to do in this case; both the member and group files
+ must be of an access type that already gives valid URLs;
+ i.e., URLs that we can pass directly to the file drivers
+ */
+ }
+ else
+ {
+ /*
+ retrieve the Current Working Directory as a Unix-like
+ URL standard string
+ */
+
+ *status = fits_get_cwd(cwd,status);
+
+ /*
+ create full file path for the member HDU FITS file URL
+ if it is of access type file://
+ */
+
+ if(strcasecmp(memberAccess1,"file://") == 0)
+ {
+ if(*memberFileName == '/')
+ {
+ strcpy(memberLocation,memberFileName);
+ }
+ else
+ {
+ strcpy(memberLocation,cwd);
+ strcat(memberLocation,"/");
+ strcat(memberLocation,memberFileName);
+ }
+
+ *status = fits_clean_url(memberLocation,memberFileName,
+ status);
+ }
+
+ /*
+ create full file path for the grouping table HDU FITS file URL
+ if it is of access type file://
+ */
+
+ if(strcasecmp(groupAccess1,"file://") == 0)
+ {
+ if(*groupFileName == '/')
+ {
+ strcpy(groupLocation,groupFileName);
+ }
+ else
+ {
+ strcpy(groupLocation,cwd);
+ strcat(groupLocation,"/");
+ strcat(groupLocation,groupFileName);
+ }
+
+ *status = fits_clean_url(groupLocation,groupFileName,status);
+ }
+
+ /*
+ if both the member and group files are disk files then
+ create a relative path (relative URL) strings with
+ respect to the grouping table's file and the grouping table's
+ file with respect to the member HDU's file
+ */
+
+ if(strcasecmp(groupAccess1,"file://") == 0 &&
+ strcasecmp(memberAccess1,"file://") == 0)
+ {
+ fits_url2relurl(memberFileName,groupFileName,
+ groupLocation,status);
+ fits_url2relurl(groupFileName,memberFileName,
+ memberLocation,status);
+
+ /*
+ copy the resulting partial URL strings to the
+ memberFileName and groupFileName variables for latter
+ use in the function
+ */
+
+ strcpy(memberFileName,memberLocation);
+ strcpy(groupFileName,groupLocation);
+ }
+ }
+ /* beo done */
+ /* } */
+
+
+ /* retrieve the grouping table's EXTVER value */
+
+ *status = fits_read_key_lng(gfptr,"EXTVER",&groupExtver,card,status);
+
+ /*
+ if useLocation is true then make the group EXTVER value negative
+ for the subsequent GRPIDn/GRPLCn matching
+ */
+ /* SPR 3463 change test; WDP added test for same filename */
+ /* Now, if either the Fptr values are the same, or the root filenames
+ are the same, then assume these refer to the same file.
+ */
+ fits_parse_rootname(tmpfptr->Fptr->filename, tmprootname, status);
+ fits_parse_rootname(gfptr->Fptr->filename, grootname, status);
+
+ if((tmpfptr->Fptr != gfptr->Fptr) &&
+ strncmp(tmprootname, grootname, FLEN_FILENAME))
+ groupExtver = -1*groupExtver;
+
+ /* retrieve the number of group members */
+
+ *status = fits_get_num_members(gfptr,&nmembers,status);
+
+ do {
+
+ /*
+ make sure the member HDU is not already an entry in the
+ grouping table before adding it
+ */
+
+ *status = ffgmf(gfptr,memberHDUtype,memberExtname,memberExtver,
+ memberPosition,memberFileName,&memberID,status);
+
+ if(*status == MEMBER_NOT_FOUND) *status = 0;
+ else if(*status == 0)
+ {
+ parentStatus = HDU_ALREADY_MEMBER;
+ ffpmsg("Specified HDU is already a member of the Grouping table (ffgtam)");
+ continue;
+ }
+ else continue;
+
+ /*
+ if the member HDU is not already recorded in the grouping table
+ then add it
+ */
+
+ /* add a new row to the grouping table */
+
+ *status = fits_insert_rows(gfptr,nmembers,1,status);
+ ++nmembers;
+
+ /* retrieve the grouping table column IDs and structure type */
+
+ *status = ffgtgc(gfptr,&xtensionCol,&extnameCol,&extverCol,&positionCol,
+ &locationCol,&uriCol,&grptype,status);
+
+ /* fill in the member HDU data in the new grouping table row */
+
+ *tmpPtr = memberHDUtype;
+
+ if(xtensionCol != 0)
+ fits_write_col_str(gfptr,xtensionCol,nmembers,1,1,tmpPtr,status);
+
+ *tmpPtr = memberExtname;
+
+ if(extnameCol != 0)
+ {
+ if(strlen(memberExtname) != 0)
+ fits_write_col_str(gfptr,extnameCol,nmembers,1,1,tmpPtr,status);
+ else
+ /* WILL THIS WORK FOR VAR LENTH CHAR COLS??????*/
+ fits_write_col_byt(gfptr,extnameCol,nmembers,1,1,charNull,status);
+ }
+
+ if(extverCol != 0)
+ fits_write_col_lng(gfptr,extverCol,nmembers,1,1,&memberExtver,
+ status);
+
+ if(positionCol != 0)
+ fits_write_col_int(gfptr,positionCol,nmembers,1,1,
+ &memberPosition,status);
+
+ *tmpPtr = memberFileName;
+
+ if(locationCol != 0)
+ {
+ /* Change the test for SPR 3463 */
+ /* Now, if either the Fptr values are the same, or the root filenames
+ are the same, then assume these refer to the same file.
+ */
+ fits_parse_rootname(tmpfptr->Fptr->filename, tmprootname, status);
+ fits_parse_rootname(gfptr->Fptr->filename, grootname, status);
+
+ if((tmpfptr->Fptr != gfptr->Fptr) &&
+ strncmp(tmprootname, grootname, FLEN_FILENAME))
+ fits_write_col_str(gfptr,locationCol,nmembers,1,1,tmpPtr,status);
+ else
+ /* WILL THIS WORK FOR VAR LENTH CHAR COLS??????*/
+ fits_write_col_byt(gfptr,locationCol,nmembers,1,1,charNull,status);
+ }
+
+ *tmpPtr = memberURI;
+
+ if(uriCol != 0)
+ {
+
+ /* Change the test for SPR 3463 */
+ /* Now, if either the Fptr values are the same, or the root filenames
+ are the same, then assume these refer to the same file.
+ */
+ fits_parse_rootname(tmpfptr->Fptr->filename, tmprootname, status);
+ fits_parse_rootname(gfptr->Fptr->filename, grootname, status);
+
+ if((tmpfptr->Fptr != gfptr->Fptr) &&
+ strncmp(tmprootname, grootname, FLEN_FILENAME))
+ fits_write_col_str(gfptr,uriCol,nmembers,1,1,tmpPtr,status);
+ else
+ /* WILL THIS WORK FOR VAR LENTH CHAR COLS??????*/
+ fits_write_col_byt(gfptr,uriCol,nmembers,1,1,charNull,status);
+ }
+ } while(0);
+
+ if(0 != *status) continue;
+ /*
+ add GRPIDn/GRPLCn keywords to the member HDU header to link
+ it to the grouing table if the they do not already exist and
+ the member file is RW
+ */
+
+ fits_file_mode(tmpfptr,&iomode,status);
+
+ if(memberIOstate == 0 || iomode != READWRITE)
+ {
+ ffpmsg("cannot add GRPID/LC keywords to member HDU: (ffgtam)");
+ ffpmsg(memberFileName);
+ continue;
+ }
+
+ *status = fits_get_num_groups(tmpfptr,&ngroups,status);
+
+ /*
+ look for the GRPID/LC keywords in the member HDU; if the keywords
+ for the back-link to the grouping table already exist then no
+ need to add them again
+ */
+
+ for(i = 1, found = 0; i <= ngroups && !found && *status == 0; ++i)
+ {
+ sprintf(keyword,"GRPID%d",(int)ngroups);
+ *status = fits_read_key_lng(tmpfptr,keyword,&grpid,card,status);
+
+ if(grpid == groupExtver)
+ {
+ if(grpid < 0)
+ {
+
+ /* have to make sure the GRPLCn keyword matches too */
+
+ sprintf(keyword,"GRPLC%d",(int)ngroups);
+ /* SPR 1738 */
+ *status = fits_read_key_longstr(mfptr,keyword,&tgrplc,card,
+ status);
+ if (0 == *status) {
+ strcpy(grplc,tgrplc);
+ free(tgrplc);
+ }
+
+ /*
+ always compare files using absolute paths
+ the presence of a non-empty cwd indicates
+ that the file names may require conversion
+ to absolute paths
+ */
+
+ if(0 < strlen(cwd)) {
+ /* temp buffer for use in assembling abs. path(s) */
+ char tmp[FLEN_FILENAME];
+
+ /* make grplc absolute if necessary */
+ if(!fits_is_url_absolute(grplc)) {
+ fits_path2url(grplc,groupLocation,status);
+
+ if(groupLocation[0] != '/')
+ {
+ strcpy(tmp, cwd);
+ strcat(tmp,"/");
+ strcat(tmp,groupLocation);
+ fits_clean_url(tmp,grplc,status);
+ }
+ }
+
+ /* make groupFileName absolute if necessary */
+ if(!fits_is_url_absolute(groupFileName)) {
+ fits_path2url(groupFileName,groupLocation,status);
+
+ if(groupLocation[0] != '/')
+ {
+ strcpy(tmp, cwd);
+ strcat(tmp,"/");
+ strcat(tmp,groupLocation);
+ /*
+ note: use groupLocation (which is not used
+ below this block), to store the absolute
+ file name instead of using groupFileName.
+ The latter may be needed unaltered if the
+ GRPLC is written below
+ */
+
+ fits_clean_url(tmp,groupLocation,status);
+ }
+ }
+ }
+ /*
+ see if the grplc value and the group file name match
+ */
+
+ if(strcmp(grplc,groupLocation) == 0) found = 1;
+ }
+ else
+ {
+ /* the match is found with GRPIDn alone */
+ found = 1;
+ }
+ }
+ }
+
+ /*
+ if FOUND is true then no need to continue
+ */
+
+ if(found)
+ {
+ ffpmsg("HDU already has GRPID/LC keywords for group table (ffgtam)");
+ continue;
+ }
+
+ /*
+ add the GRPID/LC keywords to the member header for this grouping
+ table
+
+ If NGROUPS == 0 then we must position the header pointer to the
+ record where we want to insert the GRPID/LC keywords (the pointer
+ is already correctly positioned if the above search loop activiated)
+ */
+
+ if(ngroups == 0)
+ {
+ /*
+ no GRPIDn/GRPLCn keywords currently exist in header so try
+ to position the header pointer to a desirable position
+ */
+
+ for(i = 0, *status = KEY_NO_EXIST;
+ i < nkeys && *status == KEY_NO_EXIST; ++i)
+ {
+ *status = 0;
+ *status = fits_read_card(tmpfptr,keys[i],card,status);
+ }
+
+ /* all else fails: move write pointer to end of header */
+
+ if(*status == KEY_NO_EXIST)
+ {
+ *status = 0;
+ fits_get_hdrspace(tmpfptr,&nkeys,&i,status);
+ ffgrec(tmpfptr,nkeys,card,status);
+ }
+
+ /* any other error status then abort */
+
+ if(*status != 0) continue;
+ }
+
+ /*
+ now that the header pointer is positioned for the GRPID/LC
+ keyword insertion increment the number of group links counter for
+ the member HDU
+ */
+
+ ++ngroups;
+
+ /*
+ if the member HDU and grouping table reside in the same FITS file
+ then there is no need to add a GRPLCn keyword
+ */
+ /* SPR 3463 change test */
+ /* Now, if either the Fptr values are the same, or the root filenames
+ are the same, then assume these refer to the same file.
+ */
+ fits_parse_rootname(tmpfptr->Fptr->filename, tmprootname, status);
+ fits_parse_rootname(gfptr->Fptr->filename, grootname, status);
+
+ if((tmpfptr->Fptr == gfptr->Fptr) ||
+ strncmp(tmprootname, grootname, FLEN_FILENAME) == 0)
+ {
+ /* add the GRPIDn keyword only */
+
+ sprintf(keyword,"GRPID%d",(int)ngroups);
+ fits_insert_key_lng(tmpfptr,keyword,groupExtver,
+ "EXTVER of Group containing this HDU",status);
+ }
+ else
+ {
+ /* add the GRPIDn and GRPLCn keywords */
+
+ sprintf(keyword,"GRPID%d",(int)ngroups);
+ fits_insert_key_lng(tmpfptr,keyword,groupExtver,
+ "EXTVER of Group containing this HDU",status);
+
+ sprintf(keyword,"GRPLC%d",(int)ngroups);
+ /* SPR 1738 */
+ fits_insert_key_longstr(tmpfptr,keyword,groupFileName,
+ "URL of file containing Group",status);
+ fits_write_key_longwarn(tmpfptr,status);
+
+ }
+
+ }while(0);
+
+ /* close the tmpfptr pointer if it was opened in this function */
+
+ if(mfptr == NULL)
+ {
+ *status = fits_close_file(tmpfptr,status);
+ }
+
+ *status = 0 == *status ? parentStatus : *status;
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgtnm(fitsfile *gfptr, /* FITS file pointer to grouping table */
+ long *nmembers, /* member count of the groping table */
+ int *status) /* return status code */
+
+/*
+ return the number of member HDUs in a grouping table. The fitsfile pointer
+ gfptr must be positioned with the grouping table as the CHDU. The number
+ of grouping table member HDUs is just the NAXIS2 value of the grouping
+ table.
+*/
+
+{
+ char keyvalue[FLEN_VALUE];
+ char comment[FLEN_COMMENT];
+
+
+ if(*status != 0) return(*status);
+
+ *status = fits_read_keyword(gfptr,"EXTNAME",keyvalue,comment,status);
+
+ if(*status == KEY_NO_EXIST)
+ *status = NOT_GROUP_TABLE;
+ else
+ {
+ prepare_keyvalue(keyvalue);
+
+ if(strcasecmp(keyvalue,"GROUPING") != 0)
+ {
+ *status = NOT_GROUP_TABLE;
+ ffpmsg("Specified HDU is not a Grouping table (ffgtnm)");
+ }
+
+ *status = fits_read_key_lng(gfptr,"NAXIS2",nmembers,comment,status);
+ }
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int ffgmng(fitsfile *mfptr, /* FITS file pointer to member HDU */
+ long *ngroups, /* total number of groups linked to HDU */
+ int *status) /* return status code */
+
+/*
+ return the number of groups to which a HDU belongs, as defined by the number
+ of GRPIDn/GRPLCn keyword records that appear in the HDU header. The
+ fitsfile pointer mfptr must be positioned with the member HDU as the CHDU.
+ Each time this function is called, the indicies of the GRPIDn/GRPLCn
+ keywords are checked to make sure they are continuous (ie no gaps) and
+ are re-enumerated to eliminate gaps if gaps are found to be present.
+*/
+
+{
+ int offset;
+ int index;
+ int newIndex;
+ int i;
+
+ long grpid;
+
+ char *inclist[] = {"GRPID#"};
+ char keyword[FLEN_KEYWORD];
+ char newKeyword[FLEN_KEYWORD];
+ char card[FLEN_CARD];
+ char comment[FLEN_COMMENT];
+ char *tkeyvalue;
+
+ if(*status != 0) return(*status);
+
+ *ngroups = 0;
+
+ /* reset the member HDU keyword counter to the beginning */
+
+ *status = ffgrec(mfptr,0,card,status);
+
+ /*
+ search for the number of GRPIDn keywords in the member HDU header
+ and count them with the ngroups variable
+ */
+
+ while(*status == 0)
+ {
+ /* read the next GRPIDn keyword in the series */
+
+ *status = fits_find_nextkey(mfptr,inclist,1,NULL,0,card,status);
+
+ if(*status != 0) continue;
+
+ ++(*ngroups);
+ }
+
+ if(*status == KEY_NO_EXIST) *status = 0;
+
+ /*
+ read each GRPIDn/GRPLCn keyword and adjust their index values so that
+ there are no gaps in the index count
+ */
+
+ for(index = 1, offset = 0, i = 1; i <= *ngroups && *status == 0; ++index)
+ {
+ sprintf(keyword,"GRPID%d",index);
+
+ /* try to read the next GRPIDn keyword in the series */
+
+ *status = fits_read_key_lng(mfptr,keyword,&grpid,card,status);
+
+ /* if not found then increment the offset counter and continue */
+
+ if(*status == KEY_NO_EXIST)
+ {
+ *status = 0;
+ ++offset;
+ }
+ else
+ {
+ /*
+ increment the number_keys_found counter and see if the index
+ of the keyword needs to be updated
+ */
+
+ ++i;
+
+ if(offset > 0)
+ {
+ /* compute the new index for the GRPIDn/GRPLCn keywords */
+ newIndex = index - offset;
+
+ /* update the GRPIDn keyword index */
+
+ sprintf(newKeyword,"GRPID%d",newIndex);
+ fits_modify_name(mfptr,keyword,newKeyword,status);
+
+ /* If present, update the GRPLCn keyword index */
+
+ sprintf(keyword,"GRPLC%d",index);
+ sprintf(newKeyword,"GRPLC%d",newIndex);
+ /* SPR 1738 */
+ *status = fits_read_key_longstr(mfptr,keyword,&tkeyvalue,comment,
+ status);
+ if (0 == *status) {
+ fits_delete_key(mfptr,keyword,status);
+ fits_insert_key_longstr(mfptr,newKeyword,tkeyvalue,comment,status);
+ fits_write_key_longwarn(mfptr,status);
+ free(tkeyvalue);
+ }
+
+
+ if(*status == KEY_NO_EXIST) *status = 0;
+ }
+ }
+ }
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgmop(fitsfile *gfptr, /* FITS file pointer to grouping table */
+ long member, /* member ID (row num) within grouping table */
+ fitsfile **mfptr, /* FITS file pointer to member HDU */
+ int *status) /* return status code */
+
+/*
+ open a grouping table member, returning a pointer to the member's FITS file
+ with the CHDU set to the member HDU. The grouping table must be the CHDU of
+ the FITS file pointed to by gfptr. The member to open is identified by its
+ row number within the grouping table (first row/member == 1).
+
+ If the member resides in a FITS file different from the grouping
+ table the member file is first opened readwrite and if this fails then
+ it is opened readonly. For access type of FILE:// the member file is
+ searched for assuming (1) an absolute path is given, (2) a path relative
+ to the CWD is given, and (3) a path relative to the grouping table file
+ but not relative to the CWD is given. If all of these fail then the
+ error FILE_NOT_FOUND is returned.
+*/
+
+{
+ int xtensionCol,extnameCol,extverCol,positionCol,locationCol,uriCol;
+ int grptype,hdutype;
+ int dummy;
+
+ long hdupos = 0;
+ long extver = 0;
+
+ char xtension[FLEN_VALUE];
+ char extname[FLEN_VALUE];
+ char uri[FLEN_VALUE];
+ char grpLocation1[FLEN_FILENAME];
+ char grpLocation2[FLEN_FILENAME];
+ char mbrLocation1[FLEN_FILENAME];
+ char mbrLocation2[FLEN_FILENAME];
+ char mbrLocation3[FLEN_FILENAME];
+ char cwd[FLEN_FILENAME];
+ char card[FLEN_CARD];
+ char nstr[] = {'\0'};
+ char *tmpPtr[1];
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /*
+ retrieve the Grouping Convention reserved column positions within
+ the grouping table
+ */
+
+ *status = ffgtgc(gfptr,&xtensionCol,&extnameCol,&extverCol,&positionCol,
+ &locationCol,&uriCol,&grptype,status);
+
+ if(*status != 0) continue;
+
+ /*
+ extract the member information from grouping table
+ */
+
+ tmpPtr[0] = xtension;
+
+ if(xtensionCol != 0)
+ {
+
+ *status = fits_read_col_str(gfptr,xtensionCol,member,1,1,nstr,
+ tmpPtr,&dummy,status);
+
+ /* convert the xtension string to a hdutype code */
+
+ if(strcasecmp(xtension,"PRIMARY") == 0) hdutype = IMAGE_HDU;
+ else if(strcasecmp(xtension,"IMAGE") == 0) hdutype = IMAGE_HDU;
+ else if(strcasecmp(xtension,"TABLE") == 0) hdutype = ASCII_TBL;
+ else if(strcasecmp(xtension,"BINTABLE") == 0) hdutype = BINARY_TBL;
+ else hdutype = ANY_HDU;
+ }
+
+ tmpPtr[0] = extname;
+
+ if(extnameCol != 0)
+ *status = fits_read_col_str(gfptr,extnameCol,member,1,1,nstr,
+ tmpPtr,&dummy,status);
+
+ if(extverCol != 0)
+ *status = fits_read_col_lng(gfptr,extverCol,member,1,1,0,
+ (long*)&extver,&dummy,status);
+
+ if(positionCol != 0)
+ *status = fits_read_col_lng(gfptr,positionCol,member,1,1,0,
+ (long*)&hdupos,&dummy,status);
+
+ tmpPtr[0] = mbrLocation1;
+
+ if(locationCol != 0)
+ *status = fits_read_col_str(gfptr,locationCol,member,1,1,nstr,
+ tmpPtr,&dummy,status);
+ tmpPtr[0] = uri;
+
+ if(uriCol != 0)
+ *status = fits_read_col_str(gfptr,uriCol,member,1,1,nstr,
+ tmpPtr,&dummy,status);
+
+ if(*status != 0) continue;
+
+ /*
+ decide what FITS file the member HDU resides in and open the file
+ using the fitsfile* pointer mfptr; note that this logic is rather
+ complicated and is based primiarly upon if a URL specifier is given
+ for the member file in the grouping table
+ */
+
+ switch(grptype)
+ {
+
+ case GT_ID_POS:
+ case GT_ID_REF:
+ case GT_ID_ALL:
+
+ /*
+ no location information is given so we must assume that the
+ member HDU resides in the same FITS file as the grouping table;
+ if the grouping table was incorrectly constructed then this
+ assumption will be false, but there is nothing to be done about
+ it at this point
+ */
+
+ *status = fits_reopen_file(gfptr,mfptr,status);
+
+ break;
+
+ case GT_ID_REF_URI:
+ case GT_ID_POS_URI:
+ case GT_ID_ALL_URI:
+
+ /*
+ The member location column exists. Determine if the member
+ resides in the same file as the grouping table or in a
+ separate file; open the member file in either case
+ */
+
+ if(strlen(mbrLocation1) == 0)
+ {
+ /*
+ since no location information was given we must assume
+ that the member is in the same FITS file as the grouping
+ table
+ */
+
+ *status = fits_reopen_file(gfptr,mfptr,status);
+ }
+ else
+ {
+ /*
+ make sure the location specifiation is "URL"; we cannot
+ decode any other URI types at this time
+ */
+
+ if(strcasecmp(uri,"URL") != 0)
+ {
+ *status = FILE_NOT_OPENED;
+ sprintf(card,
+ "Cannot open member HDU file with URI type %s (ffgmop)",
+ uri);
+ ffpmsg(card);
+
+ continue;
+ }
+
+ /*
+ The location string for the member is not NULL, so it
+ does not necessially reside in the same FITS file as the
+ grouping table.
+
+ Three cases are attempted for opening the member's file
+ in the following order:
+
+ 1. The URL given for the member's file is absolute (i.e.,
+ access method supplied); try to open the member
+
+ 2. The URL given for the member's file is not absolute but
+ is an absolute file path; try to open the member as a file
+ after the file path is converted to a host-dependent form
+
+ 3. The URL given for the member's file is not absolute
+ and is given as a relative path to the location of the
+ grouping table's file. Create an absolute URL using the
+ grouping table's file URL and try to open the member.
+
+ If all three cases fail then an error is returned. In each
+ case the file is first opened in read/write mode and failing
+ that readonly mode.
+
+ The following DO loop is only used as a mechanism to break
+ (continue) when the proper file opening method is found
+ */
+
+ do
+ {
+ /*
+ CASE 1:
+
+ See if the member URL is absolute (i.e., includes a
+ access directive) and if so open the file
+ */
+
+ if(fits_is_url_absolute(mbrLocation1))
+ {
+ /*
+ the URL must specify an access method, which
+ implies that its an absolute reference
+
+ regardless of the access method, pass the whole
+ URL to the open function for processing
+ */
+
+ ffpmsg("member URL is absolute, try open R/W (ffgmop)");
+
+ *status = fits_open_file(mfptr,mbrLocation1,READWRITE,
+ status);
+
+ if(*status == 0) continue;
+
+ *status = 0;
+
+ /*
+ now try to open file using full URL specs in
+ readonly mode
+ */
+
+ ffpmsg("OK, now try to open read-only (ffgmop)");
+
+ *status = fits_open_file(mfptr,mbrLocation1,READONLY,
+ status);
+
+ /* break from DO loop regardless of status */
+
+ continue;
+ }
+
+ /*
+ CASE 2:
+
+ If we got this far then the member URL location
+ has no access type ==> FILE:// Try to open the member
+ file using the URL as is, i.e., assume that it is given
+ as absolute, if it starts with a '/' character
+ */
+
+ ffpmsg("Member URL is of type FILE (ffgmop)");
+
+ if(*mbrLocation1 == '/')
+ {
+ ffpmsg("Member URL specifies abs file path (ffgmop)");
+
+ /*
+ convert the URL path to a host dependent path
+ */
+
+ *status = fits_url2path(mbrLocation1,mbrLocation2,
+ status);
+
+ ffpmsg("Try to open member URL in R/W mode (ffgmop)");
+
+ *status = fits_open_file(mfptr,mbrLocation2,READWRITE,
+ status);
+
+ if(*status == 0) continue;
+
+ *status = 0;
+
+ /*
+ now try to open file using the URL as an absolute
+ path in readonly mode
+ */
+
+ ffpmsg("OK, now try to open read-only (ffgmop)");
+
+ *status = fits_open_file(mfptr,mbrLocation2,READONLY,
+ status);
+
+ /* break from the Do loop regardless of the status */
+
+ continue;
+ }
+
+ /*
+ CASE 3:
+
+ If we got this far then the URL does not specify an
+ absoulte file path or URL with access method. Since
+ the path to the group table's file is (obviously) valid
+ for the CWD, create a full location string for the
+ member HDU using the grouping table URL as a basis
+
+ The only problem is that the grouping table file might
+ have two URLs, the original one used to open it and
+ the one that points to the real file being accessed
+ (i.e., a file accessed via HTTP but transferred to a
+ local disk file). Have to attempt to build a URL to
+ the member HDU file using both of these URLs if
+ defined.
+ */
+
+ ffpmsg("Try to open member file as relative URL (ffgmop)");
+
+ /* get the URL information for the grouping table file */
+
+ *status = fits_get_url(gfptr,grpLocation1,grpLocation2,
+ NULL,NULL,NULL,status);
+
+ /*
+ if the "real" grouping table file URL is defined then
+ build a full url for the member HDU file using it
+ and try to open the member HDU file
+ */
+
+ if(*grpLocation1)
+ {
+ /* make sure the group location is absolute */
+
+ if(! fits_is_url_absolute(grpLocation1) &&
+ *grpLocation1 != '/')
+ {
+ fits_get_cwd(cwd,status);
+ strcat(cwd,"/");
+ strcat(cwd,grpLocation1);
+ strcpy(grpLocation1,cwd);
+ }
+
+ /* create a full URL for the member HDU file */
+
+ *status = fits_relurl2url(grpLocation1,mbrLocation1,
+ mbrLocation2,status);
+
+ if(*status != 0) continue;
+
+ /*
+ if the URL does not have an access method given then
+ translate it into a host dependent file path
+ */
+
+ if(! fits_is_url_absolute(mbrLocation2))
+ {
+ *status = fits_url2path(mbrLocation2,mbrLocation3,
+ status);
+ strcpy(mbrLocation2,mbrLocation3);
+ }
+
+ /* try to open the member file READWRITE */
+
+ *status = fits_open_file(mfptr,mbrLocation2,READWRITE,
+ status);
+
+ if(*status == 0) continue;
+
+ *status = 0;
+
+ /* now try to open in readonly mode */
+
+ ffpmsg("now try to open file as READONLY (ffgmop)");
+
+ *status = fits_open_file(mfptr,mbrLocation2,READONLY,
+ status);
+
+ if(*status == 0) continue;
+
+ *status = 0;
+ }
+
+ /*
+ if we got this far then either the "real" grouping table
+ file URL was not defined or all attempts to open the
+ resulting member HDU file URL failed.
+
+ if the "original" grouping table file URL is defined then
+ build a full url for the member HDU file using it
+ and try to open the member HDU file
+ */
+
+ if(*grpLocation2)
+ {
+ /* make sure the group location is absolute */
+
+ if(! fits_is_url_absolute(grpLocation2) &&
+ *grpLocation2 != '/')
+ {
+ fits_get_cwd(cwd,status);
+ strcat(cwd,"/");
+ strcat(cwd,grpLocation2);
+ strcpy(grpLocation2,cwd);
+ }
+
+ /* create an absolute URL for the member HDU file */
+
+ *status = fits_relurl2url(grpLocation2,mbrLocation1,
+ mbrLocation2,status);
+ if(*status != 0) continue;
+
+ /*
+ if the URL does not have an access method given then
+ translate it into a host dependent file path
+ */
+
+ if(! fits_is_url_absolute(mbrLocation2))
+ {
+ *status = fits_url2path(mbrLocation2,mbrLocation3,
+ status);
+ strcpy(mbrLocation2,mbrLocation3);
+ }
+
+ /* try to open the member file READWRITE */
+
+ *status = fits_open_file(mfptr,mbrLocation2,READWRITE,
+ status);
+
+ if(*status == 0) continue;
+
+ *status = 0;
+
+ /* now try to open in readonly mode */
+
+ ffpmsg("now try to open file as READONLY (ffgmop)");
+
+ *status = fits_open_file(mfptr,mbrLocation2,READONLY,
+ status);
+
+ if(*status == 0) continue;
+
+ *status = 0;
+ }
+
+ /*
+ if we got this far then the member HDU file could not
+ be opened using any method. Log the error.
+ */
+
+ ffpmsg("Cannot open member HDU FITS file (ffgmop)");
+ *status = MEMBER_NOT_FOUND;
+
+ }while(0);
+ }
+
+ break;
+
+ default:
+
+ /* no default action */
+
+ break;
+ }
+
+ if(*status != 0) continue;
+
+ /*
+ attempt to locate the member HDU within its FITS file as determined
+ and opened above
+ */
+
+ switch(grptype)
+ {
+
+ case GT_ID_POS:
+ case GT_ID_POS_URI:
+
+ /*
+ try to find the member hdu in the the FITS file pointed to
+ by mfptr based upon its HDU posistion value. Note that is
+ impossible to verify if the HDU is actually the correct HDU due
+ to a lack of information.
+ */
+
+ *status = fits_movabs_hdu(*mfptr,(int)hdupos,&hdutype,status);
+
+ break;
+
+ case GT_ID_REF:
+ case GT_ID_REF_URI:
+
+ /*
+ try to find the member hdu in the FITS file pointed to
+ by mfptr based upon its XTENSION, EXTNAME and EXTVER keyword
+ values
+ */
+
+ *status = fits_movnam_hdu(*mfptr,hdutype,extname,extver,status);
+
+ if(*status == BAD_HDU_NUM)
+ {
+ *status = MEMBER_NOT_FOUND;
+ ffpmsg("Cannot find specified member HDU (ffgmop)");
+ }
+
+ /*
+ if the above function returned without error then the
+ mfptr is pointed to the member HDU
+ */
+
+ break;
+
+ case GT_ID_ALL:
+ case GT_ID_ALL_URI:
+
+ /*
+ if the member entry has reference information then use it
+ (ID by reference is safer than ID by position) else use
+ the position information
+ */
+
+ if(strlen(xtension) > 0 && strlen(extname) > 0 && extver > 0)
+ {
+ /* valid reference info exists so use it */
+
+ /* try to find the member hdu in the grouping table's file */
+
+ *status = fits_movnam_hdu(*mfptr,hdutype,extname,extver,status);
+
+ if(*status == BAD_HDU_NUM)
+ {
+ *status = MEMBER_NOT_FOUND;
+ ffpmsg("Cannot find specified member HDU (ffgmop)");
+ }
+ }
+ else
+ {
+ *status = fits_movabs_hdu(*mfptr,(int)hdupos,&hdutype,
+ status);
+ if(*status == END_OF_FILE) *status = MEMBER_NOT_FOUND;
+ }
+
+ /*
+ if the above function returned without error then the
+ mfptr is pointed to the member HDU
+ */
+
+ break;
+
+ default:
+
+ /* no default action */
+
+ break;
+ }
+
+ }while(0);
+
+ if(*status != 0 && *mfptr != NULL)
+ {
+ fits_close_file(*mfptr,status);
+ }
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgmcp(fitsfile *gfptr, /* FITS file pointer to group */
+ fitsfile *mfptr, /* FITS file pointer to new member
+ FITS file */
+ long member, /* member ID (row num) within grouping table */
+ int cpopt, /* code specifying copy options:
+ OPT_MCP_ADD (0) ==> add copied member to the
+ grouping table
+ OPT_MCP_NADD (1) ==> do not add member copy to
+ the grouping table
+ OPT_MCP_REPL (2) ==> replace current member
+ entry with member copy */
+ int *status) /* return status code */
+
+/*
+ copy a member HDU of a grouping table to a new FITS file. The grouping table
+ must be the CHDU of the FITS file pointed to by gfptr. The copy of the
+ group member shall be appended to the end of the FITS file pointed to by
+ mfptr. If the cpopt parameter is set to OPT_MCP_ADD then the copy of the
+ member is added to the grouping table as a new member, if OPT_MCP_NADD
+ then the copied member is not added to the grouping table, and if
+ OPT_MCP_REPL then the copied member is used to replace the original member.
+ The copied member HDU also has its EXTVER value updated so that its
+ combination of XTENSION, EXTNAME and EXVTER is unique within its new
+ FITS file.
+*/
+
+{
+ int numkeys = 0;
+ int keypos = 0;
+ int hdunum = 0;
+ int hdutype = 0;
+ int i;
+
+ char *incList[] = {"GRPID#","GRPLC#"};
+ char extname[FLEN_VALUE];
+ char card[FLEN_CARD];
+ char comment[FLEN_COMMENT];
+ char keyname[FLEN_CARD];
+ char value[FLEN_CARD];
+
+ fitsfile *tmpfptr = NULL;
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /* open the member HDU to be copied */
+
+ *status = fits_open_member(gfptr,member,&tmpfptr,status);
+
+ if(*status != 0) continue;
+
+ /*
+ if the member is a grouping table then copy it with a call to
+ fits_copy_group() using the "copy only the grouping table" option
+
+ if it is not a grouping table then copy the hdu with fits_copy_hdu()
+ remove all GRPIDn and GRPLCn keywords, and update the EXTVER keyword
+ value
+ */
+
+ /* get the member HDU's EXTNAME value */
+
+ *status = fits_read_key_str(tmpfptr,"EXTNAME",extname,comment,status);
+
+ /* if no EXTNAME value was found then set the extname to a null string */
+
+ if(*status == KEY_NO_EXIST)
+ {
+ extname[0] = 0;
+ *status = 0;
+ }
+ else if(*status != 0) continue;
+
+ prepare_keyvalue(extname);
+
+ /* if a grouping table then copy with fits_copy_group() */
+
+ if(strcasecmp(extname,"GROUPING") == 0)
+ *status = fits_copy_group(tmpfptr,mfptr,OPT_GCP_GPT,status);
+ else
+ {
+ /* copy the non-grouping table HDU the conventional way */
+
+ *status = fits_copy_hdu(tmpfptr,mfptr,0,status);
+
+ ffgrec(mfptr,0,card,status);
+
+ /* delete all the GRPIDn and GRPLCn keywords in the copied HDU */
+
+ while(*status == 0)
+ {
+ *status = fits_find_nextkey(mfptr,incList,2,NULL,0,card,status);
+ *status = fits_get_hdrpos(mfptr,&numkeys,&keypos,status);
+ /* SPR 1738 */
+ *status = fits_read_keyn(mfptr,keypos-1,keyname,value,
+ comment,status);
+ *status = fits_read_record(mfptr,keypos-1,card,status);
+ *status = fits_delete_key(mfptr,keyname,status);
+ }
+
+ if(*status == KEY_NO_EXIST) *status = 0;
+ if(*status != 0) continue;
+ }
+
+ /*
+ if the member HDU does not have an EXTNAME keyword then add one
+ with a default value
+ */
+
+ if(strlen(extname) == 0)
+ {
+ if(fits_get_hdu_num(tmpfptr,&hdunum) == 1)
+ {
+ strcpy(extname,"PRIMARY");
+ *status = fits_write_key_str(mfptr,"EXTNAME",extname,
+ "HDU was Formerly a Primary Array",
+ status);
+ }
+ else
+ {
+ strcpy(extname,"DEFAULT");
+ *status = fits_write_key_str(mfptr,"EXTNAME",extname,
+ "default EXTNAME set by CFITSIO",
+ status);
+ }
+ }
+
+ /*
+ update the member HDU's EXTVER value (add it if not present)
+ */
+
+ fits_get_hdu_num(mfptr,&hdunum);
+ fits_get_hdu_type(mfptr,&hdutype,status);
+
+ /* set the EXTVER value to 0 for now */
+
+ *status = fits_modify_key_lng(mfptr,"EXTVER",0,NULL,status);
+
+ /* if the EXTVER keyword was not found then add it */
+
+ if(*status == KEY_NO_EXIST)
+ {
+ *status = 0;
+ *status = fits_read_key_str(mfptr,"EXTNAME",extname,comment,
+ status);
+ *status = fits_insert_key_lng(mfptr,"EXTVER",0,
+ "Extension version ID",status);
+ }
+
+ if(*status != 0) continue;
+
+ /* find the first available EXTVER value for the copied HDU */
+
+ for(i = 1; fits_movnam_hdu(mfptr,hdutype,extname,i,status) == 0; ++i);
+
+ *status = 0;
+
+ fits_movabs_hdu(mfptr,hdunum,&hdutype,status);
+
+ /* reset the copied member HDUs EXTVER value */
+
+ *status = fits_modify_key_lng(mfptr,"EXTVER",(long)i,NULL,status);
+
+ /*
+ perform member copy operations that are dependent upon the cpopt
+ parameter value
+ */
+
+ switch(cpopt)
+ {
+ case OPT_MCP_ADD:
+
+ /*
+ add the copied member to the grouping table, leaving the
+ entry for the original member in place
+ */
+
+ *status = fits_add_group_member(gfptr,mfptr,0,status);
+
+ break;
+
+ case OPT_MCP_NADD:
+
+ /*
+ nothing to do for this copy option
+ */
+
+ break;
+
+ case OPT_MCP_REPL:
+
+ /*
+ remove the original member from the grouping table and add the
+ copied member in its place
+ */
+
+ *status = fits_remove_member(gfptr,member,OPT_RM_ENTRY,status);
+ *status = fits_add_group_member(gfptr,mfptr,0,status);
+
+ break;
+
+ default:
+
+ *status = BAD_OPTION;
+ ffpmsg("Invalid value specified for the cmopt parameter (ffgmcp)");
+
+ break;
+ }
+
+ }while(0);
+
+ if(tmpfptr != NULL)
+ {
+ fits_close_file(tmpfptr,status);
+ }
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgmtf(fitsfile *infptr, /* FITS file pointer to source grouping table */
+ fitsfile *outfptr, /* FITS file pointer to target grouping table */
+ long member, /* member ID within source grouping table */
+ int tfopt, /* code specifying transfer opts:
+ OPT_MCP_ADD (0) ==> copy member to dest.
+ OPT_MCP_MOV (3) ==> move member to dest. */
+ int *status) /* return status code */
+
+/*
+ transfer a group member from one grouping table to another. The source
+ grouping table must be the CHDU of the fitsfile pointed to by infptr, and
+ the destination grouping table must be the CHDU of the fitsfile to by
+ outfptr. If the tfopt parameter is OPT_MCP_ADD then the member is made a
+ member of the target group and remains a member of the source group. If
+ the tfopt parameter is OPT_MCP_MOV then the member is deleted from the
+ source group after the transfer to the destination group. The member to be
+ transfered is identified by its row number within the source grouping table.
+*/
+
+{
+ fitsfile *mfptr = NULL;
+
+
+ if(*status != 0) return(*status);
+
+ if(tfopt != OPT_MCP_MOV && tfopt != OPT_MCP_ADD)
+ {
+ *status = BAD_OPTION;
+ ffpmsg("Invalid value specified for the tfopt parameter (ffgmtf)");
+ }
+ else
+ {
+ /* open the member of infptr to be transfered */
+
+ *status = fits_open_member(infptr,member,&mfptr,status);
+
+ /* add the member to the outfptr grouping table */
+
+ *status = fits_add_group_member(outfptr,mfptr,0,status);
+
+ /* close the member HDU */
+
+ *status = fits_close_file(mfptr,status);
+
+ /*
+ if the tfopt is "move member" then remove it from the infptr
+ grouping table
+ */
+
+ if(tfopt == OPT_MCP_MOV)
+ *status = fits_remove_member(infptr,member,OPT_RM_ENTRY,status);
+ }
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int ffgmrm(fitsfile *gfptr, /* FITS file pointer to group table */
+ long member, /* member ID (row num) in the group */
+ int rmopt, /* code specifying the delete option:
+ OPT_RM_ENTRY ==> delete the member entry
+ OPT_RM_MBR ==> delete entry and member HDU */
+ int *status) /* return status code */
+
+/*
+ remove a member HDU from a grouping table. The fitsfile pointer gfptr must
+ be positioned with the grouping table as the CHDU, and the member to
+ delete is identified by its row number in the table (first member == 1).
+ The rmopt parameter determines if the member entry is deleted from the
+ grouping table (in which case GRPIDn and GRPLCn keywords in the member
+ HDU's header shall be updated accordingly) or if the member HDU shall
+ itself be removed from its FITS file.
+*/
+
+{
+ int found;
+ int hdutype = 0;
+ int index;
+ int iomode = 0;
+
+ long i;
+ long ngroups = 0;
+ long nmembers = 0;
+ long groupExtver = 0;
+ long grpid = 0;
+
+ char grpLocation1[FLEN_FILENAME];
+ char grpLocation2[FLEN_FILENAME];
+ char grpLocation3[FLEN_FILENAME];
+ char cwd[FLEN_FILENAME];
+ char keyword[FLEN_KEYWORD];
+ /* SPR 1738 This can now be longer */
+ char grplc[FLEN_FILENAME];
+ char *tgrplc;
+ char keyvalue[FLEN_VALUE];
+ char card[FLEN_CARD];
+ char *editLocation;
+ char mrootname[FLEN_FILENAME], grootname[FLEN_FILENAME];
+
+ fitsfile *mfptr = NULL;
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /*
+ make sure the grouping table can be modified before proceeding
+ */
+
+ fits_file_mode(gfptr,&iomode,status);
+
+ if(iomode != READWRITE)
+ {
+ ffpmsg("cannot modify grouping table (ffgtam)");
+ *status = BAD_GROUP_DETACH;
+ continue;
+ }
+
+ /* open the group member to be deleted and get its IOstatus*/
+
+ *status = fits_open_member(gfptr,member,&mfptr,status);
+ *status = fits_file_mode(mfptr,&iomode,status);
+
+ /*
+ if the member HDU is to be deleted then call fits_unlink_member()
+ to remove it from all groups to which it belongs (including
+ this one) and then delete it. Note that if the member is a
+ grouping table then we have to recursively call fits_remove_member()
+ for each member of the member before we delete the member itself.
+ */
+
+ if(rmopt == OPT_RM_MBR)
+ {
+ /* cannot delete a PHDU */
+ if(fits_get_hdu_num(mfptr,&hdutype) == 1)
+ {
+ *status = BAD_HDU_NUM;
+ continue;
+ }
+
+ /* determine if the member HDU is itself a grouping table */
+
+ *status = fits_read_key_str(mfptr,"EXTNAME",keyvalue,card,status);
+
+ /* if no EXTNAME is found then the HDU cannot be a grouping table */
+
+ if(*status == KEY_NO_EXIST)
+ {
+ keyvalue[0] = 0;
+ *status = 0;
+ }
+ prepare_keyvalue(keyvalue);
+
+ /* Any other error is a reason to abort */
+
+ if(*status != 0) continue;
+
+ /* if the EXTNAME == GROUPING then the member is a grouping table */
+
+ if(strcasecmp(keyvalue,"GROUPING") == 0)
+ {
+ /* remove each of the grouping table members */
+
+ *status = fits_get_num_members(mfptr,&nmembers,status);
+
+ for(i = nmembers; i > 0 && *status == 0; --i)
+ *status = fits_remove_member(mfptr,i,OPT_RM_ENTRY,status);
+
+ if(*status != 0) continue;
+ }
+
+ /* unlink the member HDU from all groups that contain it */
+
+ *status = ffgmul(mfptr,0,status);
+
+ if(*status != 0) continue;
+
+ /* reset the grouping table HDU struct */
+
+ fits_set_hdustruc(gfptr,status);
+
+ /* delete the member HDU */
+
+ if(iomode != READONLY)
+ *status = fits_delete_hdu(mfptr,&hdutype,status);
+ }
+ else if(rmopt == OPT_RM_ENTRY)
+ {
+ /*
+ The member HDU is only to be removed as an entry from this
+ grouping table. Actions are (1) find the GRPIDn/GRPLCn
+ keywords that link the member to the grouping table, (2)
+ remove the GRPIDn/GRPLCn keyword from the member HDU header
+ and (3) remove the member entry from the grouping table
+ */
+
+ /*
+ there is no need to seach for and remove the GRPIDn/GRPLCn
+ keywords from the member HDU if it has not been opened
+ in READWRITE mode
+ */
+
+ if(iomode == READWRITE)
+ {
+ /*
+ determine the group EXTVER value of the grouping table; if
+ the member HDU and grouping table HDU do not reside in the
+ same file then set the groupExtver value to its negative
+ */
+
+ *status = fits_read_key_lng(gfptr,"EXTVER",&groupExtver,card,
+ status);
+ /* Now, if either the Fptr values are the same, or the root filenames
+ are the same, then assume these refer to the same file.
+ */
+ fits_parse_rootname(mfptr->Fptr->filename, mrootname, status);
+ fits_parse_rootname(gfptr->Fptr->filename, grootname, status);
+
+ if((mfptr->Fptr != gfptr->Fptr) &&
+ strncmp(mrootname, grootname, FLEN_FILENAME))
+ groupExtver = -1*groupExtver;
+
+ /*
+ retrieve the URLs for the grouping table; note that it is
+ possible that the grouping table file has two URLs, the
+ one used to open it and the "real" one pointing to the
+ actual file being accessed
+ */
+
+ *status = fits_get_url(gfptr,grpLocation1,grpLocation2,NULL,
+ NULL,NULL,status);
+
+ if(*status != 0) continue;
+
+ /*
+ if either of the group location strings specify a relative
+ file path then convert them into absolute file paths
+ */
+
+ *status = fits_get_cwd(cwd,status);
+
+ if(*grpLocation1 != 0 && *grpLocation1 != '/' &&
+ !fits_is_url_absolute(grpLocation1))
+ {
+ strcpy(grpLocation3,cwd);
+ strcat(grpLocation3,"/");
+ strcat(grpLocation3,grpLocation1);
+ fits_clean_url(grpLocation3,grpLocation1,status);
+ }
+
+ if(*grpLocation2 != 0 && *grpLocation2 != '/' &&
+ !fits_is_url_absolute(grpLocation2))
+ {
+ strcpy(grpLocation3,cwd);
+ strcat(grpLocation3,"/");
+ strcat(grpLocation3,grpLocation2);
+ fits_clean_url(grpLocation3,grpLocation2,status);
+ }
+
+ /*
+ determine the number of groups to which the member HDU
+ belongs
+ */
+
+ *status = fits_get_num_groups(mfptr,&ngroups,status);
+
+ /* reset the HDU keyword position counter to the beginning */
+
+ *status = ffgrec(mfptr,0,card,status);
+
+ /*
+ loop over all the GRPIDn keywords in the member HDU header
+ and find the appropriate GRPIDn and GRPLCn keywords that
+ identify it as belonging to the group
+ */
+
+ for(index = 1, found = 0; index <= ngroups && *status == 0 &&
+ !found; ++index)
+ {
+ /* read the next GRPIDn keyword in the series */
+
+ sprintf(keyword,"GRPID%d",index);
+
+ *status = fits_read_key_lng(mfptr,keyword,&grpid,card,
+ status);
+ if(*status != 0) continue;
+
+ /*
+ grpid value == group EXTVER value then we could have a
+ match
+ */
+
+ if(grpid == groupExtver && grpid > 0)
+ {
+ /*
+ if GRPID is positive then its a match because
+ both the member HDU and grouping table HDU reside
+ in the same FITS file
+ */
+
+ found = index;
+ }
+ else if(grpid == groupExtver && grpid < 0)
+ {
+ /*
+ have to look at the GRPLCn value to determine a
+ match because the member HDU and grouping table
+ HDU reside in different FITS files
+ */
+
+ sprintf(keyword,"GRPLC%d",index);
+
+ /* SPR 1738 */
+ *status = fits_read_key_longstr(mfptr,keyword,&tgrplc,
+ card, status);
+ if (0 == *status) {
+ strcpy(grplc,tgrplc);
+ free(tgrplc);
+ }
+
+ if(*status == KEY_NO_EXIST)
+ {
+ /*
+ no GRPLCn keyword value found ==> grouping
+ convention not followed; nothing we can do
+ about it, so just continue
+ */
+
+ sprintf(card,"No GRPLC%d found for GRPID%d",
+ index,index);
+ ffpmsg(card);
+ *status = 0;
+ continue;
+ }
+ else if (*status != 0) continue;
+
+ /* construct the URL for the GRPLCn value */
+
+ prepare_keyvalue(grplc);
+
+ /*
+ if the grplc value specifies a relative path then
+ turn it into a absolute file path for comparison
+ purposes
+ */
+
+ if(*grplc != 0 && !fits_is_url_absolute(grplc) &&
+ *grplc != '/')
+ {
+ /* No, wrong,
+ strcpy(grpLocation3,cwd);
+ should be */
+ *status = fits_file_name(mfptr,grpLocation3,status);
+ /* Remove everything after the last / */
+ if (NULL != (editLocation = strrchr(grpLocation3,'/'))) {
+ *editLocation = '\0';
+ }
+
+ strcat(grpLocation3,"/");
+ strcat(grpLocation3,grplc);
+ *status = fits_clean_url(grpLocation3,grplc,
+ status);
+ }
+
+ /*
+ if the absolute value of GRPIDn is equal to the
+ EXTVER value of the grouping table and (one of the
+ possible two) grouping table file URL matches the
+ GRPLCn keyword value then we hava a match
+ */
+
+ if(strcmp(grplc,grpLocation1) == 0 ||
+ strcmp(grplc,grpLocation2) == 0)
+ found = index;
+ }
+ }
+
+ /*
+ if found == 0 (false) after the above search then we assume
+ that it is due to an inpromper updating of the GRPIDn and
+ GRPLCn keywords in the member header ==> nothing to delete
+ in the header. Else delete the GRPLCn and GRPIDn keywords
+ that identify the member HDU with the group HDU and
+ re-enumerate the remaining GRPIDn and GRPLCn keywords
+ */
+
+ if(found != 0)
+ {
+ sprintf(keyword,"GRPID%d",found);
+ *status = fits_delete_key(mfptr,keyword,status);
+
+ sprintf(keyword,"GRPLC%d",found);
+ *status = fits_delete_key(mfptr,keyword,status);
+
+ *status = 0;
+
+ /* call fits_get_num_groups() to re-enumerate the GRPIDn */
+
+ *status = fits_get_num_groups(mfptr,&ngroups,status);
+ }
+ }
+
+ /*
+ finally, remove the member entry from the current grouping table
+ pointed to by gfptr
+ */
+
+ *status = fits_delete_rows(gfptr,member,1,status);
+ }
+ else
+ {
+ *status = BAD_OPTION;
+ ffpmsg("Invalid value specified for the rmopt parameter (ffgmrm)");
+ }
+
+ }while(0);
+
+ if(mfptr != NULL)
+ {
+ fits_close_file(mfptr,status);
+ }
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------
+ Grouping Table support functions
+ ---------------------------------------------------------------------------*/
+int ffgtgc(fitsfile *gfptr, /* pointer to the grouping table */
+ int *xtensionCol, /* column ID of the MEMBER_XTENSION column */
+ int *extnameCol, /* column ID of the MEMBER_NAME column */
+ int *extverCol, /* column ID of the MEMBER_VERSION column */
+ int *positionCol, /* column ID of the MEMBER_POSITION column */
+ int *locationCol, /* column ID of the MEMBER_LOCATION column */
+ int *uriCol, /* column ID of the MEMBER_URI_TYPE column */
+ int *grptype, /* group structure type code specifying the
+ grouping table columns that are defined:
+ GT_ID_ALL_URI (0) ==> all columns defined
+ GT_ID_REF (1) ==> reference cols only
+ GT_ID_POS (2) ==> position col only
+ GT_ID_ALL (3) ==> ref & pos cols
+ GT_ID_REF_URI (11) ==> ref & loc cols
+ GT_ID_POS_URI (12) ==> pos & loc cols */
+ int *status) /* return status code */
+/*
+ examine the grouping table pointed to by gfptr and determine the column
+ index ID of each possible grouping column. If a column is not found then
+ an index of 0 is returned. the grptype parameter returns the structure
+ of the grouping table ==> what columns are defined.
+*/
+
+{
+
+ char keyvalue[FLEN_VALUE];
+ char comment[FLEN_COMMENT];
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /*
+ if the HDU does not have an extname of "GROUPING" then it is not
+ a grouping table
+ */
+
+ *status = fits_read_key_str(gfptr,"EXTNAME",keyvalue,comment,status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ *status = NOT_GROUP_TABLE;
+ ffpmsg("Specified HDU is not a Grouping Table (ffgtgc)");
+ }
+ if(*status != 0) continue;
+
+ prepare_keyvalue(keyvalue);
+
+ if(strcasecmp(keyvalue,"GROUPING") != 0)
+ {
+ *status = NOT_GROUP_TABLE;
+ continue;
+ }
+
+ /*
+ search for the MEMBER_XTENSION, MEMBER_NAME, MEMBER_VERSION,
+ MEMBER_POSITION, MEMBER_LOCATION and MEMBER_URI_TYPE columns
+ and determine their column index ID
+ */
+
+ *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_XTENSION",xtensionCol,
+ status);
+
+ if(*status == COL_NOT_FOUND)
+ {
+ *status = 0;
+ *xtensionCol = 0;
+ }
+
+ if(*status != 0) continue;
+
+ *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_NAME",extnameCol,status);
+
+ if(*status == COL_NOT_FOUND)
+ {
+ *status = 0;
+ *extnameCol = 0;
+ }
+
+ if(*status != 0) continue;
+
+ *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_VERSION",extverCol,
+ status);
+
+ if(*status == COL_NOT_FOUND)
+ {
+ *status = 0;
+ *extverCol = 0;
+ }
+
+ if(*status != 0) continue;
+
+ *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_POSITION",positionCol,
+ status);
+
+ if(*status == COL_NOT_FOUND)
+ {
+ *status = 0;
+ *positionCol = 0;
+ }
+
+ if(*status != 0) continue;
+
+ *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_LOCATION",locationCol,
+ status);
+
+ if(*status == COL_NOT_FOUND)
+ {
+ *status = 0;
+ *locationCol = 0;
+ }
+
+ if(*status != 0) continue;
+
+ *status = fits_get_colnum(gfptr,CASESEN,"MEMBER_URI_TYPE",uriCol,
+ status);
+
+ if(*status == COL_NOT_FOUND)
+ {
+ *status = 0;
+ *uriCol = 0;
+ }
+
+ if(*status != 0) continue;
+
+ /*
+ determine the type of grouping table structure used by this
+ grouping table and record it in the grptype parameter
+ */
+
+ if(*xtensionCol && *extnameCol && *extverCol && *positionCol &&
+ *locationCol && *uriCol)
+ *grptype = GT_ID_ALL_URI;
+
+ else if(*xtensionCol && *extnameCol && *extverCol &&
+ *locationCol && *uriCol)
+ *grptype = GT_ID_REF_URI;
+
+ else if(*xtensionCol && *extnameCol && *extverCol && *positionCol)
+ *grptype = GT_ID_ALL;
+
+ else if(*xtensionCol && *extnameCol && *extverCol)
+ *grptype = GT_ID_REF;
+
+ else if(*positionCol && *locationCol && *uriCol)
+ *grptype = GT_ID_POS_URI;
+
+ else if(*positionCol)
+ *grptype = GT_ID_POS;
+
+ else
+ *status = NOT_GROUP_TABLE;
+
+ }while(0);
+
+ /*
+ if the table contained more than one column with a reserved name then
+ this cannot be considered a vailid grouping table
+ */
+
+ if(*status == COL_NOT_UNIQUE)
+ {
+ *status = NOT_GROUP_TABLE;
+ ffpmsg("Specified HDU has multipule Group table cols defined (ffgtgc)");
+ }
+
+ return(*status);
+}
+
+/*****************************************************************************/
+int ffgtdc(int grouptype, /* code specifying the type of
+ grouping table information:
+ GT_ID_ALL_URI 0 ==> defualt (all columns)
+ GT_ID_REF 1 ==> ID by reference
+ GT_ID_POS 2 ==> ID by position
+ GT_ID_ALL 3 ==> ID by ref. and position
+ GT_ID_REF_URI 11 ==> (1) + URI info
+ GT_ID_POS_URI 12 ==> (2) + URI info */
+ int xtensioncol, /* does MEMBER_XTENSION already exist? */
+ int extnamecol, /* does MEMBER_NAME aleady exist? */
+ int extvercol, /* does MEMBER_VERSION already exist? */
+ int positioncol, /* does MEMBER_POSITION already exist? */
+ int locationcol, /* does MEMBER_LOCATION already exist? */
+ int uricol, /* does MEMBER_URI_TYPE aleardy exist? */
+ char *ttype[], /* array of grouping table column TTYPE names
+ to define (if *col var false) */
+ char *tform[], /* array of grouping table column TFORM values
+ to define (if*col variable false) */
+ int *ncols, /* number of TTYPE and TFORM values returned */
+ int *status) /* return status code */
+
+/*
+ create the TTYPE and TFORM values for the grouping table according to the
+ value of the grouptype parameter and the values of the *col flags. The
+ resulting TTYPE and TFORM are returned in ttype[] and tform[] respectively.
+ The number of TTYPE and TFORMs returned is given by ncols. Both the TTYPE[]
+ and TTFORM[] arrays must contain enough pre-allocated strings to hold
+ the returned information.
+*/
+
+{
+
+ int i = 0;
+
+ char xtension[] = "MEMBER_XTENSION";
+ char xtenTform[] = "8A";
+
+ char name[] = "MEMBER_NAME";
+ char nameTform[] = "32A";
+
+ char version[] = "MEMBER_VERSION";
+ char verTform[] = "1J";
+
+ char position[] = "MEMBER_POSITION";
+ char posTform[] = "1J";
+
+ char URI[] = "MEMBER_URI_TYPE";
+ char URITform[] = "3A";
+
+ char location[] = "MEMBER_LOCATION";
+ /* SPR 01720, move from 160A to 256A */
+ char locTform[] = "256A";
+
+
+ if(*status != 0) return(*status);
+
+ switch(grouptype)
+ {
+
+ case GT_ID_ALL_URI:
+
+ if(xtensioncol == 0)
+ {
+ strcpy(ttype[i],xtension);
+ strcpy(tform[i],xtenTform);
+ ++i;
+ }
+ if(extnamecol == 0)
+ {
+ strcpy(ttype[i],name);
+ strcpy(tform[i],nameTform);
+ ++i;
+ }
+ if(extvercol == 0)
+ {
+ strcpy(ttype[i],version);
+ strcpy(tform[i],verTform);
+ ++i;
+ }
+ if(positioncol == 0)
+ {
+ strcpy(ttype[i],position);
+ strcpy(tform[i],posTform);
+ ++i;
+ }
+ if(locationcol == 0)
+ {
+ strcpy(ttype[i],location);
+ strcpy(tform[i],locTform);
+ ++i;
+ }
+ if(uricol == 0)
+ {
+ strcpy(ttype[i],URI);
+ strcpy(tform[i],URITform);
+ ++i;
+ }
+ break;
+
+ case GT_ID_REF:
+
+ if(xtensioncol == 0)
+ {
+ strcpy(ttype[i],xtension);
+ strcpy(tform[i],xtenTform);
+ ++i;
+ }
+ if(extnamecol == 0)
+ {
+ strcpy(ttype[i],name);
+ strcpy(tform[i],nameTform);
+ ++i;
+ }
+ if(extvercol == 0)
+ {
+ strcpy(ttype[i],version);
+ strcpy(tform[i],verTform);
+ ++i;
+ }
+ break;
+
+ case GT_ID_POS:
+
+ if(positioncol == 0)
+ {
+ strcpy(ttype[i],position);
+ strcpy(tform[i],posTform);
+ ++i;
+ }
+ break;
+
+ case GT_ID_ALL:
+
+ if(xtensioncol == 0)
+ {
+ strcpy(ttype[i],xtension);
+ strcpy(tform[i],xtenTform);
+ ++i;
+ }
+ if(extnamecol == 0)
+ {
+ strcpy(ttype[i],name);
+ strcpy(tform[i],nameTform);
+ ++i;
+ }
+ if(extvercol == 0)
+ {
+ strcpy(ttype[i],version);
+ strcpy(tform[i],verTform);
+ ++i;
+ }
+ if(positioncol == 0)
+ {
+ strcpy(ttype[i],position);
+ strcpy(tform[i], posTform);
+ ++i;
+ }
+
+ break;
+
+ case GT_ID_REF_URI:
+
+ if(xtensioncol == 0)
+ {
+ strcpy(ttype[i],xtension);
+ strcpy(tform[i],xtenTform);
+ ++i;
+ }
+ if(extnamecol == 0)
+ {
+ strcpy(ttype[i],name);
+ strcpy(tform[i],nameTform);
+ ++i;
+ }
+ if(extvercol == 0)
+ {
+ strcpy(ttype[i],version);
+ strcpy(tform[i],verTform);
+ ++i;
+ }
+ if(locationcol == 0)
+ {
+ strcpy(ttype[i],location);
+ strcpy(tform[i],locTform);
+ ++i;
+ }
+ if(uricol == 0)
+ {
+ strcpy(ttype[i],URI);
+ strcpy(tform[i],URITform);
+ ++i;
+ }
+ break;
+
+ case GT_ID_POS_URI:
+
+ if(positioncol == 0)
+ {
+ strcpy(ttype[i],position);
+ strcpy(tform[i],posTform);
+ ++i;
+ }
+ if(locationcol == 0)
+ {
+ strcpy(ttype[i],location);
+ strcpy(tform[i],locTform);
+ ++i;
+ }
+ if(uricol == 0)
+ {
+ strcpy(ttype[i],URI);
+ strcpy(tform[i],URITform);
+ ++i;
+ }
+ break;
+
+ default:
+
+ *status = BAD_OPTION;
+ ffpmsg("Invalid value specified for the grouptype parameter (ffgtdc)");
+
+ break;
+
+ }
+
+ *ncols = i;
+
+ return(*status);
+}
+
+/*****************************************************************************/
+int ffgmul(fitsfile *mfptr, /* pointer to the grouping table member HDU */
+ int rmopt, /* 0 ==> leave GRPIDn/GRPLCn keywords,
+ 1 ==> remove GRPIDn/GRPLCn keywords */
+ int *status) /* return status code */
+
+/*
+ examine all the GRPIDn and GRPLCn keywords in the member HDUs header
+ and remove the member from the grouping tables referenced; This
+ effectively "unlinks" the member from all of its groups. The rmopt
+ specifies if the GRPIDn/GRPLCn keywords are to be removed from the
+ member HDUs header after the unlinking.
+*/
+
+{
+ int memberPosition = 0;
+ int iomode;
+
+ long index;
+ long ngroups = 0;
+ long memberExtver = 0;
+ long memberID = 0;
+
+ char mbrLocation1[FLEN_FILENAME];
+ char mbrLocation2[FLEN_FILENAME];
+ char memberHDUtype[FLEN_VALUE];
+ char memberExtname[FLEN_VALUE];
+ char keyword[FLEN_KEYWORD];
+ char card[FLEN_CARD];
+
+ fitsfile *gfptr = NULL;
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /*
+ determine location parameters of the member HDU; note that
+ default values are supplied if the expected keywords are not
+ found
+ */
+
+ *status = fits_read_key_str(mfptr,"XTENSION",memberHDUtype,card,status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ strcpy(memberHDUtype,"PRIMARY");
+ *status = 0;
+ }
+ prepare_keyvalue(memberHDUtype);
+
+ *status = fits_read_key_lng(mfptr,"EXTVER",&memberExtver,card,status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ memberExtver = 1;
+ *status = 0;
+ }
+
+ *status = fits_read_key_str(mfptr,"EXTNAME",memberExtname,card,status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ memberExtname[0] = 0;
+ *status = 0;
+ }
+ prepare_keyvalue(memberExtname);
+
+ fits_get_hdu_num(mfptr,&memberPosition);
+
+ *status = fits_get_url(mfptr,mbrLocation1,mbrLocation2,NULL,NULL,
+ NULL,status);
+
+ if(*status != 0) continue;
+
+ /*
+ open each grouping table linked to this HDU and remove the member
+ from the grouping tables
+ */
+
+ *status = fits_get_num_groups(mfptr,&ngroups,status);
+
+ /* loop over each group linked to the member HDU */
+
+ for(index = 1; index <= ngroups && *status == 0; ++index)
+ {
+ /* open the (index)th group linked to the member HDU */
+
+ *status = fits_open_group(mfptr,index,&gfptr,status);
+
+ /* if the group could not be opened then just skip it */
+
+ if(*status != 0)
+ {
+ *status = 0;
+ sprintf(card,"Cannot open the %dth group table (ffgmul)",
+ (int)index);
+ ffpmsg(card);
+ continue;
+ }
+
+ /*
+ make sure the grouping table can be modified before proceeding
+ */
+
+ fits_file_mode(gfptr,&iomode,status);
+
+ if(iomode != READWRITE)
+ {
+ sprintf(card,"The %dth group cannot be modified (ffgtam)",
+ (int)index);
+ ffpmsg(card);
+ continue;
+ }
+
+ /*
+ try to find the member's row within the grouping table; first
+ try using the member HDU file's "real" URL string then try
+ using its originally opened URL string if either string exist
+ */
+
+ memberID = 0;
+
+ if(strlen(mbrLocation1) != 0)
+ {
+ *status = ffgmf(gfptr,memberHDUtype,memberExtname,memberExtver,
+ memberPosition,mbrLocation1,&memberID,status);
+ }
+
+ if(*status == MEMBER_NOT_FOUND && strlen(mbrLocation2) != 0)
+ {
+ *status = 0;
+ *status = ffgmf(gfptr,memberHDUtype,memberExtname,memberExtver,
+ memberPosition,mbrLocation2,&memberID,status);
+ }
+
+ /* if the member was found then delete it from the grouping table */
+
+ if(*status == 0)
+ *status = fits_delete_rows(gfptr,memberID,1,status);
+
+ /*
+ continue the loop over all member groups even if an error
+ was generated
+ */
+
+ if(*status == MEMBER_NOT_FOUND)
+ {
+ ffpmsg("cannot locate member's entry in group table (ffgmul)");
+ }
+ *status = 0;
+
+ /*
+ close the file pointed to by gfptr if it is non NULL to
+ prepare for the next loop iterration
+ */
+
+ if(gfptr != NULL)
+ {
+ fits_close_file(gfptr,status);
+ gfptr = NULL;
+ }
+ }
+
+ if(*status != 0) continue;
+
+ /*
+ if rmopt is non-zero then find and delete the GRPIDn/GRPLCn
+ keywords from the member HDU header
+ */
+
+ if(rmopt != 0)
+ {
+ fits_file_mode(mfptr,&iomode,status);
+
+ if(iomode == READONLY)
+ {
+ ffpmsg("Cannot modify member HDU, opened READONLY (ffgmul)");
+ continue;
+ }
+
+ /* delete all the GRPIDn/GRPLCn keywords */
+
+ for(index = 1; index <= ngroups && *status == 0; ++index)
+ {
+ sprintf(keyword,"GRPID%d",(int)index);
+ fits_delete_key(mfptr,keyword,status);
+
+ sprintf(keyword,"GRPLC%d",(int)index);
+ fits_delete_key(mfptr,keyword,status);
+
+ if(*status == KEY_NO_EXIST) *status = 0;
+ }
+ }
+ }while(0);
+
+ /* make sure the gfptr has been closed */
+
+ if(gfptr != NULL)
+ {
+ fits_close_file(gfptr,status);
+ }
+
+return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int ffgmf(fitsfile *gfptr, /* pointer to grouping table HDU to search */
+ char *xtension, /* XTENSION value for member HDU */
+ char *extname, /* EXTNAME value for member HDU */
+ int extver, /* EXTVER value for member HDU */
+ int position, /* HDU position value for member HDU */
+ char *location, /* FITS file location value for member HDU */
+ long *member, /* member HDU ID within group table (if found) */
+ int *status) /* return status code */
+
+/*
+ try to find the entry for the member HDU defined by the xtension, extname,
+ extver, position, and location parameters within the grouping table
+ pointed to by gfptr. If the member HDU is found then its ID (row number)
+ within the grouping table is returned in the member variable; if not
+ found then member is returned with a value of 0 and the status return
+ code will be set to MEMBER_NOT_FOUND.
+
+ Note that the member HDU postion information is used to obtain a member
+ match only if the grouping table type is GT_ID_POS_URI or GT_ID_POS. This
+ is because the position information can become invalid much more
+ easily then the reference information for a group member.
+*/
+
+{
+ int xtensionCol,extnameCol,extverCol,positionCol,locationCol,uriCol;
+ int mposition = 0;
+ int grptype;
+ int dummy;
+ int i;
+
+ long nmembers = 0;
+ long mextver = 0;
+
+ char charBuff1[FLEN_FILENAME];
+ char charBuff2[FLEN_FILENAME];
+ char tmpLocation[FLEN_FILENAME];
+ char mbrLocation1[FLEN_FILENAME];
+ char mbrLocation2[FLEN_FILENAME];
+ char mbrLocation3[FLEN_FILENAME];
+ char grpLocation1[FLEN_FILENAME];
+ char grpLocation2[FLEN_FILENAME];
+ char cwd[FLEN_FILENAME];
+
+ char nstr[] = {'\0'};
+ char *tmpPtr[2];
+
+ if(*status != 0) return(*status);
+
+ *member = 0;
+
+ tmpPtr[0] = charBuff1;
+ tmpPtr[1] = charBuff2;
+
+
+ if(*status != 0) return(*status);
+
+ /*
+ if the passed LOCATION value is not an absolute URL then turn it
+ into an absolute path
+ */
+
+ if(location == NULL)
+ {
+ *tmpLocation = 0;
+ }
+
+ else if(*location == 0)
+ {
+ *tmpLocation = 0;
+ }
+
+ else if(!fits_is_url_absolute(location))
+ {
+ fits_path2url(location,tmpLocation,status);
+
+ if(*tmpLocation != '/')
+ {
+ fits_get_cwd(cwd,status);
+ strcat(cwd,"/");
+ strcat(cwd,tmpLocation);
+ fits_clean_url(cwd,tmpLocation,status);
+ }
+ }
+
+ else
+ strcpy(tmpLocation,location);
+
+ /*
+ retrieve the Grouping Convention reserved column positions within
+ the grouping table
+ */
+
+ *status = ffgtgc(gfptr,&xtensionCol,&extnameCol,&extverCol,&positionCol,
+ &locationCol,&uriCol,&grptype,status);
+
+ /* retrieve the number of group members */
+
+ *status = fits_get_num_members(gfptr,&nmembers,status);
+
+ /*
+ loop over all grouping table rows until the member HDU is found
+ */
+
+ for(i = 1; i <= nmembers && *member == 0 && *status == 0; ++i)
+ {
+ if(xtensionCol != 0)
+ {
+ fits_read_col_str(gfptr,xtensionCol,i,1,1,nstr,tmpPtr,&dummy,status);
+ if(strcasecmp(tmpPtr[0],xtension) != 0) continue;
+ }
+
+ if(extnameCol != 0)
+ {
+ fits_read_col_str(gfptr,extnameCol,i,1,1,nstr,tmpPtr,&dummy,status);
+ if(strcasecmp(tmpPtr[0],extname) != 0) continue;
+ }
+
+ if(extverCol != 0)
+ {
+ fits_read_col_lng(gfptr,extverCol,i,1,1,0,
+ (long*)&mextver,&dummy,status);
+ if(extver != mextver) continue;
+ }
+
+ /* note we only use postionCol if we have to */
+
+ if(positionCol != 0 &&
+ (grptype == GT_ID_POS || grptype == GT_ID_POS_URI))
+ {
+ fits_read_col_int(gfptr,positionCol,i,1,1,0,
+ &mposition,&dummy,status);
+ if(position != mposition) continue;
+ }
+
+ /*
+ if no location string was passed to the function then assume that
+ the calling application does not wish to use it as a comparision
+ critera ==> if we got this far then we have a match
+ */
+
+ if(location == NULL)
+ {
+ ffpmsg("NULL Location string given ==> ingore location (ffgmf)");
+ *member = i;
+ continue;
+ }
+
+ /*
+ if the grouping table MEMBER_LOCATION column exists then read the
+ location URL for the member, else set the location string to
+ a zero-length string for subsequent comparisions
+ */
+
+ if(locationCol != 0)
+ {
+ fits_read_col_str(gfptr,locationCol,i,1,1,nstr,tmpPtr,&dummy,status);
+ strcpy(mbrLocation1,tmpPtr[0]);
+ *mbrLocation2 = 0;
+ }
+ else
+ *mbrLocation1 = 0;
+
+ /*
+ if the member location string from the grouping table is zero
+ length (either implicitly or explicitly) then assume that the
+ member HDU is in the same file as the grouping table HDU; retrieve
+ the possible URL values of the grouping table HDU file
+ */
+
+ if(*mbrLocation1 == 0)
+ {
+ /* retrieve the possible URLs of the grouping table file */
+ *status = fits_get_url(gfptr,mbrLocation1,mbrLocation2,NULL,NULL,
+ NULL,status);
+
+ /* if non-NULL, make sure the first URL is absolute or a full path */
+ if(*mbrLocation1 != 0 && !fits_is_url_absolute(mbrLocation1) &&
+ *mbrLocation1 != '/')
+ {
+ fits_get_cwd(cwd,status);
+ strcat(cwd,"/");
+ strcat(cwd,mbrLocation1);
+ fits_clean_url(cwd,mbrLocation1,status);
+ }
+
+ /* if non-NULL, make sure the first URL is absolute or a full path */
+ if(*mbrLocation2 != 0 && !fits_is_url_absolute(mbrLocation2) &&
+ *mbrLocation2 != '/')
+ {
+ fits_get_cwd(cwd,status);
+ strcat(cwd,"/");
+ strcat(cwd,mbrLocation2);
+ fits_clean_url(cwd,mbrLocation2,status);
+ }
+ }
+
+ /*
+ if the member location was specified, then make sure that it is
+ either an absolute URL or specifies a full path
+ */
+
+ else if(!fits_is_url_absolute(mbrLocation1) && *mbrLocation1 != '/')
+ {
+ strcpy(mbrLocation2,mbrLocation1);
+
+ /* get the possible URLs for the grouping table file */
+ *status = fits_get_url(gfptr,grpLocation1,grpLocation2,NULL,NULL,
+ NULL,status);
+
+ if(*grpLocation1 != 0)
+ {
+ /* make sure the first grouping table URL is absolute */
+ if(!fits_is_url_absolute(grpLocation1) && *grpLocation1 != '/')
+ {
+ fits_get_cwd(cwd,status);
+ strcat(cwd,"/");
+ strcat(cwd,grpLocation1);
+ fits_clean_url(cwd,grpLocation1,status);
+ }
+
+ /* create an absoute URL for the member */
+
+ fits_relurl2url(grpLocation1,mbrLocation1,mbrLocation3,status);
+
+ /*
+ if URL construction succeeded then copy it to the
+ first location string; else set the location string to
+ empty
+ */
+
+ if(*status == 0)
+ {
+ strcpy(mbrLocation1,mbrLocation3);
+ }
+
+ else if(*status == URL_PARSE_ERROR)
+ {
+ *status = 0;
+ *mbrLocation1 = 0;
+ }
+ }
+ else
+ *mbrLocation1 = 0;
+
+ if(*grpLocation2 != 0)
+ {
+ /* make sure the second grouping table URL is absolute */
+ if(!fits_is_url_absolute(grpLocation2) && *grpLocation2 != '/')
+ {
+ fits_get_cwd(cwd,status);
+ strcat(cwd,"/");
+ strcat(cwd,grpLocation2);
+ fits_clean_url(cwd,grpLocation2,status);
+ }
+
+ /* create an absolute URL for the member */
+
+ fits_relurl2url(grpLocation2,mbrLocation2,mbrLocation3,status);
+
+ /*
+ if URL construction succeeded then copy it to the
+ second location string; else set the location string to
+ empty
+ */
+
+ if(*status == 0)
+ {
+ strcpy(mbrLocation2,mbrLocation3);
+ }
+
+ else if(*status == URL_PARSE_ERROR)
+ {
+ *status = 0;
+ *mbrLocation2 = 0;
+ }
+ }
+ else
+ *mbrLocation2 = 0;
+ }
+
+ /*
+ compare the passed member HDU file location string with the
+ (possibly two) member location strings to see if there is a match
+ */
+
+ if(strcmp(mbrLocation1,tmpLocation) != 0 &&
+ strcmp(mbrLocation2,tmpLocation) != 0 ) continue;
+
+ /* if we made it this far then a match to the member HDU was found */
+
+ *member = i;
+ }
+
+ /* if a match was not found then set the return status code */
+
+ if(*member == 0 && *status == 0)
+ {
+ *status = MEMBER_NOT_FOUND;
+ ffpmsg("Cannot find specified member HDU (ffgmf)");
+ }
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------
+ Recursive Group Functions
+ --------------------------------------------------------------------------*/
+int ffgtrmr(fitsfile *gfptr, /* FITS file pointer to group */
+ HDUtracker *HDU, /* list of processed HDUs */
+ int *status) /* return status code */
+
+/*
+ recursively remove a grouping table and all its members. Each member of
+ the grouping table pointed to by gfptr it processed. If the member is itself
+ a grouping table then ffgtrmr() is recursively called to process all
+ of its members. The HDUtracker struct *HDU is used to make sure a member
+ is not processed twice, thus avoiding an infinite loop (e.g., a grouping
+ table contains itself as a member).
+*/
+
+{
+ int i;
+ int hdutype;
+
+ long nmembers = 0;
+
+ char keyvalue[FLEN_VALUE];
+ char comment[FLEN_COMMENT];
+
+ fitsfile *mfptr = NULL;
+
+
+ if(*status != 0) return(*status);
+
+ /* get the number of members contained by this grouping table */
+
+ *status = fits_get_num_members(gfptr,&nmembers,status);
+
+ /* loop over all group members and delete them */
+
+ for(i = nmembers; i > 0 && *status == 0; --i)
+ {
+ /* open the member HDU */
+
+ *status = fits_open_member(gfptr,i,&mfptr,status);
+
+ /* if the member cannot be opened then just skip it and continue */
+
+ if(*status == MEMBER_NOT_FOUND)
+ {
+ *status = 0;
+ continue;
+ }
+
+ /* Any other error is a reason to abort */
+
+ if(*status != 0) continue;
+
+ /* add the member HDU to the HDUtracker struct */
+
+ *status = fftsad(mfptr,HDU,NULL,NULL);
+
+ /* status == HDU_ALREADY_TRACKED ==> HDU has already been processed */
+
+ if(*status == HDU_ALREADY_TRACKED)
+ {
+ *status = 0;
+ fits_close_file(mfptr,status);
+ continue;
+ }
+ else if(*status != 0) continue;
+
+ /* determine if the member HDU is itself a grouping table */
+
+ *status = fits_read_key_str(mfptr,"EXTNAME",keyvalue,comment,status);
+
+ /* if no EXTNAME is found then the HDU cannot be a grouping table */
+
+ if(*status == KEY_NO_EXIST)
+ {
+ *status = 0;
+ keyvalue[0] = 0;
+ }
+ prepare_keyvalue(keyvalue);
+
+ /* Any other error is a reason to abort */
+
+ if(*status != 0) continue;
+
+ /*
+ if the EXTNAME == GROUPING then the member is a grouping table
+ and we must call ffgtrmr() to process its members
+ */
+
+ if(strcasecmp(keyvalue,"GROUPING") == 0)
+ *status = ffgtrmr(mfptr,HDU,status);
+
+ /*
+ unlink all the grouping tables that contain this HDU as a member
+ and then delete the HDU (if not a PHDU)
+ */
+
+ if(fits_get_hdu_num(mfptr,&hdutype) == 1)
+ *status = ffgmul(mfptr,1,status);
+ else
+ {
+ *status = ffgmul(mfptr,0,status);
+ *status = fits_delete_hdu(mfptr,&hdutype,status);
+ }
+
+ /* close the fitsfile pointer */
+
+ fits_close_file(mfptr,status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtcpr(fitsfile *infptr, /* input FITS file pointer */
+ fitsfile *outfptr, /* output FITS file pointer */
+ int cpopt, /* code specifying copy options:
+ OPT_GCP_GPT (0) ==> cp only grouping table
+ OPT_GCP_ALL (2) ==> recusrively copy
+ members and their members (if groups) */
+ HDUtracker *HDU, /* list of already copied HDUs */
+ int *status) /* return status code */
+
+/*
+ copy a Group to a new FITS file. If the cpopt parameter is set to
+ OPT_GCP_GPT (copy grouping table only) then the existing members have their
+ GRPIDn and GRPLCn keywords updated to reflect the existance of the new group,
+ since they now belong to another group. If cpopt is set to OPT_GCP_ALL
+ (copy grouping table and members recursively) then the original members are
+ not updated; the new grouping table is modified to include only the copied
+ member HDUs and not the original members.
+
+ Note that this function is recursive. When copt is OPT_GCP_ALL it will call
+ itself whenever a member HDU of the current grouping table is itself a
+ grouping table (i.e., EXTNAME = 'GROUPING').
+*/
+
+{
+
+ int i;
+ int nexclude = 8;
+ int hdutype = 0;
+ int groupHDUnum = 0;
+ int numkeys = 0;
+ int keypos = 0;
+ int startSearch = 0;
+ int newPosition = 0;
+
+ long nmembers = 0;
+ long tfields = 0;
+ long newTfields = 0;
+
+ char keyword[FLEN_KEYWORD];
+ char keyvalue[FLEN_VALUE];
+ char card[FLEN_CARD];
+ char comment[FLEN_CARD];
+ char *tkeyvalue;
+
+ char *includeList[] = {"*"};
+ char *excludeList[] = {"EXTNAME","EXTVER","GRPNAME","GRPID#","GRPLC#",
+ "THEAP","TDIM#","T????#"};
+
+ fitsfile *mfptr = NULL;
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /*
+ create a new grouping table in the FITS file pointed to by outptr
+ */
+
+ *status = fits_get_num_members(infptr,&nmembers,status);
+
+ *status = fits_read_key_str(infptr,"GRPNAME",keyvalue,card,status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ keyvalue[0] = 0;
+ *status = 0;
+ }
+ prepare_keyvalue(keyvalue);
+
+ *status = fits_create_group(outfptr,keyvalue,GT_ID_ALL_URI,status);
+
+ /* save the new grouping table's HDU position for future use */
+
+ fits_get_hdu_num(outfptr,&groupHDUnum);
+
+ /* update the HDUtracker struct with the grouping table's new position */
+
+ *status = fftsud(infptr,HDU,groupHDUnum,NULL);
+
+ /*
+ Now populate the copied grouping table depending upon the
+ copy option parameter value
+ */
+
+ switch(cpopt)
+ {
+
+ /*
+ for the "copy grouping table only" option we only have to
+ add the members of the original grouping table to the new
+ grouping table
+ */
+
+ case OPT_GCP_GPT:
+
+ for(i = 1; i <= nmembers && *status == 0; ++i)
+ {
+ *status = fits_open_member(infptr,i,&mfptr,status);
+ *status = fits_add_group_member(outfptr,mfptr,0,status);
+
+ fits_close_file(mfptr,status);
+ mfptr = NULL;
+ }
+
+ break;
+
+ case OPT_GCP_ALL:
+
+ /*
+ for the "copy the entire group" option
+ */
+
+ /* loop over all the grouping table members */
+
+ for(i = 1; i <= nmembers && *status == 0; ++i)
+ {
+ /* open the ith member */
+
+ *status = fits_open_member(infptr,i,&mfptr,status);
+
+ if(*status != 0) continue;
+
+ /* add it to the HDUtracker struct */
+
+ *status = fftsad(mfptr,HDU,&newPosition,NULL);
+
+ /* if already copied then just add the member to the group */
+
+ if(*status == HDU_ALREADY_TRACKED)
+ {
+ *status = 0;
+ *status = fits_add_group_member(outfptr,NULL,newPosition,
+ status);
+ fits_close_file(mfptr,status);
+ mfptr = NULL;
+ continue;
+ }
+ else if(*status != 0) continue;
+
+ /* see if the member is a grouping table */
+
+ *status = fits_read_key_str(mfptr,"EXTNAME",keyvalue,card,
+ status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ keyvalue[0] = 0;
+ *status = 0;
+ }
+ prepare_keyvalue(keyvalue);
+
+ /*
+ if the member is a grouping table then copy it and all of
+ its members using ffgtcpr(), else copy it using
+ fits_copy_member(); the outptr will point to the newly
+ copied member upon return from both functions
+ */
+
+ if(strcasecmp(keyvalue,"GROUPING") == 0)
+ *status = ffgtcpr(mfptr,outfptr,OPT_GCP_ALL,HDU,status);
+ else
+ *status = fits_copy_member(infptr,outfptr,i,OPT_MCP_NADD,
+ status);
+
+ /* retrieve the position of the newly copied member */
+
+ fits_get_hdu_num(outfptr,&newPosition);
+
+ /* update the HDUtracker struct with member's new position */
+
+ if(strcasecmp(keyvalue,"GROUPING") != 0)
+ *status = fftsud(mfptr,HDU,newPosition,NULL);
+
+ /* move the outfptr back to the copied grouping table HDU */
+
+ *status = fits_movabs_hdu(outfptr,groupHDUnum,&hdutype,status);
+
+ /* add the copied member HDU to the copied grouping table */
+
+ *status = fits_add_group_member(outfptr,NULL,newPosition,status);
+
+ /* close the mfptr pointer */
+
+ fits_close_file(mfptr,status);
+ mfptr = NULL;
+ }
+
+ break;
+
+ default:
+
+ *status = BAD_OPTION;
+ ffpmsg("Invalid value specified for cmopt parameter (ffgtcpr)");
+ break;
+ }
+
+ if(*status != 0) continue;
+
+ /*
+ reposition the outfptr to the grouping table so that the grouping
+ table is the CHDU upon return to the calling function
+ */
+
+ fits_movabs_hdu(outfptr,groupHDUnum,&hdutype,status);
+
+ /*
+ copy all auxiliary keyword records from the original grouping table
+ to the new grouping table; they are copied in their original order
+ and inserted just before the TTYPE1 keyword record
+ */
+
+ *status = fits_read_card(outfptr,"TTYPE1",card,status);
+ *status = fits_get_hdrpos(outfptr,&numkeys,&keypos,status);
+ --keypos;
+
+ startSearch = 8;
+
+ while(*status == 0)
+ {
+ ffgrec(infptr,startSearch,card,status);
+
+ *status = fits_find_nextkey(infptr,includeList,1,excludeList,
+ nexclude,card,status);
+
+ *status = fits_get_hdrpos(infptr,&numkeys,&startSearch,status);
+
+ --startSearch;
+ /* SPR 1738 */
+ if (strncmp(card,"GRPLC",5)) {
+ /* Not going to be a long string so we're ok */
+ *status = fits_insert_record(outfptr,keypos,card,status);
+ } else {
+ /* We could have a long string */
+ *status = fits_read_record(infptr,startSearch,card,status);
+ card[9] = '\0';
+ *status = fits_read_key_longstr(infptr,card,&tkeyvalue,comment,
+ status);
+ if (0 == *status) {
+ fits_insert_key_longstr(outfptr,card,tkeyvalue,comment,status);
+ fits_write_key_longwarn(outfptr,status);
+ free(tkeyvalue);
+ }
+ }
+
+ ++keypos;
+ }
+
+
+ if(*status == KEY_NO_EXIST)
+ *status = 0;
+ else if(*status != 0) continue;
+
+ /*
+ search all the columns of the original grouping table and copy
+ those to the new grouping table that were not part of the grouping
+ convention. Note that is legal to have additional columns in a
+ grouping table. Also note that the order of the columns may
+ not be the same in the original and copied grouping table.
+ */
+
+ /* retrieve the number of columns in the original and new group tables */
+
+ *status = fits_read_key_lng(infptr,"TFIELDS",&tfields,card,status);
+ *status = fits_read_key_lng(outfptr,"TFIELDS",&newTfields,card,status);
+
+ for(i = 1; i <= tfields; ++i)
+ {
+ sprintf(keyword,"TTYPE%d",i);
+ *status = fits_read_key_str(infptr,keyword,keyvalue,card,status);
+
+ if(*status == KEY_NO_EXIST)
+ {
+ *status = 0;
+ keyvalue[0] = 0;
+ }
+ prepare_keyvalue(keyvalue);
+
+ if(strcasecmp(keyvalue,"MEMBER_XTENSION") != 0 &&
+ strcasecmp(keyvalue,"MEMBER_NAME") != 0 &&
+ strcasecmp(keyvalue,"MEMBER_VERSION") != 0 &&
+ strcasecmp(keyvalue,"MEMBER_POSITION") != 0 &&
+ strcasecmp(keyvalue,"MEMBER_LOCATION") != 0 &&
+ strcasecmp(keyvalue,"MEMBER_URI_TYPE") != 0 )
+ {
+
+ /* SPR 3956, add at the end of the table */
+ *status = fits_copy_col(infptr,outfptr,i,newTfields+1,1,status);
+ ++newTfields;
+ }
+ }
+
+ }while(0);
+
+ if(mfptr != NULL)
+ {
+ fits_close_file(mfptr,status);
+ }
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------
+ HDUtracker struct manipulation functions
+ --------------------------------------------------------------------------*/
+int fftsad(fitsfile *mfptr, /* pointer to an member HDU */
+ HDUtracker *HDU, /* pointer to an HDU tracker struct */
+ int *newPosition, /* new HDU position of the member HDU */
+ char *newFileName) /* file containing member HDU */
+
+/*
+ add an HDU to the HDUtracker struct pointed to by HDU. The HDU is only
+ added if it does not already reside in the HDUtracker. If it already
+ resides in the HDUtracker then the new HDU postion and file name are
+ returned in newPosition and newFileName (if != NULL)
+*/
+
+{
+ int i;
+ int hdunum;
+ int status = 0;
+
+ char filename1[FLEN_FILENAME];
+ char filename2[FLEN_FILENAME];
+
+ do
+ {
+ /* retrieve the HDU's position within the FITS file */
+
+ fits_get_hdu_num(mfptr,&hdunum);
+
+ /* retrieve the HDU's file name */
+
+ status = fits_file_name(mfptr,filename1,&status);
+
+ /* parse the file name and construct the "standard" URL for it */
+
+ status = ffrtnm(filename1,filename2,&status);
+
+ /*
+ examine all the existing HDUs in the HDUtracker an see if this HDU
+ has already been registered
+ */
+
+ for(i = 0;
+ i < HDU->nHDU && !(HDU->position[i] == hdunum
+ && strcmp(HDU->filename[i],filename2) == 0);
+ ++i);
+
+ if(i != HDU->nHDU)
+ {
+ status = HDU_ALREADY_TRACKED;
+ if(newPosition != NULL) *newPosition = HDU->newPosition[i];
+ if(newFileName != NULL) strcpy(newFileName,HDU->newFilename[i]);
+ continue;
+ }
+
+ if(HDU->nHDU == MAX_HDU_TRACKER)
+ {
+ status = TOO_MANY_HDUS_TRACKED;
+ continue;
+ }
+
+ HDU->filename[i] = (char*) malloc(FLEN_FILENAME * sizeof(char));
+
+ if(HDU->filename[i] == NULL)
+ {
+ status = MEMORY_ALLOCATION;
+ continue;
+ }
+
+ HDU->newFilename[i] = (char*) malloc(FLEN_FILENAME * sizeof(char));
+
+ if(HDU->newFilename[i] == NULL)
+ {
+ status = MEMORY_ALLOCATION;
+ free(HDU->filename[i]);
+ continue;
+ }
+
+ HDU->position[i] = hdunum;
+ HDU->newPosition[i] = hdunum;
+
+ strcpy(HDU->filename[i],filename2);
+ strcpy(HDU->newFilename[i],filename2);
+
+ ++(HDU->nHDU);
+
+ }while(0);
+
+ return(status);
+}
+/*--------------------------------------------------------------------------*/
+int fftsud(fitsfile *mfptr, /* pointer to an member HDU */
+ HDUtracker *HDU, /* pointer to an HDU tracker struct */
+ int newPosition, /* new HDU position of the member HDU */
+ char *newFileName) /* file containing member HDU */
+
+/*
+ update the HDU information in the HDUtracker struct pointed to by HDU. The
+ HDU to update is pointed to by mfptr. If non-zero, the value of newPosition
+ is used to update the HDU->newPosition[] value for the mfptr, and if
+ non-NULL the newFileName value is used to update the HDU->newFilename[]
+ value for mfptr.
+*/
+
+{
+ int i;
+ int hdunum;
+ int status = 0;
+
+ char filename1[FLEN_FILENAME];
+ char filename2[FLEN_FILENAME];
+
+
+ /* retrieve the HDU's position within the FITS file */
+
+ fits_get_hdu_num(mfptr,&hdunum);
+
+ /* retrieve the HDU's file name */
+
+ status = fits_file_name(mfptr,filename1,&status);
+
+ /* parse the file name and construct the "standard" URL for it */
+
+ status = ffrtnm(filename1,filename2,&status);
+
+ /*
+ examine all the existing HDUs in the HDUtracker an see if this HDU
+ has already been registered
+ */
+
+ for(i = 0; i < HDU->nHDU &&
+ !(HDU->position[i] == hdunum && strcmp(HDU->filename[i],filename2) == 0);
+ ++i);
+
+ /* if previously registered then change newPosition and newFileName */
+
+ if(i != HDU->nHDU)
+ {
+ if(newPosition != 0) HDU->newPosition[i] = newPosition;
+ if(newFileName != NULL)
+ {
+ strcpy(HDU->newFilename[i],newFileName);
+ }
+ }
+ else
+ status = MEMBER_NOT_FOUND;
+
+ return(status);
+}
+
+/*---------------------------------------------------------------------------*/
+
+void prepare_keyvalue(char *keyvalue) /* string containing keyword value */
+
+/*
+ strip off all single quote characters "'" and blank spaces from a keyword
+ value retrieved via fits_read_key*() routines
+
+ this is necessary so that a standard comparision of keyword values may
+ be made
+*/
+
+{
+
+ int i;
+ int length;
+
+ /*
+ strip off any leading or trailing single quotes (`) and (') from
+ the keyword value
+ */
+
+ length = strlen(keyvalue) - 1;
+
+ if(keyvalue[0] == '\'' && keyvalue[length] == '\'')
+ {
+ for(i = 0; i < length - 1; ++i) keyvalue[i] = keyvalue[i+1];
+ keyvalue[length-1] = 0;
+ }
+
+ /*
+ strip off any trailing blanks from the keyword value; note that if the
+ keyvalue consists of nothing but blanks then no blanks are stripped
+ */
+
+ length = strlen(keyvalue) - 1;
+
+ for(i = 0; i < length && keyvalue[i] == ' '; ++i);
+
+ if(i != length)
+ {
+ for(i = length; i >= 0 && keyvalue[i] == ' '; --i) keyvalue[i] = '\0';
+ }
+}
+
+/*---------------------------------------------------------------------------
+ Host dependent directory path to/from URL functions
+ --------------------------------------------------------------------------*/
+int fits_path2url(char *inpath, /* input file path string */
+ char *outpath, /* output file path string */
+ int *status)
+ /*
+ convert a file path into its Unix-style equivelent for URL
+ purposes. Note that this process is platform dependent. This
+ function supports Unix, MSDOS/WIN32, VMS and Macintosh platforms.
+ The plaform dependant code is conditionally compiled depending upon
+ the setting of the appropriate C preprocessor macros.
+ */
+{
+ char buff[FLEN_FILENAME];
+
+#if defined(WINNT) || defined(__WINNT__)
+
+ /*
+ Microsoft Windows NT case. We assume input file paths of the form:
+
+ //disk/path/filename
+
+ All path segments may be null, so that a single file name is the
+ simplist case.
+
+ The leading "//" becomes a single "/" if present. If no "//" is present,
+ then make sure the resulting URL path is relative, i.e., does not
+ begin with a "/". In other words, the only way that an absolute URL
+ file path may be generated is if the drive specification is given.
+ */
+
+ if(*status > 0) return(*status);
+
+ if(inpath[0] == '/')
+ {
+ strcpy(buff,inpath+1);
+ }
+ else
+ {
+ strcpy(buff,inpath);
+ }
+
+#elif defined(MSDOS) || defined(__WIN32__) || defined(WIN32)
+
+ /*
+ MSDOS or Microsoft windows/NT case. The assumed form of the
+ input path is:
+
+ disk:\path\filename
+
+ All path segments may be null, so that a single file name is the
+ simplist case.
+
+ All back-slashes '\' become slashes '/'; if the path starts with a
+ string of the form "X:" then it is replaced with "/X/"
+ */
+
+ int i,j,k;
+ int size;
+ if(*status > 0) return(*status);
+
+ for(i = 0, j = 0, size = strlen(inpath), buff[0] = 0;
+ i < size; j = strlen(buff))
+ {
+ switch(inpath[i])
+ {
+
+ case ':':
+
+ /*
+ must be a disk desiginator; add a slash '/' at the start of
+ outpath to designate that the path is absolute, then change
+ the colon ':' to a slash '/'
+ */
+
+ for(k = j; k >= 0; --k) buff[k+1] = buff[k];
+ buff[0] = '/';
+ strcat(buff,"/");
+ ++i;
+
+ break;
+
+ case '\\':
+
+ /* just replace the '\' with a '/' IF its not the first character */
+
+ if(i != 0 && buff[(j == 0 ? 0 : j-1)] != '/')
+ {
+ buff[j] = '/';
+ buff[j+1] = 0;
+ }
+
+ ++i;
+
+ break;
+
+ default:
+
+ /* copy the character from inpath to buff as is */
+
+ buff[j] = inpath[i];
+ buff[j+1] = 0;
+ ++i;
+
+ break;
+ }
+ }
+
+#elif defined(VMS) || defined(vms) || defined(__vms)
+
+ /*
+ VMS case. Assumed format of the input path is:
+
+ node::disk:[path]filename.ext;version
+
+ Any part of the file path may be missing, so that in the simplist
+ case a single file name/extension is given.
+
+ all brackets "[", "]" and dots "." become "/"; dashes "-" become "..",
+ all single colons ":" become ":/", all double colons "::" become
+ "FILE://"
+ */
+
+ int i,j,k;
+ int done;
+ int size;
+
+ if(*status > 0) return(*status);
+
+ /* see if inpath contains a directory specification */
+
+ if(strchr(inpath,']') == NULL)
+ done = 1;
+ else
+ done = 0;
+
+ for(i = 0, j = 0, size = strlen(inpath), buff[0] = 0;
+ i < size && j < FLEN_FILENAME - 8; j = strlen(buff))
+ {
+ switch(inpath[i])
+ {
+
+ case ':':
+
+ /*
+ must be a logical/symbol separator or (in the case of a double
+ colon "::") machine node separator
+ */
+
+ if(inpath[i+1] == ':')
+ {
+ /* insert a "FILE://" at the start of buff ==> machine given */
+
+ for(k = j; k >= 0; --k) buff[k+7] = buff[k];
+ strncpy(buff,"FILE://",7);
+ i += 2;
+ }
+ else if(strstr(buff,"FILE://") == NULL)
+ {
+ /* insert a "/" at the start of buff ==> absolute path */
+
+ for(k = j; k >= 0; --k) buff[k+1] = buff[k];
+ buff[0] = '/';
+ ++i;
+ }
+ else
+ ++i;
+
+ /* a colon always ==> path separator */
+
+ strcat(buff,"/");
+
+ break;
+
+ case ']':
+
+ /* end of directory spec, file name spec begins after this */
+
+ done = 1;
+
+ buff[j] = '/';
+ buff[j+1] = 0;
+ ++i;
+
+ break;
+
+ case '[':
+
+ /*
+ begin directory specification; add a '/' only if the last char
+ is not '/'
+ */
+
+ if(i != 0 && buff[(j == 0 ? 0 : j-1)] != '/')
+ {
+ buff[j] = '/';
+ buff[j+1] = 0;
+ }
+
+ ++i;
+
+ break;
+
+ case '.':
+
+ /*
+ directory segment separator or file name/extension separator;
+ we decide which by looking at the value of done
+ */
+
+ if(!done)
+ {
+ /* must be a directory segment separator */
+ if(inpath[i-1] == '[')
+ {
+ strcat(buff,"./");
+ ++j;
+ }
+ else
+ buff[j] = '/';
+ }
+ else
+ /* must be a filename/extension separator */
+ buff[j] = '.';
+
+ buff[j+1] = 0;
+
+ ++i;
+
+ break;
+
+ case '-':
+
+ /*
+ a dash is the same as ".." in Unix speak, but lets make sure
+ that its not part of the file name first!
+ */
+
+ if(!done)
+ /* must be part of the directory path specification */
+ strcat(buff,"..");
+ else
+ {
+ /* the dash is part of the filename, so just copy it as is */
+ buff[j] = '-';
+ buff[j+1] = 0;
+ }
+
+ ++i;
+
+ break;
+
+ default:
+
+ /* nothing special, just copy the character as is */
+
+ buff[j] = inpath[i];
+ buff[j+1] = 0;
+
+ ++i;
+
+ break;
+
+ }
+ }
+
+ if(j > FLEN_FILENAME - 8)
+ {
+ *status = URL_PARSE_ERROR;
+ ffpmsg("resulting path to URL conversion too big (fits_path2url)");
+ }
+
+#elif defined(macintosh)
+
+ /*
+ MacOS case. The assumed form of the input path is:
+
+ disk:path:filename
+
+ It is assumed that all paths are absolute with disk and path specified,
+ unless no colons ":" are supplied with the string ==> a single file name
+ only. All colons ":" become slashes "/", and if one or more colon is
+ encountered then the path is specified as absolute.
+ */
+
+ int i,j,k;
+ int firstColon;
+ int size;
+
+ if(*status > 0) return(*status);
+
+ for(i = 0, j = 0, firstColon = 1, size = strlen(inpath), buff[0] = 0;
+ i < size; j = strlen(buff))
+ {
+ switch(inpath[i])
+ {
+
+ case ':':
+
+ /*
+ colons imply path separators. If its the first colon encountered
+ then assume that its the disk designator and add a slash to the
+ beginning of the buff string
+ */
+
+ if(firstColon)
+ {
+ firstColon = 0;
+
+ for(k = j; k >= 0; --k) buff[k+1] = buff[k];
+ buff[0] = '/';
+ }
+
+ /* all colons become slashes */
+
+ strcat(buff,"/");
+
+ ++i;
+
+ break;
+
+ default:
+
+ /* copy the character from inpath to buff as is */
+
+ buff[j] = inpath[i];
+ buff[j+1] = 0;
+
+ ++i;
+
+ break;
+ }
+ }
+
+#else
+
+ /*
+ Default Unix case.
+
+ Nothing special to do here except to remove the double or more // and
+ replace them with single /
+ */
+
+ int ii = 0;
+ int jj = 0;
+
+ if(*status > 0) return(*status);
+
+ while (inpath[ii]) {
+ if (inpath[ii] == '/' && inpath[ii+1] == '/') {
+ /* do nothing */
+ } else {
+ buff[jj] = inpath[ii];
+ jj++;
+ }
+ ii++;
+ }
+ buff[jj] = '\0';
+ /* printf("buff is %s\ninpath is %s\n",buff,inpath); */
+ /* strcpy(buff,inpath); */
+
+#endif
+
+ /*
+ encode all "unsafe" and "reserved" URL characters
+ */
+
+ *status = fits_encode_url(buff,outpath,status);
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int fits_url2path(char *inpath, /* input file path string */
+ char *outpath, /* output file path string */
+ int *status)
+ /*
+ convert a Unix-style URL into a platform dependent directory path.
+ Note that this process is platform dependent. This
+ function supports Unix, MSDOS/WIN32, VMS and Macintosh platforms. Each
+ platform dependent code segment is conditionally compiled depending
+ upon the setting of the appropriate C preprocesser macros.
+ */
+{
+ char buff[FLEN_FILENAME];
+ int absolute;
+
+#if defined(MSDOS) || defined(__WIN32__) || defined(WIN32)
+ char *tmpStr;
+#elif defined(VMS) || defined(vms) || defined(__vms)
+ int i;
+ char *tmpStr;
+#elif defined(macintosh)
+ char *tmpStr;
+#endif
+
+ if(*status != 0) return(*status);
+
+ /*
+ make a copy of the inpath so that we can manipulate it
+ */
+
+ strcpy(buff,inpath);
+
+ /*
+ convert any encoded characters to their unencoded values
+ */
+
+ *status = fits_unencode_url(inpath,buff,status);
+
+ /*
+ see if the URL is given as absolute w.r.t. the "local" file system
+ */
+
+ if(buff[0] == '/')
+ absolute = 1;
+ else
+ absolute = 0;
+
+#if defined(WINNT) || defined(__WINNT__)
+
+ /*
+ Microsoft Windows NT case. We create output paths of the form
+
+ //disk/path/filename
+
+ All path segments but the last may be null, so that a single file name
+ is the simplist case.
+ */
+
+ if(absolute)
+ {
+ strcpy(outpath,"/");
+ strcat(outpath,buff);
+ }
+ else
+ {
+ strcpy(outpath,buff);
+ }
+
+#elif defined(MSDOS) || defined(__WIN32__) || defined(WIN32)
+
+ /*
+ MSDOS or Microsoft windows/NT case. The output path will be of the
+ form
+
+ disk:\path\filename
+
+ All path segments but the last may be null, so that a single file name
+ is the simplist case.
+ */
+
+ /*
+ separate the URL into tokens at each slash '/' and process until
+ all tokens have been examined
+ */
+
+ for(tmpStr = strtok(buff,"/"), outpath[0] = 0;
+ tmpStr != NULL; tmpStr = strtok(NULL,"/"))
+ {
+ strcat(outpath,tmpStr);
+
+ /*
+ if the absolute flag is set then process the token as a disk
+ specification; else just process it as a directory path or filename
+ */
+
+ if(absolute)
+ {
+ strcat(outpath,":\\");
+ absolute = 0;
+ }
+ else
+ strcat(outpath,"\\");
+ }
+
+ /* remove the last "\" from the outpath, it does not belong there */
+
+ outpath[strlen(outpath)-1] = 0;
+
+#elif defined(VMS) || defined(vms) || defined(__vms)
+
+ /*
+ VMS case. The output path will be of the form:
+
+ node::disk:[path]filename.ext;version
+
+ Any part of the file path may be missing execpt filename.ext, so that in
+ the simplist case a single file name/extension is given.
+
+ if the path is specified as relative starting with "./" then the first
+ part of the VMS path is "[.". If the path is relative and does not start
+ with "./" (e.g., "a/b/c") then the VMS path is constructed as
+ "[a.b.c]"
+ */
+
+ /*
+ separate the URL into tokens at each slash '/' and process until
+ all tokens have been examined
+ */
+
+ for(tmpStr = strtok(buff,"/"), outpath[0] = 0;
+ tmpStr != NULL; tmpStr = strtok(NULL,"/"))
+ {
+
+ if(strcasecmp(tmpStr,"FILE:") == 0)
+ {
+ /* the next token should contain the DECnet machine name */
+
+ tmpStr = strtok(NULL,"/");
+ if(tmpStr == NULL) continue;
+
+ strcat(outpath,tmpStr);
+ strcat(outpath,"::");
+
+ /* set the absolute flag to true for the next token */
+ absolute = 1;
+ }
+
+ else if(strcmp(tmpStr,"..") == 0)
+ {
+ /* replace all Unix-like ".." with VMS "-" */
+
+ if(strlen(outpath) == 0) strcat(outpath,"[");
+ strcat(outpath,"-.");
+ }
+
+ else if(strcmp(tmpStr,".") == 0 && strlen(outpath) == 0)
+ {
+ /*
+ must indicate a relative path specifier
+ */
+
+ strcat(outpath,"[.");
+ }
+
+ else if(strchr(tmpStr,'.') != NULL)
+ {
+ /*
+ must be up to the file name; turn the last "." path separator
+ into a "]" and then add the file name to the outpath
+ */
+
+ i = strlen(outpath);
+ if(i > 0 && outpath[i-1] == '.') outpath[i-1] = ']';
+
+ strcat(outpath,tmpStr);
+ }
+
+ else
+ {
+ /*
+ process the token as a a directory path segement
+ */
+
+ if(absolute)
+ {
+ /* treat the token as a disk specifier */
+ absolute = 0;
+ strcat(outpath,tmpStr);
+ strcat(outpath,":[");
+ }
+ else if(strlen(outpath) == 0)
+ {
+ /* treat the token as the first directory path specifier */
+ strcat(outpath,"[");
+ strcat(outpath,tmpStr);
+ strcat(outpath,".");
+ }
+ else
+ {
+ /* treat the token as an imtermediate path specifier */
+ strcat(outpath,tmpStr);
+ strcat(outpath,".");
+ }
+ }
+ }
+
+#elif defined(macintosh)
+
+ /*
+ MacOS case. The output path will be of the form
+
+ disk:path:filename
+
+ All path segments but the last may be null, so that a single file name
+ is the simplist case.
+ */
+
+ /*
+ separate the URL into tokens at each slash '/' and process until
+ all tokens have been examined
+ */
+
+ for(tmpStr = strtok(buff,"/"), outpath[0] = 0;
+ tmpStr != NULL; tmpStr = strtok(NULL,"/"))
+ {
+ strcat(outpath,tmpStr);
+ strcat(outpath,":");
+ }
+
+ /* remove the last ":" from the outpath, it does not belong there */
+
+ outpath[strlen(outpath)-1] = 0;
+
+#else
+
+ /*
+ Default Unix case.
+
+ Nothing special to do here
+ */
+
+ strcpy(outpath,buff);
+
+#endif
+
+ return(*status);
+}
+
+/****************************************************************************/
+int fits_get_cwd(char *cwd, /* IO current working directory string */
+ int *status)
+ /*
+ retrieve the string containing the current working directory absolute
+ path in Unix-like URL standard notation. It is assumed that the CWD
+ string has a size of at least FLEN_FILENAME.
+
+ Note that this process is platform dependent. This
+ function supports Unix, MSDOS/WIN32, VMS and Macintosh platforms. Each
+ platform dependent code segment is conditionally compiled depending
+ upon the setting of the appropriate C preprocesser macros.
+ */
+{
+
+ char buff[FLEN_FILENAME];
+
+
+ if(*status != 0) return(*status);
+
+#if defined(macintosh)
+
+ /*
+ MacOS case. Currently unknown !!!!
+ */
+
+ *buff = 0;
+
+#else
+ /*
+ Good old getcwd() seems to work with all other platforms
+ */
+
+ getcwd(buff,FLEN_FILENAME);
+
+#endif
+
+ /*
+ convert the cwd string to a URL standard path string
+ */
+
+ fits_path2url(buff,cwd,status);
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int fits_get_url(fitsfile *fptr, /* I ptr to FITS file to evaluate */
+ char *realURL, /* O URL of real FITS file */
+ char *startURL, /* O URL of starting FITS file */
+ char *realAccess, /* O true access method of FITS file */
+ char *startAccess,/* O "official" access of FITS file */
+ int *iostate, /* O can this file be modified? */
+ int *status)
+/*
+ For grouping convention purposes, determine the URL of the FITS file
+ associated with the fitsfile pointer fptr. The true access type (file://,
+ mem://, shmem://, root://), starting "official" access type, and iostate
+ (0 ==> readonly, 1 ==> readwrite) are also returned.
+
+ It is assumed that the url string has enough room to hold the resulting
+ URL, and the the accessType string has enough room to hold the access type.
+*/
+{
+ int i;
+ int tmpIOstate = 0;
+
+ char infile[FLEN_FILENAME];
+ char outfile[FLEN_FILENAME];
+ char tmpStr1[FLEN_FILENAME];
+ char tmpStr2[FLEN_FILENAME];
+ char tmpStr3[FLEN_FILENAME];
+ char tmpStr4[FLEN_FILENAME];
+ char *tmpPtr;
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+ /*
+ retrieve the member HDU's file name as opened by ffopen()
+ and parse it into its constitutent pieces; get the currently
+ active driver token too
+ */
+
+ *tmpStr1 = *tmpStr2 = *tmpStr3 = *tmpStr4 = 0;
+
+ *status = fits_file_name(fptr,tmpStr1,status);
+
+ *status = ffiurl(tmpStr1,NULL,infile,outfile,NULL,tmpStr2,tmpStr3,
+ tmpStr4,status);
+
+ if((*tmpStr2) || (*tmpStr3) || (*tmpStr4)) tmpIOstate = -1;
+
+ *status = ffurlt(fptr,tmpStr3,status);
+
+ strcpy(tmpStr4,tmpStr3);
+
+ *status = ffrtnm(tmpStr1,tmpStr2,status);
+ strcpy(tmpStr1,tmpStr2);
+
+ /*
+ for grouping convention purposes (only) determine the URL of the
+ actual FITS file being used for the given fptr, its true access
+ type (file://, mem://, shmem://, root://) and its iostate (0 ==>
+ read only, 1 ==> readwrite)
+ */
+
+ /*
+ The first set of access types are "simple" in that they do not
+ use any redirection to temporary memory or outfiles
+ */
+
+ /* standard disk file driver is in use */
+
+ if(strcasecmp(tmpStr3,"file://") == 0)
+ {
+ tmpIOstate = 1;
+
+ if(strlen(outfile)) strcpy(tmpStr1,outfile);
+ else *tmpStr2 = 0;
+
+ /*
+ make sure no FILE:// specifier is given in the tmpStr1
+ or tmpStr2 strings; the convention calls for local files
+ to have no access specification
+ */
+
+ if((tmpPtr = strstr(tmpStr1,"://")) != NULL)
+ {
+ strcpy(infile,tmpPtr+3);
+ strcpy(tmpStr1,infile);
+ }
+
+ if((tmpPtr = strstr(tmpStr2,"://")) != NULL)
+ {
+ strcpy(infile,tmpPtr+3);
+ strcpy(tmpStr2,infile);
+ }
+ }
+
+ /* file stored in conventional memory */
+
+ else if(strcasecmp(tmpStr3,"mem://") == 0)
+ {
+ if(tmpIOstate < 0)
+ {
+ /* file is a temp mem file only */
+ ffpmsg("cannot make URL from temp MEM:// file (fits_get_url)");
+ *status = URL_PARSE_ERROR;
+ }
+ else
+ {
+ /* file is a "perminate" mem file for this process */
+ tmpIOstate = 1;
+ *tmpStr2 = 0;
+ }
+ }
+
+ /* file stored in conventional memory */
+
+ else if(strcasecmp(tmpStr3,"memkeep://") == 0)
+ {
+ strcpy(tmpStr3,"mem://");
+ *tmpStr4 = 0;
+ *tmpStr2 = 0;
+ tmpIOstate = 1;
+ }
+
+ /* file residing in shared memory */
+
+ else if(strcasecmp(tmpStr3,"shmem://") == 0)
+ {
+ *tmpStr4 = 0;
+ *tmpStr2 = 0;
+ tmpIOstate = 1;
+ }
+
+ /* file accessed via the ROOT network protocol */
+
+ else if(strcasecmp(tmpStr3,"root://") == 0)
+ {
+ *tmpStr4 = 0;
+ *tmpStr2 = 0;
+ tmpIOstate = 1;
+ }
+
+ /*
+ the next set of access types redirect the contents of the original
+ file to an special outfile because the original could not be
+ directly modified (i.e., resides on the network, was compressed).
+ In these cases the URL string takes on the value of the OUTFILE,
+ the access type becomes file://, and the iostate is set to 1 (can
+ read/write to the file).
+ */
+
+ /* compressed file uncompressed and written to disk */
+
+ else if(strcasecmp(tmpStr3,"compressfile://") == 0)
+ {
+ strcpy(tmpStr1,outfile);
+ strcpy(tmpStr2,infile);
+ strcpy(tmpStr3,"file://");
+ strcpy(tmpStr4,"file://");
+ tmpIOstate = 1;
+ }
+
+ /* HTTP accessed file written locally to disk */
+
+ else if(strcasecmp(tmpStr3,"httpfile://") == 0)
+ {
+ strcpy(tmpStr1,outfile);
+ strcpy(tmpStr3,"file://");
+ strcpy(tmpStr4,"http://";);
+ tmpIOstate = 1;
+ }
+
+ /* FTP accessd file written locally to disk */
+
+ else if(strcasecmp(tmpStr3,"ftpfile://") == 0)
+ {
+ strcpy(tmpStr1,outfile);
+ strcpy(tmpStr3,"file://");
+ strcpy(tmpStr4,"ftp://";);
+ tmpIOstate = 1;
+ }
+
+ /* file from STDIN written to disk */
+
+ else if(strcasecmp(tmpStr3,"stdinfile://") == 0)
+ {
+ strcpy(tmpStr1,outfile);
+ strcpy(tmpStr3,"file://");
+ strcpy(tmpStr4,"stdin://");
+ tmpIOstate = 1;
+ }
+
+ /*
+ the following access types use memory resident files as temporary
+ storage; they cannot be modified or be made group members for
+ grouping conventions purposes, but their original files can be.
+ Thus, their tmpStr3s are reset to mem://, their iostate
+ values are set to 0 (for no-modification), and their URL string
+ values remain set to their original values
+ */
+
+ /* compressed disk file uncompressed into memory */
+
+ else if(strcasecmp(tmpStr3,"compress://") == 0)
+ {
+ *tmpStr1 = 0;
+ strcpy(tmpStr2,infile);
+ strcpy(tmpStr3,"mem://");
+ strcpy(tmpStr4,"file://");
+ tmpIOstate = 0;
+ }
+
+ /* HTTP accessed file transferred into memory */
+
+ else if(strcasecmp(tmpStr3,"http://";) == 0)
+ {
+ *tmpStr1 = 0;
+ strcpy(tmpStr3,"mem://");
+ strcpy(tmpStr4,"http://";);
+ tmpIOstate = 0;
+ }
+
+ /* HTTP accessed compressed file transferred into memory */
+
+ else if(strcasecmp(tmpStr3,"httpcompress://") == 0)
+ {
+ *tmpStr1 = 0;
+ strcpy(tmpStr3,"mem://");
+ strcpy(tmpStr4,"http://";);
+ tmpIOstate = 0;
+ }
+
+ /* FTP accessed file transferred into memory */
+
+ else if(strcasecmp(tmpStr3,"ftp://";) == 0)
+ {
+ *tmpStr1 = 0;
+ strcpy(tmpStr3,"mem://");
+ strcpy(tmpStr4,"ftp://";);
+ tmpIOstate = 0;
+ }
+
+ /* FTP accessed compressed file transferred into memory */
+
+ else if(strcasecmp(tmpStr3,"ftpcompress://") == 0)
+ {
+ *tmpStr1 = 0;
+ strcpy(tmpStr3,"mem://");
+ strcpy(tmpStr4,"ftp://";);
+ tmpIOstate = 0;
+ }
+
+ /*
+ The last set of access types cannot be used to make a meaningful URL
+ strings from; thus an error is generated
+ */
+
+ else if(strcasecmp(tmpStr3,"stdin://") == 0)
+ {
+ *status = URL_PARSE_ERROR;
+ ffpmsg("cannot make vaild URL from stdin:// (fits_get_url)");
+ *tmpStr1 = *tmpStr2 = 0;
+ }
+
+ else if(strcasecmp(tmpStr3,"stdout://") == 0)
+ {
+ *status = URL_PARSE_ERROR;
+ ffpmsg("cannot make vaild URL from stdout:// (fits_get_url)");
+ *tmpStr1 = *tmpStr2 = 0;
+ }
+
+ else if(strcasecmp(tmpStr3,"irafmem://") == 0)
+ {
+ *status = URL_PARSE_ERROR;
+ ffpmsg("cannot make vaild URL from irafmem:// (fits_get_url)");
+ *tmpStr1 = *tmpStr2 = 0;
+ }
+
+ if(*status != 0) continue;
+
+ /*
+ assign values to the calling parameters if they are non-NULL
+ */
+
+ if(realURL != NULL)
+ {
+ if(strlen(tmpStr1) == 0)
+ *realURL = 0;
+ else
+ {
+ if((tmpPtr = strstr(tmpStr1,"://")) != NULL)
+ {
+ tmpPtr += 3;
+ i = (long)tmpPtr - (long)tmpStr1;
+ strncpy(realURL,tmpStr1,i);
+ }
+ else
+ {
+ tmpPtr = tmpStr1;
+ i = 0;
+ }
+
+ *status = fits_path2url(tmpPtr,realURL+i,status);
+ }
+ }
+
+ if(startURL != NULL)
+ {
+ if(strlen(tmpStr2) == 0)
+ *startURL = 0;
+ else
+ {
+ if((tmpPtr = strstr(tmpStr2,"://")) != NULL)
+ {
+ tmpPtr += 3;
+ i = (long)tmpPtr - (long)tmpStr2;
+ strncpy(startURL,tmpStr2,i);
+ }
+ else
+ {
+ tmpPtr = tmpStr2;
+ i = 0;
+ }
+
+ *status = fits_path2url(tmpPtr,startURL+i,status);
+ }
+ }
+
+ if(realAccess != NULL) strcpy(realAccess,tmpStr3);
+ if(startAccess != NULL) strcpy(startAccess,tmpStr4);
+ if(iostate != NULL) *iostate = tmpIOstate;
+
+ }while(0);
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------
+ URL parse support functions
+ --------------------------------------------------------------------------*/
+
+/* simple push/pop/shift/unshift string stack for use by fits_clean_url */
+typedef char* grp_stack_data; /* type of data held by grp_stack */
+
+typedef struct grp_stack_item_struct {
+ grp_stack_data data; /* value of this stack item */
+ struct grp_stack_item_struct* next; /* next stack item */
+ struct grp_stack_item_struct* prev; /* previous stack item */
+} grp_stack_item;
+
+typedef struct grp_stack_struct {
+ size_t stack_size; /* number of items on stack */
+ grp_stack_item* top; /* top item */
+} grp_stack;
+
+static char* grp_stack_default = NULL; /* initial value for new instances
+ of grp_stack_data */
+
+/* the following functions implement the group string stack grp_stack */
+static void delete_grp_stack(grp_stack** mystack);
+static grp_stack_item* grp_stack_append(
+ grp_stack_item* last, grp_stack_data data
+);
+static grp_stack_data grp_stack_remove(grp_stack_item* last);
+static grp_stack* new_grp_stack(void);
+static grp_stack_data pop_grp_stack(grp_stack* mystack);
+static void push_grp_stack(grp_stack* mystack, grp_stack_data data);
+static grp_stack_data shift_grp_stack(grp_stack* mystack);
+/* static void unshift_grp_stack(grp_stack* mystack, grp_stack_data data); */
+
+int fits_clean_url(char *inURL, /* I input URL string */
+ char *outURL, /* O output URL string */
+ int *status)
+/*
+ clean the URL by eliminating any ".." or "." specifiers in the inURL
+ string, and write the output to the outURL string.
+
+ Note that this function must have a valid Unix-style URL as input; platform
+ dependent path strings are not allowed.
+ */
+{
+ grp_stack* mystack; /* stack to hold pieces of URL */
+ char* tmp;
+
+ if(*status) return *status;
+
+ mystack = new_grp_stack();
+ *outURL = 0;
+
+ do {
+ /* handle URL scheme and domain if they exist */
+ tmp = strstr(inURL, "://");
+ if(tmp) {
+ /* there is a URL scheme, so look for the end of the domain too */
+ tmp = strchr(tmp + 3, '/');
+ if(tmp) {
+ /* tmp is now the end of the domain, so
+ * copy URL scheme and domain as is, and terminate by hand */
+ size_t string_size = (size_t) (tmp - inURL);
+ strncpy(outURL, inURL, string_size);
+ outURL[string_size] = 0;
+
+ /* now advance the input pointer to just after the domain and go on */
+ inURL = tmp;
+ } else {
+ /* '/' was not found, which means there are no path-like
+ * portions, so copy whole inURL to outURL and we're done */
+ strcpy(outURL, inURL);
+ continue; /* while(0) */
+ }
+ }
+
+ /* explicitly copy a leading / (absolute path) */
+ if('/' == *inURL) strcat(outURL, "/");
+
+ /* now clean the remainder of the inURL. push URL segments onto
+ * stack, dealing with .. and . as we go */
+ tmp = strtok(inURL, "/"); /* finds first / */
+ while(tmp) {
+ if(!strcmp(tmp, "..")) {
+ /* discard previous URL segment, if there was one. if not,
+ * add the .. to the stack if this is *not* an absolute path
+ * (for absolute paths, leading .. has no effect, so skip it) */
+ if(0 < mystack->stack_size) pop_grp_stack(mystack);
+ else if('/' != *inURL) push_grp_stack(mystack, tmp);
+ } else {
+ /* always just skip ., but otherwise add segment to stack */
+ if(strcmp(tmp, ".")) push_grp_stack(mystack, tmp);
+ }
+ tmp = strtok(NULL, "/"); /* get the next segment */
+ }
+
+ /* stack now has pieces of cleaned URL, so just catenate them
+ * onto output string until stack is empty */
+ while(0 < mystack->stack_size) {
+ tmp = shift_grp_stack(mystack);
+ strcat(outURL, tmp);
+ strcat(outURL, "/");
+ }
+ outURL[strlen(outURL) - 1] = 0; /* blank out trailing / */
+ } while(0);
+ delete_grp_stack(&mystack);
+ return *status;
+}
+
+/* free all stack contents using pop_grp_stack before freeing the
+ * grp_stack itself */
+static void delete_grp_stack(grp_stack** mystack) {
+ if(!mystack || !*mystack) return;
+ while((*mystack)->stack_size) pop_grp_stack(*mystack);
+ free(*mystack);
+ *mystack = NULL;
+}
+
+/* append an item to the stack, handling the special case of the first
+ * item appended */
+static grp_stack_item* grp_stack_append(
+ grp_stack_item* last, grp_stack_data data
+) {
+ /* first create a new stack item, and copy data to it */
+ grp_stack_item* new_item = (grp_stack_item*) malloc(sizeof(grp_stack_item));
+ new_item->data = data;
+ if(last) {
+ /* attach this item between the "last" item and its "next" item */
+ new_item->next = last->next;
+ new_item->prev = last;
+ last->next->prev = new_item;
+ last->next = new_item;
+ } else {
+ /* stack is empty, so "next" and "previous" both point back to it */
+ new_item->next = new_item;
+ new_item->prev = new_item;
+ }
+ return new_item;
+}
+
+/* remove an item from the stack, handling the special case of the last
+ * item removed */
+static grp_stack_data grp_stack_remove(grp_stack_item* last) {
+ grp_stack_data retval = last->data;
+ last->prev->next = last->next;
+ last->next->prev = last->prev;
+ free(last);
+ return retval;
+}
+
+/* create new stack dynamically, and give it valid initial values */
+static grp_stack* new_grp_stack(void) {
+ grp_stack* retval = (grp_stack*) malloc(sizeof(grp_stack));
+ if(retval) {
+ retval->stack_size = 0;
+ retval->top = NULL;
+ }
+ return retval;
+}
+
+/* return the value at the top of the stack and remove it, updating
+ * stack_size. top->prev becomes the new "top" */
+static grp_stack_data pop_grp_stack(grp_stack* mystack) {
+ grp_stack_data retval = grp_stack_default;
+ if(mystack && mystack->top) {
+ grp_stack_item* newtop = mystack->top->prev;
+ retval = grp_stack_remove(mystack->top);
+ mystack->top = newtop;
+ if(0 == --mystack->stack_size) mystack->top = NULL;
+ }
+ return retval;
+}
+
+/* add to the stack after the top element. the added element becomes
+ * the new "top" */
+static void push_grp_stack(grp_stack* mystack, grp_stack_data data) {
+ if(!mystack) return;
+ mystack->top = grp_stack_append(mystack->top, data);
+ ++mystack->stack_size;
+ return;
+}
+
+/* return the value at the bottom of the stack and remove it, updating
+ * stack_size. "top" pointer is unaffected */
+static grp_stack_data shift_grp_stack(grp_stack* mystack) {
+ grp_stack_data retval = grp_stack_default;
+ if(mystack && mystack->top) {
+ retval = grp_stack_remove(mystack->top->next); /* top->next == bottom */
+ if(0 == --mystack->stack_size) mystack->top = NULL;
+ }
+ return retval;
+}
+
+/* add to the stack after the top element. "top" is unaffected, except
+ * in the special case of an initially empty stack */
+/* static void unshift_grp_stack(grp_stack* mystack, grp_stack_data data) {
+ if(!mystack) return;
+ if(mystack->top) grp_stack_append(mystack->top, data);
+ else mystack->top = grp_stack_append(NULL, data);
+ ++mystack->stack_size;
+ return;
+ } */
+
+/*--------------------------------------------------------------------------*/
+int fits_url2relurl(char *refURL, /* I reference URL string */
+ char *absURL, /* I absoulute URL string to process */
+ char *relURL, /* O resulting relative URL string */
+ int *status)
+/*
+ create a relative URL to the file referenced by absURL with respect to the
+ reference URL refURL. The relative URL is returned in relURL.
+
+ Both refURL and absURL must be absolute URL strings; i.e. either begin
+ with an access method specification "XXX://" or with a '/' character
+ signifiying that they are absolute file paths.
+
+ Note that it is possible to make a relative URL from two input URLs
+ (absURL and refURL) that are not compatable. This function does not
+ check to see if the resulting relative URL makes any sence. For instance,
+ it is impossible to make a relative URL from the following two inputs:
+
+ absURL = ftp://a.b.c.com/x/y/z/foo.fits
+ refURL = /a/b/c/ttt.fits
+
+ The resulting relURL will be:
+
+ ../../../ftp://a.b.c.com/x/y/z/foo.fits
+
+ Which is syntically correct but meaningless. The problem is that a file
+ with an access method of ftp:// cannot be expressed a a relative URL to
+ a local disk file.
+*/
+
+{
+ int i,j;
+ int refcount,abscount;
+ int refsize,abssize;
+ int done;
+
+
+ if(*status != 0) return(*status);
+
+ /* initialize the relative URL string */
+ relURL[0] = 0;
+
+ do
+ {
+ /*
+ refURL and absURL must be absolute to process
+ */
+
+ if(!(fits_is_url_absolute(refURL) || *refURL == '/') ||
+ !(fits_is_url_absolute(absURL) || *absURL == '/'))
+ {
+ *status = URL_PARSE_ERROR;
+ ffpmsg("Cannot make rel. URL from non abs. URLs (fits_url2relurl)");
+ continue;
+ }
+
+ /* determine the size of the refURL and absURL strings */
+
+ refsize = strlen(refURL);
+ abssize = strlen(absURL);
+
+ /* process the two URL strings and build the relative URL between them */
+
+
+ for(done = 0, refcount = 0, abscount = 0;
+ !done && refcount < refsize && abscount < abssize;
+ ++refcount, ++abscount)
+ {
+ for(; abscount < abssize && absURL[abscount] == '/'; ++abscount);
+ for(; refcount < refsize && refURL[refcount] == '/'; ++refcount);
+
+ /* find the next path segment in absURL */
+ for(i = abscount; absURL[i] != '/' && i < abssize; ++i);
+
+ /* find the next path segment in refURL */
+ for(j = refcount; refURL[j] != '/' && j < refsize; ++j);
+
+ /* do the two path segments match? */
+ if(i == j &&
+ strncmp(absURL+abscount, refURL+refcount,i-refcount) == 0)
+ {
+ /* they match, so ignore them and continue */
+ abscount = i; refcount = j;
+ continue;
+ }
+
+ /* We found a difference in the paths in refURL and absURL.
+ For every path segment remaining in the refURL string, append
+ a "../" path segment to the relataive URL relURL.
+ */
+
+ for(j = refcount; j < refsize; ++j)
+ if(refURL[j] == '/') strcat(relURL,"../");
+
+ /* copy all remaining characters of absURL to the output relURL */
+
+ strcat(relURL,absURL+abscount);
+
+ /* we are done building the relative URL */
+ done = 1;
+ }
+
+ }while(0);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_relurl2url(char *refURL, /* I reference URL string */
+ char *relURL, /* I relative URL string to process */
+ char *absURL, /* O absolute URL string */
+ int *status)
+/*
+ create an absolute URL from a relative url and a reference URL. The
+ reference URL is given by the FITS file pointed to by fptr.
+
+ The construction of the absolute URL from the partial and reference URl
+ is performed using the rules set forth in:
+
+ http://www.w3.org/Addressing/URL/URL_TOC.html
+ and
+ http://www.w3.org/Addressing/URL/4_3_Partial.html
+
+ Note that the relative URL string relURL must conform to the Unix-like
+ URL syntax; host dependent partial URL strings are not allowed.
+*/
+{
+ int i;
+
+ char tmpStr[FLEN_FILENAME];
+
+ char *tmpStr1, *tmpStr2;
+
+
+ if(*status != 0) return(*status);
+
+ do
+ {
+
+ /*
+ make a copy of the reference URL string refURL for parsing purposes
+ */
+
+ strcpy(tmpStr,refURL);
+
+ /*
+ if the reference file has an access method of mem:// or shmem://
+ then we cannot use it as the basis of an absolute URL construction
+ for a partial URL
+ */
+
+ if(strncasecmp(tmpStr,"MEM:",4) == 0 ||
+ strncasecmp(tmpStr,"SHMEM:",6) == 0)
+ {
+ ffpmsg("ref URL has access mem:// or shmem:// (fits_relurl2url)");
+ ffpmsg(" cannot construct full URL from a partial URL and ");
+ ffpmsg(" MEM/SHMEM base URL");
+ *status = URL_PARSE_ERROR;
+ continue;
+ }
+
+ if(relURL[0] != '/')
+ {
+ /*
+ just append the relative URL string to the reference URL
+ string (minus the reference URL file name) to form the
+ absolute URL string
+ */
+
+ tmpStr1 = strrchr(tmpStr,'/');
+
+ if(tmpStr1 != NULL) tmpStr1[1] = 0;
+ else tmpStr[0] = 0;
+
+ strcat(tmpStr,relURL);
+ }
+ else
+ {
+ /*
+ have to parse the refURL string for the first occurnace of the
+ same number of '/' characters as contained in the beginning of
+ location that is not followed by a greater number of consective
+ '/' charaters (yes, that is a confusing statement); this is the
+ location in the refURL string where the relURL string is to
+ be appended to form the new absolute URL string
+ */
+
+ /*
+ first, build up a slash pattern string that has one more
+ slash in it than the starting slash pattern of the
+ relURL string
+ */
+
+ strcpy(absURL,"/");
+
+ for(i = 0; relURL[i] == '/'; ++i) strcat(absURL,"/");
+
+ /*
+ loop over the refURL string until the slash pattern stored
+ in absURL is no longer found
+ */
+
+ for(tmpStr1 = tmpStr, i = strlen(absURL);
+ (tmpStr2 = strstr(tmpStr1,absURL)) != NULL;
+ tmpStr1 = tmpStr2 + i);
+
+ /* reduce the slash pattern string by one slash */
+
+ absURL[i-1] = 0;
+
+ /*
+ search for the slash pattern in the remaining portion
+ of the refURL string
+ */
+
+ tmpStr2 = strstr(tmpStr1,absURL);
+
+ /* if no slash pattern match was found */
+
+ if(tmpStr2 == NULL)
+ {
+ /* just strip off the file name from the refURL */
+
+ tmpStr2 = strrchr(tmpStr1,'/');
+
+ if(tmpStr2 != NULL) tmpStr2[0] = 0;
+ else tmpStr[0] = 0;
+ }
+ else
+ {
+ /* set a string terminator at the slash pattern match */
+
+ *tmpStr2 = 0;
+ }
+
+ /*
+ conatenate the relURL string to the refURL string to form
+ the absURL
+ */
+
+ strcat(tmpStr,relURL);
+ }
+
+ /*
+ normalize the absURL by removing any ".." or "." specifiers
+ in the string
+ */
+
+ *status = fits_clean_url(tmpStr,absURL,status);
+
+ }while(0);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_encode_url(char *inpath, /* I URL to be encoded */
+ char *outpath, /* O output encoded URL */
+ int *status)
+ /*
+ encode all URL "unsafe" and "reserved" characters using the "%XX"
+ convention, where XX stand for the two hexidecimal digits of the
+ encode character's ASCII code.
+
+ Note that the output path is at least as large as, if not larger than
+ the input path, so that OUTPATH should be passed to this function
+ with room for growth. If not a runtime error could result. It is
+ assumed that OUTPATH has been allocated with enough room to hold
+ the resulting encoded URL.
+
+ This function was adopted from code in the libwww.a library available
+ via the W3 consortium <URL: http://www.w3.org>
+ */
+{
+ unsigned char a;
+
+ char *p;
+ char *q;
+ char *hex = "0123456789ABCDEF";
+
+unsigned const char isAcceptable[96] =
+{/* 0x0 0x1 0x2 0x3 0x4 0x5 0x6 0x7 0x8 0x9 0xA 0xB 0xC 0xD 0xE 0xF */
+
+ 0x0,0x0,0x0,0x0,0x0,0x0,0x0,0x0,0x0,0x0,0xF,0xE,0x0,0xF,0xF,0xC,
+ /* 2x !"#$%&'()*+,-./ */
+ 0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0x8,0x0,0x0,0x0,0x0,0x0,
+ /* 3x 0123456789:;<=>? */
+ 0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,
+ /* 4x @ABCDEFGHIJKLMNO */
+ 0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0x0,0x0,0x0,0x0,0xF,
+ /* 5X PQRSTUVWXYZ[\]^_ */
+ 0x0,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,
+ /* 6x `abcdefghijklmno */
+ 0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0xF,0x0,0x0,0x0,0x0,0x0
+ /* 7X pqrstuvwxyz{\}~DEL */
+};
+
+ if(*status != 0) return(*status);
+
+ /* loop over all characters in inpath until '\0' is encountered */
+
+ for(q = outpath, p = inpath; *p; p++)
+ {
+ a = (unsigned char)*p;
+
+ /* if the charcter requires encoding then process it */
+
+ if(!( a>=32 && a<128 && (isAcceptable[a-32])))
+ {
+ /* add a '%' character to the outpath */
+ *q++ = HEX_ESCAPE;
+ /* add the most significant ASCII code hex value */
+ *q++ = hex[a >> 4];
+ /* add the least significant ASCII code hex value */
+ *q++ = hex[a & 15];
+ }
+ /* else just copy the character as is */
+ else *q++ = *p;
+ }
+
+ /* null terminate the outpath string */
+
+ *q++ = 0;
+
+ return(*status);
+}
+
+/*---------------------------------------------------------------------------*/
+int fits_unencode_url(char *inpath, /* I input URL with encoding */
+ char *outpath, /* O unencoded URL */
+ int *status)
+ /*
+ unencode all URL "unsafe" and "reserved" characters to their actual
+ ASCII representation. All tokens of the form "%XX" where XX is the
+ hexidecimal code for an ASCII character, are searched for and
+ translated into the actuall ASCII character (so three chars become
+ 1 char).
+
+ It is assumed that OUTPATH has enough room to hold the unencoded
+ URL.
+
+ This function was adopted from code in the libwww.a library available
+ via the W3 consortium <URL: http://www.w3.org>
+ */
+
+{
+ char *p;
+ char *q;
+ char c;
+
+ if(*status != 0) return(*status);
+
+ p = inpath;
+ q = outpath;
+
+ /*
+ loop over all characters in the inpath looking for the '%' escape
+ character; if found the process the escape sequence
+ */
+
+ while(*p != 0)
+ {
+ /*
+ if the character is '%' then unencode the sequence, else
+ just copy the character from inpath to outpath
+ */
+
+ if (*p == HEX_ESCAPE)
+ {
+ if((c = *(++p)) != 0)
+ {
+ *q = (
+ (c >= '0' && c <= '9') ?
+ (c - '0') : ((c >= 'A' && c <= 'F') ?
+ (c - 'A' + 10) : (c - 'a' + 10))
+ )*16;
+
+ if((c = *(++p)) != 0)
+ {
+ *q = *q + (
+ (c >= '0' && c <= '9') ?
+ (c - '0') : ((c >= 'A' && c <= 'F') ?
+ (c - 'A' + 10) : (c - 'a' + 10))
+ );
+ p++, q++;
+ }
+ }
+ }
+ else
+ *q++ = *p++;
+ }
+
+ /* terminate the outpath */
+ *q = 0;
+
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+
+int fits_is_url_absolute(char *url)
+/*
+ Return a True (1) or False (0) value indicating whether or not the passed
+ URL string contains an access method specifier or not. Note that this is
+ a boolean function and it neither reads nor returns the standard error
+ status parameter
+*/
+{
+ char *tmpStr1, *tmpStr2;
+
+ char reserved[] = {':',';','/','?','@','&','=','+','$',','};
+
+ /*
+ The rule for determing if an URL is relative or absolute is that it (1)
+ must have a colon ":" and (2) that the colon must appear before any other
+ reserved URL character in the URL string. We first see if a colon exists,
+ get its position in the string, and then check to see if any of the other
+ reserved characters exists and if their position in the string is greater
+ than that of the colons.
+ */
+
+ if( (tmpStr1 = strchr(url,reserved[0])) != NULL &&
+ ((tmpStr2 = strchr(url,reserved[1])) == NULL || tmpStr2 > tmpStr1) &&
+ ((tmpStr2 = strchr(url,reserved[2])) == NULL || tmpStr2 > tmpStr1) &&
+ ((tmpStr2 = strchr(url,reserved[3])) == NULL || tmpStr2 > tmpStr1) &&
+ ((tmpStr2 = strchr(url,reserved[4])) == NULL || tmpStr2 > tmpStr1) &&
+ ((tmpStr2 = strchr(url,reserved[5])) == NULL || tmpStr2 > tmpStr1) &&
+ ((tmpStr2 = strchr(url,reserved[6])) == NULL || tmpStr2 > tmpStr1) &&
+ ((tmpStr2 = strchr(url,reserved[7])) == NULL || tmpStr2 > tmpStr1) &&
+ ((tmpStr2 = strchr(url,reserved[8])) == NULL || tmpStr2 > tmpStr1) &&
+ ((tmpStr2 = strchr(url,reserved[9])) == NULL || tmpStr2 > tmpStr1) )
+ {
+ return(1);
+ }
+ else
+ {
+ return(0);
+ }
+}
diff --git a/src/plugins/cfitsio/group.h b/src/plugins/cfitsio/group.h
new file mode 100644
index 0000000..f7aae5b
--- /dev/null
+++ b/src/plugins/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);
+
diff --git a/src/plugins/cfitsio/grparser.c b/src/plugins/cfitsio/grparser.c
new file mode 100644
index 0000000..a5091ea
--- /dev/null
+++ b/src/plugins/cfitsio/grparser.c
@@ -0,0 +1,1379 @@
+/* T E M P L A T E P A R S E R
+ =============================
+
+ 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: code cleanup, #include <string.h> included, now gcc -Wall prints no
+ warnings during compilation. Bugfix: now one can specify additional
+ columns in group HDU. Autoindexing also works in this situation
+ (colunms are number from 7 however).
+17-Oct-98: bugfix: complex keywords were incorrectly written (was TCOMPLEX should
+ be TDBLCOMPLEX).
+20-Oct-98: bugfix: parser was writing EXTNAME twice, when first HDU in template is
+ defined with XTENSION IMAGE then parser creates now dummy PHDU,
+ SIMPLE T is now allowed only at most once and in first HDU only.
+ WARNING: one should not define EXTNAME keyword for GROUP HDUs, as
+ they have them already defined by parser (EXTNAME = GROUPING).
+ Parser accepts EXTNAME oin GROUP HDU definition, but in this
+ case multiple EXTNAME keywords will present in HDU header.
+23-Oct-98: bugfix: unnecessary space was written to FITS file for blank
+ keywords.
+24-Oct-98: syntax change: empty lines and lines with only whitespaces are
+ written to FITS files as blank keywords (if inside group/hdu
+ definition). Previously lines had to have at least 8 spaces.
+ Please note, that due to pecularities of CFITSIO if the
+ last keyword(s) defined for given HDU are blank keywords
+ consisting of only 80 spaces, then (some of) those keywords
+ may be silently deleted by CFITSIO.
+13-Nov-98: bugfix: parser was writing GRPNAME twice. Parser still creates
+ GRPNAME keywords for GROUP HDU's which do not specify them.
+ However, values (of form DEFAULT_GROUP_XXX) are assigned
+ not necessarily in order HDUs appear in template file, but
+ rather in order parser completes their creation in FITS
+ file. Also, when including files, if fopen fails, parser
+ tries to open file with a name = directory_of_top_level
+ file + name of file to be included, as long as name
+ of file to be included does not specify absolute pathname.
+16-Nov-98: bugfix to bugfix from 13-Nov-98
+19-Nov-98: EXTVER keyword is now automatically assigned value by parser.
+17-Dev-98: 2 new things added: 1st: CFITSIO_INCLUDE_FILES environment
+ variable can contain a colon separated list of directories
+ to look for when looking for template include files (and master
+ template also). 2nd: it is now possible to append template
+ to nonempty FITS. file. fitsfile *ff no longer needs to point
+ to an empty FITS file with 0 HDUs in it. All data written by
+ parser will simple be appended at the end of file.
+22-Jan-99: changes to parser: when in append mode parser initially scans all
+ existing HDUs to built a list of already used EXTNAME/EXTVERs
+22-Jan-99: Bruce O'Neel, bugfix : TLONG should always reference long type
+ variable on OSF/Alpha and on 64-bit archs in general
+20-Jun-2002 Wm Pence, added support for the HIERARCH keyword convention in
+ which keyword names can effectively be longer than 8 characters.
+ Example:
+ HIERARCH LongKeywordName = 'value' / comment
+30-Jan-2003 Wm Pence, bugfix: ngp_read_xtension was testing for "ASCIITABLE"
+ instead of "TABLE" as the XTENSION value of an ASCII table,
+ and it did not allow for optional trailing spaces in the
+ "IMAGE" or "TABLE" string.
+16-Dec-2003 James Peachey: ngp_keyword_all_write was modified to apply
+ comments from the template file to the output file in
+ the case of reserved keywords (e.g. tform#, ttype# etcetera).
+*/
+
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef sparc
+#include <malloc.h>
+#include <memory.h>
+#endif
+
+#include <string.h>
+#include "fitsio2.h"
+#include "grparser.h"
+
+NGP_RAW_LINE ngp_curline = { NULL, NULL, NULL, NGP_TTYPE_UNKNOWN, NULL, NGP_FORMAT_OK, 0 };
+NGP_RAW_LINE ngp_prevline = { NULL, NULL, NULL, NGP_TTYPE_UNKNOWN, NULL, NGP_FORMAT_OK, 0 };
+
+int ngp_inclevel = 0; /* number of included files, 1 - means mean file */
+int ngp_grplevel = 0; /* group nesting level, 0 - means no grouping */
+
+FILE *ngp_fp[NGP_MAX_INCLUDE]; /* stack of included file handles */
+int ngp_keyidx = NGP_TOKEN_UNKNOWN; /* index of token in current line */
+NGP_TOKEN ngp_linkey; /* keyword after line analyze */
+
+char ngp_master_dir[NGP_MAX_FNAME]; /* directory of top level include file */
+
+NGP_TKDEF ngp_tkdef[] = /* tokens recognized by parser */
+ { { "\\INCLUDE", NGP_TOKEN_INCLUDE },
+ { "\\GROUP", NGP_TOKEN_GROUP },
+ { "\\END", NGP_TOKEN_END },
+ { "XTENSION", NGP_TOKEN_XTENSION },
+ { "SIMPLE", NGP_TOKEN_SIMPLE },
+ { NULL, NGP_TOKEN_UNKNOWN }
+ };
+
+int master_grp_idx = 1; /* current unnamed group in object */
+
+int ngp_extver_tab_size = 0;
+NGP_EXTVER_TAB *ngp_extver_tab = NULL;
+
+
+int ngp_get_extver(char *extname, int *version)
+ { NGP_EXTVER_TAB *p;
+ char *p2;
+ int i;
+
+ if ((NULL == extname) || (NULL == version)) return(NGP_BAD_ARG);
+ if ((NULL == ngp_extver_tab) && (ngp_extver_tab_size > 0)) return(NGP_BAD_ARG);
+ if ((NULL != ngp_extver_tab) && (ngp_extver_tab_size <= 0)) return(NGP_BAD_ARG);
+
+ for (i=0; i<ngp_extver_tab_size; i++)
+ { if (0 == strcmp(extname, ngp_extver_tab[i].extname))
+ { *version = (++ngp_extver_tab[i].version);
+ return(NGP_OK);
+ }
+ }
+
+ if (NULL == ngp_extver_tab)
+ { p = (NGP_EXTVER_TAB *)ngp_alloc(sizeof(NGP_EXTVER_TAB)); }
+ else
+ { p = (NGP_EXTVER_TAB *)ngp_realloc(ngp_extver_tab, (ngp_extver_tab_size + 1) * sizeof(NGP_EXTVER_TAB)); }
+
+ if (NULL == p) return(NGP_NO_MEMORY);
+
+ p2 = ngp_alloc(strlen(extname) + 1);
+ if (NULL == p2)
+ { ngp_free(p);
+ return(NGP_NO_MEMORY);
+ }
+
+ strcpy(p2, extname);
+ ngp_extver_tab = p;
+ ngp_extver_tab[ngp_extver_tab_size].extname = p2;
+ *version = ngp_extver_tab[ngp_extver_tab_size].version = 1;
+
+ ngp_extver_tab_size++;
+
+ return(NGP_OK);
+ }
+
+int ngp_set_extver(char *extname, int version)
+ { NGP_EXTVER_TAB *p;
+ char *p2;
+ int i;
+
+ if (NULL == extname) return(NGP_BAD_ARG);
+ if ((NULL == ngp_extver_tab) && (ngp_extver_tab_size > 0)) return(NGP_BAD_ARG);
+ if ((NULL != ngp_extver_tab) && (ngp_extver_tab_size <= 0)) return(NGP_BAD_ARG);
+
+ for (i=0; i<ngp_extver_tab_size; i++)
+ { if (0 == strcmp(extname, ngp_extver_tab[i].extname))
+ { if (version > ngp_extver_tab[i].version) ngp_extver_tab[i].version = version;
+ return(NGP_OK);
+ }
+ }
+
+ if (NULL == ngp_extver_tab)
+ { p = (NGP_EXTVER_TAB *)ngp_alloc(sizeof(NGP_EXTVER_TAB)); }
+ else
+ { p = (NGP_EXTVER_TAB *)ngp_realloc(ngp_extver_tab, (ngp_extver_tab_size + 1) * sizeof(NGP_EXTVER_TAB)); }
+
+ if (NULL == p) return(NGP_NO_MEMORY);
+
+ p2 = ngp_alloc(strlen(extname) + 1);
+ if (NULL == p2)
+ { ngp_free(p);
+ return(NGP_NO_MEMORY);
+ }
+
+ strcpy(p2, extname);
+ ngp_extver_tab = p;
+ ngp_extver_tab[ngp_extver_tab_size].extname = p2;
+ ngp_extver_tab[ngp_extver_tab_size].version = version;
+
+ ngp_extver_tab_size++;
+
+ return(NGP_OK);
+ }
+
+
+int ngp_delete_extver_tab(void)
+ { int i;
+
+ if ((NULL == ngp_extver_tab) && (ngp_extver_tab_size > 0)) return(NGP_BAD_ARG);
+ if ((NULL != ngp_extver_tab) && (ngp_extver_tab_size <= 0)) return(NGP_BAD_ARG);
+ if ((NULL == ngp_extver_tab) && (0 == ngp_extver_tab_size)) return(NGP_OK);
+
+ for (i=0; i<ngp_extver_tab_size; i++)
+ { if (NULL != ngp_extver_tab[i].extname)
+ { ngp_free(ngp_extver_tab[i].extname);
+ ngp_extver_tab[i].extname = NULL;
+ }
+ ngp_extver_tab[i].version = 0;
+ }
+ ngp_free(ngp_extver_tab);
+ ngp_extver_tab = NULL;
+ ngp_extver_tab_size = 0;
+ return(NGP_OK);
+ }
+
+ /* compare strings, case does not matter */
+
+int ngp_strcasecmp(char *p1, char *p2)
+ { char c1, c2;
+
+ for (;;)
+ {
+ c1 = *p1;
+ if ((c1 >= 'a') && (c1 <= 'z')) c1 += ('A' - 'a');
+
+ c2 = *p2;
+ if ((c2 >= 'a') && (c2 <= 'z')) c2 += ('A' - 'a');
+
+ if (c1 < c2) return(-1);
+ if (c1 > c2) return(1);
+ if (0 == c1) return(0);
+ p1++;
+ p2++;
+ }
+ }
+
+int ngp_strcasencmp(char *p1, char *p2, int n)
+ { char c1, c2;
+ int ii;
+
+ for (ii=0;ii<n;ii++)
+ {
+ c1 = *p1;
+ if ((c1 >= 'a') && (c1 <= 'z')) c1 += ('A' - 'a');
+
+ c2 = *p2;
+ if ((c2 >= 'a') && (c2 <= 'z')) c2 += ('A' - 'a');
+
+ if (c1 < c2) return(-1);
+ if (c1 > c2) return(1);
+ if (0 == c1) return(0);
+ p1++;
+ p2++;
+ }
+ return(0);
+ }
+
+ /* read one line from file */
+
+int ngp_line_from_file(FILE *fp, char **p)
+ { int c, r, llen, allocsize, alen;
+ char *p2;
+
+ if (NULL == fp) return(NGP_NUL_PTR); /* check for stupid args */
+ if (NULL == p) return(NGP_NUL_PTR); /* more foolproof checks */
+
+ r = NGP_OK; /* initialize stuff, reset err code */
+ llen = 0; /* 0 characters read so far */
+ *p = (char *)ngp_alloc(1); /* preallocate 1 byte */
+ allocsize = 1; /* signal that we have allocated 1 byte */
+ if (NULL == *p) return(NGP_NO_MEMORY); /* if this failed, system is in dire straits */
+
+ for (;;)
+ { c = getc(fp); /* get next character */
+ if ('\r' == c) continue; /* carriage return character ? Just ignore it */
+ if (EOF == c) /* EOF signalled ? */
+ {
+ if (ferror(fp)) r = NGP_READ_ERR; /* was it real error or simply EOF ? */
+ if (0 == llen) return(NGP_EOF); /* signal EOF only if 0 characters read so far */
+ break;
+ }
+ if ('\n' == c) break; /* end of line character ? */
+
+ llen++; /* we have new character, make room for it */
+ alen = ((llen + NGP_ALLOCCHUNK) / NGP_ALLOCCHUNK) * NGP_ALLOCCHUNK;
+ if (alen > allocsize)
+ { p2 = (char *)ngp_realloc(*p, alen); /* realloc buffer, if there is need */
+ if (NULL == p2)
+ { r = NGP_NO_MEMORY;
+ break;
+ }
+ *p = p2;
+ allocsize = alen;
+ }
+ (*p)[llen - 1] = c; /* copy character to buffer */
+ }
+
+ llen++; /* place for terminating \0 */
+ if (llen != allocsize)
+ { p2 = (char *)ngp_realloc(*p, llen);
+ if (NULL == p2) r = NGP_NO_MEMORY;
+ else
+ { *p = p2;
+ (*p)[llen - 1] = 0; /* copy \0 to buffer */
+ }
+ }
+ else
+ { (*p)[llen - 1] = 0; /* necessary when line read was empty */
+ }
+
+ if ((NGP_EOF != r) && (NGP_OK != r)) /* in case of errors free resources */
+ { ngp_free(*p);
+ *p = NULL;
+ }
+
+ return(r); /* return status code */
+ }
+
+ /* free current line structure */
+
+int ngp_free_line(void)
+ {
+ if (NULL != ngp_curline.line)
+ { ngp_free(ngp_curline.line);
+ ngp_curline.line = NULL;
+ ngp_curline.name = NULL;
+ ngp_curline.value = NULL;
+ ngp_curline.comment = NULL;
+ ngp_curline.type = NGP_TTYPE_UNKNOWN;
+ ngp_curline.format = NGP_FORMAT_OK;
+ ngp_curline.flags = 0;
+ }
+ return(NGP_OK);
+ }
+
+ /* free cached line structure */
+
+int ngp_free_prevline(void)
+ {
+ if (NULL != ngp_prevline.line)
+ { ngp_free(ngp_prevline.line);
+ ngp_prevline.line = NULL;
+ ngp_prevline.name = NULL;
+ ngp_prevline.value = NULL;
+ ngp_prevline.comment = NULL;
+ ngp_prevline.type = NGP_TTYPE_UNKNOWN;
+ ngp_prevline.format = NGP_FORMAT_OK;
+ ngp_prevline.flags = 0;
+ }
+ return(NGP_OK);
+ }
+
+ /* read one line */
+
+int ngp_read_line_buffered(FILE *fp)
+ {
+ ngp_free_line(); /* first free current line (if any) */
+
+ if (NULL != ngp_prevline.line) /* if cached, return cached line */
+ { ngp_curline = ngp_prevline;
+ ngp_prevline.line = NULL;
+ ngp_prevline.name = NULL;
+ ngp_prevline.value = NULL;
+ ngp_prevline.comment = NULL;
+ ngp_prevline.type = NGP_TTYPE_UNKNOWN;
+ ngp_prevline.format = NGP_FORMAT_OK;
+ ngp_prevline.flags = 0;
+ ngp_curline.flags = NGP_LINE_REREAD;
+ return(NGP_OK);
+ }
+
+ ngp_curline.flags = 0; /* if not cached really read line from file */
+ return(ngp_line_from_file(fp, &(ngp_curline.line)));
+ }
+
+ /* unread line */
+
+int ngp_unread_line(void)
+ {
+ if (NULL == ngp_curline.line) /* nothing to unread */
+ return(NGP_EMPTY_CURLINE);
+
+ if (NULL != ngp_prevline.line) /* we cannot unread line twice */
+ return(NGP_UNREAD_QUEUE_FULL);
+
+ ngp_prevline = ngp_curline;
+ ngp_curline.line = NULL;
+ return(NGP_OK);
+ }
+
+ /* a first guess line decomposition */
+
+int ngp_extract_tokens(NGP_RAW_LINE *cl)
+ { char *p, *s;
+ int cl_flags, i;
+
+ p = cl->line; /* start from beginning of line */
+ if (NULL == p) return(NGP_NUL_PTR);
+
+ cl->name = cl->value = cl->comment = NULL;
+ cl->type = NGP_TTYPE_UNKNOWN;
+ cl->format = NGP_FORMAT_OK;
+
+ cl_flags = 0;
+
+ for (i=0;; i++) /* if 8 spaces at beginning then line is comment */
+ { if ((0 == *p) || ('\n' == *p))
+ { /* if line has only blanks -> write blank keyword */
+ cl->line[0] = 0; /* create empty name (0 length string) */
+ cl->comment = cl->name = cl->line;
+ cl->type = NGP_TTYPE_RAW; /* signal write unformatted to FITS file */
+ return(NGP_OK);
+ }
+ if ((' ' != *p) && ('\t' != *p)) break;
+ if (i >= 7)
+ {
+ cl->comment = p + 1;
+ for (s = cl->comment;; s++) /* filter out any EOS characters in comment */
+ { if ('\n' == *s) *s = 0;
+ if (0 == *s) break;
+ }
+ cl->line[0] = 0; /* create empty name (0 length string) */
+ cl->name = cl->line;
+ cl->type = NGP_TTYPE_RAW;
+ return(NGP_OK);
+ }
+ p++;
+ }
+
+ cl->name = p;
+
+ for (;;) /* we need to find 1st whitespace */
+ { if ((0 == *p) || ('\n' == *p))
+ { *p = 0;
+ break;
+ }
+
+ /*
+ from Richard Mathar, 2002-05-03, add 10 lines:
+ if upper/lowercase HIERARCH followed also by an equal sign...
+ */
+ if( strncasecmp("HIERARCH",p,strlen("HIERARCH")) == 0 )
+ {
+ char * const eqsi=strchr(p,'=') ;
+ if( eqsi )
+ {
+ cl_flags |= NGP_FOUND_EQUAL_SIGN ;
+ p=eqsi ;
+ break ;
+ }
+ }
+
+ if ((' ' == *p) || ('\t' == *p)) break;
+ if ('=' == *p)
+ { cl_flags |= NGP_FOUND_EQUAL_SIGN;
+ break;
+ }
+
+ p++;
+ }
+
+ if (*p) *(p++) = 0; /* found end of keyname so terminate string with zero */
+
+ if ((!ngp_strcasecmp("HISTORY", cl->name))
+ || (!ngp_strcasecmp("COMMENT", cl->name))
+ || (!ngp_strcasecmp("CONTINUE", cl->name)))
+ { cl->comment = p;
+ for (s = cl->comment;; s++) /* filter out any EOS characters in comment */
+ { if ('\n' == *s) *s = 0;
+ if (0 == *s) break;
+ }
+ cl->type = NGP_TTYPE_RAW;
+ return(NGP_OK);
+ }
+
+ if (!ngp_strcasecmp("\\INCLUDE", cl->name))
+ {
+ for (;; p++) if ((' ' != *p) && ('\t' != *p)) break; /* skip whitespace */
+
+ cl->value = p;
+ for (s = cl->value;; s++) /* filter out any EOS characters */
+ { if ('\n' == *s) *s = 0;
+ if (0 == *s) break;
+ }
+ cl->type = NGP_TTYPE_UNKNOWN;
+ return(NGP_OK);
+ }
+
+ for (;; p++)
+ { if ((0 == *p) || ('\n' == *p)) return(NGP_OK); /* test if at end of string */
+ if ((' ' == *p) || ('\t' == *p)) continue; /* skip whitespace */
+ if (cl_flags & NGP_FOUND_EQUAL_SIGN) break;
+ if ('=' != *p) break; /* ignore initial equal sign */
+ cl_flags |= NGP_FOUND_EQUAL_SIGN;
+ }
+
+ if ('/' == *p) /* no value specified, comment only */
+ { p++;
+ if ((' ' == *p) || ('\t' == *p)) p++;
+ cl->comment = p;
+ for (s = cl->comment;; s++) /* filter out any EOS characters in comment */
+ { if ('\n' == *s) *s = 0;
+ if (0 == *s) break;
+ }
+ return(NGP_OK);
+ }
+
+ if ('\'' == *p) /* we have found string within quotes */
+ { cl->value = s = ++p; /* set pointer to beginning of that string */
+ cl->type = NGP_TTYPE_STRING; /* signal that it is of string type */
+
+ for (;;) /* analyze it */
+ { if ((0 == *p) || ('\n' == *p)) /* end of line -> end of string */
+ { *s = 0; return(NGP_OK); }
+
+ if ('\'' == *p) /* we have found doublequote */
+ { if ((0 == p[1]) || ('\n' == p[1]))/* doublequote is the last character in line */
+ { *s = 0; return(NGP_OK); }
+ if (('\t' == p[1]) || (' ' == p[1])) /* duoblequote was string terminator */
+ { *s = 0; p++; break; }
+ if ('\'' == p[1]) p++; /* doublequote is inside string, convert "" -> " */
+ }
+
+ *(s++) = *(p++); /* compact string in place, necess. by "" -> " conversion */
+ }
+ }
+ else /* regular token */
+ {
+ cl->value = p; /* set pointer to token */
+ cl->type = NGP_TTYPE_UNKNOWN; /* we dont know type at the moment */
+ for (;; p++) /* we need to find 1st whitespace */
+ { if ((0 == *p) || ('\n' == *p))
+ { *p = 0; return(NGP_OK); }
+ if ((' ' == *p) || ('\t' == *p)) break;
+ }
+ if (*p) *(p++) = 0; /* found so terminate string with zero */
+ }
+
+ for (;; p++)
+ { if ((0 == *p) || ('\n' == *p)) return(NGP_OK); /* test if at end of string */
+ if ((' ' != *p) && ('\t' != *p)) break; /* skip whitespace */
+ }
+
+ if ('/' == *p) /* no value specified, comment only */
+ { p++;
+ if ((' ' == *p) || ('\t' == *p)) p++;
+ cl->comment = p;
+ for (s = cl->comment;; s++) /* filter out any EOS characters in comment */
+ { if ('\n' == *s) *s = 0;
+ if (0 == *s) break;
+ }
+ return(NGP_OK);
+ }
+
+ cl->format = NGP_FORMAT_ERROR;
+ return(NGP_OK); /* too many tokens ... */
+ }
+
+/* try to open include file. If open fails and fname
+ does not specify absolute pathname, try to open fname
+ in any directory specified in CFITSIO_INCLUDE_FILES
+ environment variable. Finally try to open fname
+ relative to ngp_master_dir, which is directory of top
+ level include file
+*/
+
+int ngp_include_file(char *fname) /* try to open include file */
+ { char *p, *p2, *cp, *envar, envfiles[NGP_MAX_ENVFILES];
+
+ if (NULL == fname) return(NGP_NUL_PTR);
+
+ if (ngp_inclevel >= NGP_MAX_INCLUDE) /* too many include files */
+ return(NGP_INC_NESTING);
+
+ if (NULL == (ngp_fp[ngp_inclevel] = fopen(fname, "r")))
+ { /* if simple open failed .. */
+ envar = getenv("CFITSIO_INCLUDE_FILES"); /* scan env. variable, and retry to open */
+
+ if (NULL != envar) /* is env. variable defined ? */
+ { strncpy(envfiles, envar, NGP_MAX_ENVFILES - 1);
+ envfiles[NGP_MAX_ENVFILES - 1] = 0; /* copy search path to local variable, env. is fragile */
+
+ for (p2 = strtok(envfiles, ":"); NULL != p2; p2 = strtok(NULL, ":"))
+ {
+ cp = (char *)ngp_alloc(strlen(fname) + strlen(p2) + 2);
+ if (NULL == cp) return(NGP_NO_MEMORY);
+
+ strcpy(cp, p2);
+#ifdef MSDOS
+ strcat(cp, "\\"); /* abs. pathname for MSDOS */
+
+#else
+ strcat(cp, "/"); /* and for unix */
+#endif
+ strcat(cp, fname);
+
+ ngp_fp[ngp_inclevel] = fopen(cp, "r");
+ ngp_free(cp);
+
+ if (NULL != ngp_fp[ngp_inclevel]) break;
+ }
+ }
+
+ if (NULL == ngp_fp[ngp_inclevel]) /* finally try to open relative to top level */
+ {
+#ifdef MSDOS
+ if ('\\' == fname[0]) return(NGP_ERR_FOPEN); /* abs. pathname for MSDOS, does not support C:\\PATH */
+#else
+ if ('/' == fname[0]) return(NGP_ERR_FOPEN); /* and for unix */
+#endif
+ if (0 == ngp_master_dir[0]) return(NGP_ERR_FOPEN);
+
+ p = ngp_alloc(strlen(fname) + strlen(ngp_master_dir) + 1);
+ if (NULL == p) return(NGP_NO_MEMORY);
+
+ strcpy(p, ngp_master_dir); /* construct composite pathname */
+ strcat(p, fname); /* comp = master + fname */
+
+ ngp_fp[ngp_inclevel] = fopen(p, "r");/* try to open composite */
+ ngp_free(p); /* we don't need buffer anymore */
+
+ if (NULL == ngp_fp[ngp_inclevel])
+ return(NGP_ERR_FOPEN); /* fail if error */
+ }
+ }
+
+ ngp_inclevel++;
+ return(NGP_OK);
+ }
+
+
+/* read line in the intelligent way. All \INCLUDE directives are handled,
+ empty and comment line skipped. If this function returns NGP_OK, than
+ decomposed line (name, type, value in proper type and comment) are
+ stored in ngp_linkey structure. ignore_blank_lines parameter is zero
+ when parser is inside GROUP or HDU definition. Nonzero otherwise.
+*/
+
+int ngp_read_line(int ignore_blank_lines)
+ { int r, nc, savec;
+ unsigned k;
+
+ if (ngp_inclevel <= 0) /* do some sanity checking first */
+ { ngp_keyidx = NGP_TOKEN_EOF; /* no parents, so report error */
+ return(NGP_OK);
+ }
+ if (ngp_inclevel > NGP_MAX_INCLUDE) return(NGP_INC_NESTING);
+ if (NULL == ngp_fp[ngp_inclevel - 1]) return(NGP_NUL_PTR);
+
+ for (;;)
+ { switch (r = ngp_read_line_buffered(ngp_fp[ngp_inclevel - 1]))
+ { case NGP_EOF:
+ ngp_inclevel--; /* end of file, revert to parent */
+ if (ngp_fp[ngp_inclevel]) /* we can close old file */
+ fclose(ngp_fp[ngp_inclevel]);
+
+ ngp_fp[ngp_inclevel] = NULL;
+ if (ngp_inclevel <= 0)
+ { ngp_keyidx = NGP_TOKEN_EOF; /* no parents, so report error */
+ return(NGP_OK);
+ }
+ continue;
+
+ case NGP_OK:
+ if (ngp_curline.flags & NGP_LINE_REREAD) return(r);
+ break;
+ default:
+ return(r);
+ }
+
+ switch (ngp_curline.line[0])
+ { case 0: if (0 == ignore_blank_lines) break; /* ignore empty lines if told so */
+ case '#': continue; /* ignore comment lines */
+ }
+
+ r = ngp_extract_tokens(&ngp_curline); /* analyse line, extract tokens and comment */
+ if (NGP_OK != r) return(r);
+
+ if (NULL == ngp_curline.name) continue; /* skip lines consisting only of whitespaces */
+
+ for (k = 0; k < strlen(ngp_curline.name); k++)
+ { if ((ngp_curline.name[k] >= 'a') && (ngp_curline.name[k] <= 'z'))
+ ngp_curline.name[k] += 'A' - 'a'; /* force keyword to be upper case */
+ if (k == 7) break; /* only first 8 chars are required to be upper case */
+ }
+
+ for (k=0;; k++) /* find index of keyword in keyword table */
+ { if (NGP_TOKEN_UNKNOWN == ngp_tkdef[k].code) break;
+ if (0 == strcmp(ngp_curline.name, ngp_tkdef[k].name)) break;
+ }
+
+ ngp_keyidx = ngp_tkdef[k].code; /* save this index, grammar parser will need this */
+
+ if (NGP_TOKEN_INCLUDE == ngp_keyidx) /* if this is \INCLUDE keyword, try to include file */
+ { if (NGP_OK != (r = ngp_include_file(ngp_curline.value))) return(r);
+ continue; /* and read next line */
+ }
+
+ ngp_linkey.type = NGP_TTYPE_UNKNOWN; /* now, get the keyword type, it's a long story ... */
+
+ if (NULL != ngp_curline.value) /* if no value given signal it */
+ { if (NGP_TTYPE_STRING == ngp_curline.type) /* string type test */
+ { ngp_linkey.type = NGP_TTYPE_STRING;
+ ngp_linkey.value.s = ngp_curline.value;
+ }
+ if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* bool type test */
+ { if ((!ngp_strcasecmp("T", ngp_curline.value)) || (!ngp_strcasecmp("F", ngp_curline.value)))
+ { ngp_linkey.type = NGP_TTYPE_BOOL;
+ ngp_linkey.value.b = (ngp_strcasecmp("T", ngp_curline.value) ? 0 : 1);
+ }
+ }
+ if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* complex type test */
+ { if (2 == sscanf(ngp_curline.value, "(%lg,%lg)%n", &(ngp_linkey.value.c.re), &(ngp_linkey.value.c.im), &nc))
+ { if ((' ' == ngp_curline.value[nc]) || ('\t' == ngp_curline.value[nc])
+ || ('\n' == ngp_curline.value[nc]) || (0 == ngp_curline.value[nc]))
+ { ngp_linkey.type = NGP_TTYPE_COMPLEX;
+ }
+ }
+ }
+ if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* real type test */
+ { if (strchr(ngp_curline.value, '.') && (1 == sscanf(ngp_curline.value, "%lg%n", &(ngp_linkey.value.d), &nc)))
+ {
+ if ('D' == ngp_curline.value[nc]) {
+ /* test if template used a 'D' rather than an 'E' as the exponent character (added by WDP in 12/2010) */
+ savec = nc;
+ ngp_curline.value[nc] = 'E';
+ sscanf(ngp_curline.value, "%lg%n", &(ngp_linkey.value.d), &nc);
+ if ((' ' == ngp_curline.value[nc]) || ('\t' == ngp_curline.value[nc])
+ || ('\n' == ngp_curline.value[nc]) || (0 == ngp_curline.value[nc])) {
+ ngp_linkey.type = NGP_TTYPE_REAL;
+ } else { /* no, this is not a real value */
+ ngp_curline.value[savec] = 'D'; /* restore the original D character */
+ }
+ } else {
+ if ((' ' == ngp_curline.value[nc]) || ('\t' == ngp_curline.value[nc])
+ || ('\n' == ngp_curline.value[nc]) || (0 == ngp_curline.value[nc]))
+ { ngp_linkey.type = NGP_TTYPE_REAL;
+ }
+ }
+ }
+ }
+ if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* integer type test */
+ { if (1 == sscanf(ngp_curline.value, "%d%n", &(ngp_linkey.value.i), &nc))
+ { if ((' ' == ngp_curline.value[nc]) || ('\t' == ngp_curline.value[nc])
+ || ('\n' == ngp_curline.value[nc]) || (0 == ngp_curline.value[nc]))
+ { ngp_linkey.type = NGP_TTYPE_INT;
+ }
+ }
+ }
+ if (NGP_TTYPE_UNKNOWN == ngp_linkey.type) /* force string type */
+ { ngp_linkey.type = NGP_TTYPE_STRING;
+ ngp_linkey.value.s = ngp_curline.value;
+ }
+ }
+ else
+ { if (NGP_TTYPE_RAW == ngp_curline.type) ngp_linkey.type = NGP_TTYPE_RAW;
+ else ngp_linkey.type = NGP_TTYPE_NULL;
+ }
+
+ if (NULL != ngp_curline.comment)
+ { strncpy(ngp_linkey.comment, ngp_curline.comment, NGP_MAX_COMMENT); /* store comment */
+ ngp_linkey.comment[NGP_MAX_COMMENT - 1] = 0;
+ }
+ else
+ { ngp_linkey.comment[0] = 0;
+ }
+
+ strncpy(ngp_linkey.name, ngp_curline.name, NGP_MAX_NAME); /* and keyword's name */
+ ngp_linkey.name[NGP_MAX_NAME - 1] = 0;
+
+ if (strlen(ngp_linkey.name) > FLEN_KEYWORD) /* WDP: 20-Jun-2002: mod to support HIERARCH */
+ {
+ return(NGP_BAD_ARG); /* cfitsio does not allow names > 8 chars */
+ }
+
+ return(NGP_OK); /* we have valid non empty line, so return success */
+ }
+ }
+
+ /* check whether keyword can be written as is */
+
+int ngp_keyword_is_write(NGP_TOKEN *ngp_tok)
+ { int i, j, l, spc;
+ /* indexed variables not to write */
+
+ static char *nm[] = { "NAXIS", "TFORM", "TTYPE", NULL } ;
+
+ /* non indexed variables not allowed to write */
+
+ static char *nmni[] = { "SIMPLE", "XTENSION", "BITPIX", "NAXIS", "PCOUNT",
+ "GCOUNT", "TFIELDS", "THEAP", "EXTEND", "EXTVER",
+ NULL } ;
+
+ if (NULL == ngp_tok) return(NGP_NUL_PTR);
+
+ for (j = 0; ; j++) /* first check non indexed */
+ { if (NULL == nmni[j]) break;
+ if (0 == strcmp(nmni[j], ngp_tok->name)) return(NGP_BAD_ARG);
+ }
+
+ for (j = 0; ; j++) /* now check indexed */
+ { if (NULL == nm[j]) return(NGP_OK);
+ l = strlen(nm[j]);
+ if ((l < 1) || (l > 5)) continue;
+ if (0 == strncmp(nm[j], ngp_tok->name, l)) break;
+ }
+
+ if ((ngp_tok->name[l] < '1') || (ngp_tok->name[l] > '9')) return(NGP_OK);
+ spc = 0;
+ for (i = l + 1; i < 8; i++)
+ { if (spc) { if (' ' != ngp_tok->name[i]) return(NGP_OK); }
+ else
+ { if ((ngp_tok->name[i] >= '0') || (ngp_tok->name[i] <= '9')) continue;
+ if (' ' == ngp_tok->name[i]) { spc = 1; continue; }
+ if (0 == ngp_tok->name[i]) break;
+ return(NGP_OK);
+ }
+ }
+ return(NGP_BAD_ARG);
+ }
+
+ /* write (almost) all keywords from given HDU to disk */
+
+int ngp_keyword_all_write(NGP_HDU *ngph, fitsfile *ffp, int mode)
+ { int i, r, ib;
+ char buf[200];
+ long l;
+
+
+ if (NULL == ngph) return(NGP_NUL_PTR);
+ if (NULL == ffp) return(NGP_NUL_PTR);
+ r = NGP_OK;
+
+ for (i=0; i<ngph->tokcnt; i++)
+ { r = ngp_keyword_is_write(&(ngph->tok[i]));
+ if ((NGP_REALLY_ALL & mode) || (NGP_OK == r))
+ { switch (ngph->tok[i].type)
+ { case NGP_TTYPE_BOOL:
+ ib = ngph->tok[i].value.b;
+ fits_write_key(ffp, TLOGICAL, ngph->tok[i].name, &ib, ngph->tok[i].comment, &r);
+ break;
+ case NGP_TTYPE_STRING:
+ fits_write_key_longstr(ffp, ngph->tok[i].name, ngph->tok[i].value.s, ngph->tok[i].comment, &r);
+ break;
+ case NGP_TTYPE_INT:
+ l = ngph->tok[i].value.i; /* bugfix - 22-Jan-99, BO - nonalignment of OSF/Alpha */
+ fits_write_key(ffp, TLONG, ngph->tok[i].name, &l, ngph->tok[i].comment, &r);
+ break;
+ case NGP_TTYPE_REAL:
+ fits_write_key(ffp, TDOUBLE, ngph->tok[i].name, &(ngph->tok[i].value.d), ngph->tok[i].comment, &r);
+ break;
+ case NGP_TTYPE_COMPLEX:
+ fits_write_key(ffp, TDBLCOMPLEX, ngph->tok[i].name, &(ngph->tok[i].value.c), ngph->tok[i].comment, &r);
+ break;
+ case NGP_TTYPE_NULL:
+ fits_write_key_null(ffp, ngph->tok[i].name, ngph->tok[i].comment, &r);
+ break;
+ case NGP_TTYPE_RAW:
+ if (0 == strcmp("HISTORY", ngph->tok[i].name))
+ { fits_write_history(ffp, ngph->tok[i].comment, &r);
+ break;
+ }
+ if (0 == strcmp("COMMENT", ngph->tok[i].name))
+ { fits_write_comment(ffp, ngph->tok[i].comment, &r);
+ break;
+ }
+ sprintf(buf, "%-8.8s%s", ngph->tok[i].name, ngph->tok[i].comment);
+ fits_write_record(ffp, buf, &r);
+ break;
+ }
+ }
+ else if (NGP_BAD_ARG == r) /* enhancement 10 dec 2003, James Peachey: template comments replace defaults */
+ { r = NGP_OK; /* update comments of special keywords like TFORM */
+ if (ngph->tok[i].comment && *ngph->tok[i].comment) /* do not update with a blank comment */
+ { fits_modify_comment(ffp, ngph->tok[i].name, ngph->tok[i].comment, &r);
+ }
+ }
+ else /* other problem, typically a blank token */
+ { r = NGP_OK; /* skip this token, but continue */
+ }
+ if (r) return(r);
+ }
+
+ fits_set_hdustruc(ffp, &r); /* resync cfitsio */
+ return(r);
+ }
+
+ /* init HDU structure */
+
+int ngp_hdu_init(NGP_HDU *ngph)
+ { if (NULL == ngph) return(NGP_NUL_PTR);
+ ngph->tok = NULL;
+ ngph->tokcnt = 0;
+ return(NGP_OK);
+ }
+
+ /* clear HDU structure */
+
+int ngp_hdu_clear(NGP_HDU *ngph)
+ { int i;
+
+ if (NULL == ngph) return(NGP_NUL_PTR);
+
+ for (i=0; i<ngph->tokcnt; i++)
+ { if (NGP_TTYPE_STRING == ngph->tok[i].type)
+ if (NULL != ngph->tok[i].value.s)
+ { ngp_free(ngph->tok[i].value.s);
+ ngph->tok[i].value.s = NULL;
+ }
+ }
+
+ if (NULL != ngph->tok) ngp_free(ngph->tok);
+
+ ngph->tok = NULL;
+ ngph->tokcnt = 0;
+
+ return(NGP_OK);
+ }
+
+ /* insert new token to HDU structure */
+
+int ngp_hdu_insert_token(NGP_HDU *ngph, NGP_TOKEN *newtok)
+ { NGP_TOKEN *tkp;
+
+ if (NULL == ngph) return(NGP_NUL_PTR);
+ if (NULL == newtok) return(NGP_NUL_PTR);
+
+ if (0 == ngph->tokcnt)
+ tkp = (NGP_TOKEN *)ngp_alloc((ngph->tokcnt + 1) * sizeof(NGP_TOKEN));
+ else
+ tkp = (NGP_TOKEN *)ngp_realloc(ngph->tok, (ngph->tokcnt + 1) * sizeof(NGP_TOKEN));
+
+ if (NULL == tkp) return(NGP_NO_MEMORY);
+
+ ngph->tok = tkp;
+ ngph->tok[ngph->tokcnt] = *newtok;
+
+ if (NGP_TTYPE_STRING == newtok->type)
+ { if (NULL != newtok->value.s)
+ { ngph->tok[ngph->tokcnt].value.s = (char *)ngp_alloc(1 + strlen(newtok->value.s));
+ if (NULL == ngph->tok[ngph->tokcnt].value.s) return(NGP_NO_MEMORY);
+ strcpy(ngph->tok[ngph->tokcnt].value.s, newtok->value.s);
+ }
+ }
+
+ ngph->tokcnt++;
+ return(NGP_OK);
+ }
+
+
+int ngp_append_columns(fitsfile *ff, NGP_HDU *ngph, int aftercol)
+ { int r, i, j, exitflg, ngph_i;
+ char *my_tform, *my_ttype;
+ char ngph_ctmp;
+
+
+ if (NULL == ff) return(NGP_NUL_PTR);
+ if (NULL == ngph) return(NGP_NUL_PTR);
+ if (0 == ngph->tokcnt) return(NGP_OK); /* nothing to do ! */
+
+ r = NGP_OK;
+ exitflg = 0;
+
+ for (j=aftercol; j<NGP_MAX_ARRAY_DIM; j++) /* 0 for table, 6 for group */
+ {
+ my_tform = NULL;
+ my_ttype = "";
+
+ for (i=0; ; i++)
+ { if (1 == sscanf(ngph->tok[i].name, "TFORM%d%c", &ngph_i, &ngph_ctmp))
+ { if ((NGP_TTYPE_STRING == ngph->tok[i].type) && (ngph_i == (j + 1)))
+ { my_tform = ngph->tok[i].value.s;
+ }
+ }
+ else if (1 == sscanf(ngph->tok[i].name, "TTYPE%d%c", &ngph_i, &ngph_ctmp))
+ { if ((NGP_TTYPE_STRING == ngph->tok[i].type) && (ngph_i == (j + 1)))
+ { my_ttype = ngph->tok[i].value.s;
+ }
+ }
+
+ if ((NULL != my_tform) && (my_ttype[0])) break;
+
+ if (i < (ngph->tokcnt - 1)) continue;
+ exitflg = 1;
+ break;
+ }
+ if ((NGP_OK == r) && (NULL != my_tform))
+ fits_insert_col(ff, j + 1, my_ttype, my_tform, &r);
+
+ if ((NGP_OK != r) || exitflg) break;
+ }
+ return(r);
+ }
+
+ /* read complete HDU */
+
+int ngp_read_xtension(fitsfile *ff, int parent_hn, int simple_mode)
+ { int r, exflg, l, my_hn, tmp0, incrementor_index, i, j;
+ int ngph_dim, ngph_bitpix, ngph_node_type, my_version;
+ char incrementor_name[NGP_MAX_STRING], ngph_ctmp;
+ char *ngph_extname = 0;
+ long ngph_size[NGP_MAX_ARRAY_DIM];
+ NGP_HDU ngph;
+ long lv;
+
+ incrementor_name[0] = 0; /* signal no keyword+'#' found yet */
+ incrementor_index = 0;
+
+ if (NGP_OK != (r = ngp_hdu_init(&ngph))) return(r);
+
+ if (NGP_OK != (r = ngp_read_line(0))) return(r); /* EOF always means error here */
+ switch (NGP_XTENSION_SIMPLE & simple_mode)
+ {
+ case 0: if (NGP_TOKEN_XTENSION != ngp_keyidx) return(NGP_TOKEN_NOT_EXPECT);
+ break;
+ default: if (NGP_TOKEN_SIMPLE != ngp_keyidx) return(NGP_TOKEN_NOT_EXPECT);
+ break;
+ }
+
+ if (NGP_OK != (r = ngp_hdu_insert_token(&ngph, &ngp_linkey))) return(r);
+
+ for (;;)
+ { if (NGP_OK != (r = ngp_read_line(0))) return(r); /* EOF always means error here */
+ exflg = 0;
+ switch (ngp_keyidx)
+ {
+ case NGP_TOKEN_SIMPLE:
+ r = NGP_TOKEN_NOT_EXPECT;
+ break;
+
+ case NGP_TOKEN_END:
+ case NGP_TOKEN_XTENSION:
+ case NGP_TOKEN_GROUP:
+ r = ngp_unread_line(); /* WARNING - not break here .... */
+ case NGP_TOKEN_EOF:
+ exflg = 1;
+ break;
+
+ default: l = strlen(ngp_linkey.name);
+ if ((l >= 2) && (l <= 6))
+ { if ('#' == ngp_linkey.name[l - 1])
+ { if (0 == incrementor_name[0])
+ { memcpy(incrementor_name, ngp_linkey.name, l - 1);
+ incrementor_name[l - 1] = 0;
+ }
+ if (((l - 1) == (int)strlen(incrementor_name)) && (0 == memcmp(incrementor_name, ngp_linkey.name, l - 1)))
+ { incrementor_index++;
+ }
+ sprintf(ngp_linkey.name + l - 1, "%d", incrementor_index);
+ }
+ }
+ r = ngp_hdu_insert_token(&ngph, &ngp_linkey);
+ break;
+ }
+ if ((NGP_OK != r) || exflg) break;
+ }
+
+ if (NGP_OK == r)
+ { /* we should scan keywords, and calculate HDU's */
+ /* structure ourselves .... */
+
+ ngph_node_type = NGP_NODE_INVALID; /* init variables */
+ ngph_bitpix = 0;
+ ngph_extname = NULL;
+ for (i=0; i<NGP_MAX_ARRAY_DIM; i++) ngph_size[i] = 0;
+ ngph_dim = 0;
+
+ for (i=0; i<ngph.tokcnt; i++)
+ { if (!strcmp("XTENSION", ngph.tok[i].name))
+ { if (NGP_TTYPE_STRING == ngph.tok[i].type)
+ { if (!ngp_strcasencmp("BINTABLE", ngph.tok[i].value.s,8)) ngph_node_type = NGP_NODE_BTABLE;
+ if (!ngp_strcasencmp("TABLE", ngph.tok[i].value.s,5)) ngph_node_type = NGP_NODE_ATABLE;
+ if (!ngp_strcasencmp("IMAGE", ngph.tok[i].value.s,5)) ngph_node_type = NGP_NODE_IMAGE;
+ }
+ }
+ else if (!strcmp("SIMPLE", ngph.tok[i].name))
+ { if (NGP_TTYPE_BOOL == ngph.tok[i].type)
+ { if (ngph.tok[i].value.b) ngph_node_type = NGP_NODE_IMAGE;
+ }
+ }
+ else if (!strcmp("BITPIX", ngph.tok[i].name))
+ { if (NGP_TTYPE_INT == ngph.tok[i].type) ngph_bitpix = ngph.tok[i].value.i;
+ }
+ else if (!strcmp("NAXIS", ngph.tok[i].name))
+ { if (NGP_TTYPE_INT == ngph.tok[i].type) ngph_dim = ngph.tok[i].value.i;
+ }
+ else if (!strcmp("EXTNAME", ngph.tok[i].name)) /* assign EXTNAME, I hope struct does not move */
+ { if (NGP_TTYPE_STRING == ngph.tok[i].type) ngph_extname = ngph.tok[i].value.s;
+ }
+ else if (1 == sscanf(ngph.tok[i].name, "NAXIS%d%c", &j, &ngph_ctmp))
+ { if (NGP_TTYPE_INT == ngph.tok[i].type)
+ if ((j>=1) && (j <= NGP_MAX_ARRAY_DIM))
+ { ngph_size[j - 1] = ngph.tok[i].value.i;
+ }
+ }
+ }
+
+ switch (ngph_node_type)
+ { case NGP_NODE_IMAGE:
+ if (NGP_XTENSION_FIRST == ((NGP_XTENSION_FIRST | NGP_XTENSION_SIMPLE) & simple_mode))
+ { /* if caller signals that this is 1st HDU in file */
+ /* and it is IMAGE defined with XTENSION, then we */
+ /* need create dummy Primary HDU */
+ fits_create_img(ff, 16, 0, NULL, &r);
+ }
+ /* create image */
+ fits_create_img(ff, ngph_bitpix, ngph_dim, ngph_size, &r);
+
+ /* update keywords */
+ if (NGP_OK == r) r = ngp_keyword_all_write(&ngph, ff, NGP_NON_SYSTEM_ONLY);
+ break;
+
+ case NGP_NODE_ATABLE:
+ case NGP_NODE_BTABLE:
+ /* create table, 0 rows and 0 columns for the moment */
+ fits_create_tbl(ff, ((NGP_NODE_ATABLE == ngph_node_type)
+ ? ASCII_TBL : BINARY_TBL),
+ 0, 0, NULL, NULL, NULL, NULL, &r);
+ if (NGP_OK != r) break;
+
+ /* add columns ... */
+ r = ngp_append_columns(ff, &ngph, 0);
+ if (NGP_OK != r) break;
+
+ /* add remaining keywords */
+ r = ngp_keyword_all_write(&ngph, ff, NGP_NON_SYSTEM_ONLY);
+ if (NGP_OK != r) break;
+
+ /* if requested add rows */
+ if (ngph_size[1] > 0) fits_insert_rows(ff, 0, ngph_size[1], &r);
+ break;
+
+ default: r = NGP_BAD_ARG;
+ break;
+ }
+
+ }
+
+ if ((NGP_OK == r) && (NULL != ngph_extname))
+ { r = ngp_get_extver(ngph_extname, &my_version); /* write correct ext version number */
+ lv = my_version; /* bugfix - 22-Jan-99, BO - nonalignment of OSF/Alpha */
+ fits_write_key(ff, TLONG, "EXTVER", &lv, "auto assigned by template parser", &r);
+ }
+
+ if (NGP_OK == r)
+ { if (parent_hn > 0)
+ { fits_get_hdu_num(ff, &my_hn);
+ fits_movabs_hdu(ff, parent_hn, &tmp0, &r); /* link us to parent */
+ fits_add_group_member(ff, NULL, my_hn, &r);
+ fits_movabs_hdu(ff, my_hn, &tmp0, &r);
+ if (NGP_OK != r) return(r);
+ }
+ }
+
+ if (NGP_OK != r) /* in case of error - delete hdu */
+ { tmp0 = 0;
+ fits_delete_hdu(ff, NULL, &tmp0);
+ }
+
+ ngp_hdu_clear(&ngph);
+ return(r);
+ }
+
+ /* read complete GROUP */
+
+int ngp_read_group(fitsfile *ff, char *grpname, int parent_hn)
+ { int r, exitflg, l, my_hn, tmp0, incrementor_index;
+ char grnm[NGP_MAX_STRING]; /* keyword holding group name */
+ char incrementor_name[NGP_MAX_STRING];
+ NGP_HDU ngph;
+
+ incrementor_name[0] = 0; /* signal no keyword+'#' found yet */
+ incrementor_index = 6; /* first 6 cols are used by group */
+
+ ngp_grplevel++;
+ if (NGP_OK != (r = ngp_hdu_init(&ngph))) return(r);
+
+ r = NGP_OK;
+ if (NGP_OK != (r = fits_create_group(ff, grpname, GT_ID_ALL_URI, &r))) return(r);
+ fits_get_hdu_num(ff, &my_hn);
+ if (parent_hn > 0)
+ { fits_movabs_hdu(ff, parent_hn, &tmp0, &r); /* link us to parent */
+ fits_add_group_member(ff, NULL, my_hn, &r);
+ fits_movabs_hdu(ff, my_hn, &tmp0, &r);
+ if (NGP_OK != r) return(r);
+ }
+
+ for (exitflg = 0; 0 == exitflg;)
+ { if (NGP_OK != (r = ngp_read_line(0))) break; /* EOF always means error here */
+ switch (ngp_keyidx)
+ {
+ case NGP_TOKEN_SIMPLE:
+ case NGP_TOKEN_EOF:
+ r = NGP_TOKEN_NOT_EXPECT;
+ break;
+
+ case NGP_TOKEN_END:
+ ngp_grplevel--;
+ exitflg = 1;
+ break;
+
+ case NGP_TOKEN_GROUP:
+ if (NGP_TTYPE_STRING == ngp_linkey.type)
+ { strncpy(grnm, ngp_linkey.value.s, NGP_MAX_STRING);
+ }
+ else
+ { sprintf(grnm, "DEFAULT_GROUP_%d", master_grp_idx++);
+ }
+ grnm[NGP_MAX_STRING - 1] = 0;
+ r = ngp_read_group(ff, grnm, my_hn);
+ break; /* we can have many subsequent GROUP defs */
+
+ case NGP_TOKEN_XTENSION:
+ r = ngp_unread_line();
+ if (NGP_OK != r) break;
+ r = ngp_read_xtension(ff, my_hn, 0);
+ break; /* we can have many subsequent HDU defs */
+
+ default: l = strlen(ngp_linkey.name);
+ if ((l >= 2) && (l <= 6))
+ { if ('#' == ngp_linkey.name[l - 1])
+ { if (0 == incrementor_name[0])
+ { memcpy(incrementor_name, ngp_linkey.name, l - 1);
+ incrementor_name[l - 1] = 0;
+ }
+ if (((l - 1) == (int)strlen(incrementor_name)) && (0 == memcmp(incrementor_name, ngp_linkey.name, l - 1)))
+ { incrementor_index++;
+ }
+ sprintf(ngp_linkey.name + l - 1, "%d", incrementor_index);
+ }
+ }
+ r = ngp_hdu_insert_token(&ngph, &ngp_linkey);
+ break; /* here we can add keyword */
+ }
+ if (NGP_OK != r) break;
+ }
+
+ fits_movabs_hdu(ff, my_hn, &tmp0, &r); /* back to our HDU */
+
+ if (NGP_OK == r) /* create additional columns, if requested */
+ r = ngp_append_columns(ff, &ngph, 6);
+
+ if (NGP_OK == r) /* and write keywords */
+ r = ngp_keyword_all_write(&ngph, ff, NGP_NON_SYSTEM_ONLY);
+
+ if (NGP_OK != r) /* delete group in case of error */
+ { tmp0 = 0;
+ fits_remove_group(ff, OPT_RM_GPT, &tmp0);
+ }
+
+ ngp_hdu_clear(&ngph); /* we are done with this HDU, so delete it */
+ return(r);
+ }
+
+ /* top level API functions */
+
+/* read whole template. ff should point to the opened empty fits file. */
+
+int fits_execute_template(fitsfile *ff, char *ngp_template, int *status)
+ { int r, exit_flg, first_extension, i, my_hn, tmp0, keys_exist, more_keys, used_ver;
+ char grnm[NGP_MAX_STRING], used_name[NGP_MAX_STRING];
+ long luv;
+
+ if (NULL == status) return(NGP_NUL_PTR);
+ if (NGP_OK != *status) return(*status);
+
+ if ((NULL == ff) || (NULL == ngp_template))
+ { *status = NGP_NUL_PTR;
+ return(*status);
+ }
+
+ ngp_inclevel = 0; /* initialize things, not all should be zero */
+ ngp_grplevel = 0;
+ master_grp_idx = 1;
+ exit_flg = 0;
+ ngp_master_dir[0] = 0; /* this should be before 1st call to ngp_include_file */
+ first_extension = 1; /* we need to create PHDU */
+
+ if (NGP_OK != (r = ngp_delete_extver_tab()))
+ { *status = r;
+ return(r);
+ }
+
+ fits_get_hdu_num(ff, &my_hn); /* our HDU position */
+ if (my_hn <= 1) /* check whether we really need to create PHDU */
+ { fits_movabs_hdu(ff, 1, &tmp0, status);
+ fits_get_hdrspace(ff, &keys_exist, &more_keys, status);
+ fits_movabs_hdu(ff, my_hn, &tmp0, status);
+ if (NGP_OK != *status) return(*status); /* error here means file is corrupted */
+ if (keys_exist > 0) first_extension = 0; /* if keywords exist assume PHDU already exist */
+ }
+ else
+ { first_extension = 0; /* PHDU (followed by 1+ extensions) exist */
+
+ for (i = 2; i<= my_hn; i++)
+ { *status = NGP_OK;
+ fits_movabs_hdu(ff, 1, &tmp0, status);
+ if (NGP_OK != *status) break;
+
+ fits_read_key(ff, TSTRING, "EXTNAME", used_name, NULL, status);
+ if (NGP_OK != *status) continue;
+
+ fits_read_key(ff, TLONG, "EXTVER", &luv, NULL, status);
+ used_ver = luv; /* bugfix - 22-Jan-99, BO - nonalignment of OSF/Alpha */
+ if (VALUE_UNDEFINED == *status)
+ { used_ver = 1;
+ *status = NGP_OK;
+ }
+
+ if (NGP_OK == *status) *status = ngp_set_extver(used_name, used_ver);
+ }
+
+ fits_movabs_hdu(ff, my_hn, &tmp0, status);
+ }
+ if (NGP_OK != *status) return(*status);
+
+ if (NGP_OK != (*status = ngp_include_file(ngp_template))) return(*status);
+
+ for (i = strlen(ngp_template) - 1; i >= 0; i--) /* strlen is > 0, otherwise fopen failed */
+ {
+#ifdef MSDOS
+ if ('\\' == ngp_template[i]) break;
+#else
+ if ('/' == ngp_template[i]) break;
+#endif
+ }
+
+ i++;
+ if (i > (NGP_MAX_FNAME - 1)) i = NGP_MAX_FNAME - 1;
+
+ if (i > 0)
+ { memcpy(ngp_master_dir, ngp_template, i);
+ ngp_master_dir[i] = 0;
+ }
+
+
+ for (;;)
+ { if (NGP_OK != (r = ngp_read_line(1))) break; /* EOF always means error here */
+ switch (ngp_keyidx)
+ {
+ case NGP_TOKEN_SIMPLE:
+ if (0 == first_extension) /* simple only allowed in first HDU */
+ { r = NGP_TOKEN_NOT_EXPECT;
+ break;
+ }
+ if (NGP_OK != (r = ngp_unread_line())) break;
+ r = ngp_read_xtension(ff, 0, NGP_XTENSION_SIMPLE | NGP_XTENSION_FIRST);
+ first_extension = 0;
+ break;
+
+ case NGP_TOKEN_XTENSION:
+ if (NGP_OK != (r = ngp_unread_line())) break;
+ r = ngp_read_xtension(ff, 0, (first_extension ? NGP_XTENSION_FIRST : 0));
+ first_extension = 0;
+ break;
+
+ case NGP_TOKEN_GROUP:
+ if (NGP_TTYPE_STRING == ngp_linkey.type)
+ { strncpy(grnm, ngp_linkey.value.s, NGP_MAX_STRING); }
+ else
+ { sprintf(grnm, "DEFAULT_GROUP_%d", master_grp_idx++); }
+ grnm[NGP_MAX_STRING - 1] = 0;
+ r = ngp_read_group(ff, grnm, 0);
+ first_extension = 0;
+ break;
+
+ case NGP_TOKEN_EOF:
+ exit_flg = 1;
+ break;
+
+ default: r = NGP_TOKEN_NOT_EXPECT;
+ break;
+ }
+ if (exit_flg || (NGP_OK != r)) break;
+ }
+
+/* all top level HDUs up to faulty one are left intact in case of i/o error. It is up
+ to the caller to call fits_close_file or fits_delete_file when this function returns
+ error. */
+
+ ngp_free_line(); /* deallocate last line (if any) */
+ ngp_free_prevline(); /* deallocate cached line (if any) */
+ ngp_delete_extver_tab(); /* delete extver table (if present), error ignored */
+
+ *status = r;
+ return(r);
+ }
diff --git a/src/plugins/cfitsio/grparser.h b/src/plugins/cfitsio/grparser.h
new file mode 100644
index 0000000..56bdea0
--- /dev/null
+++ b/src/plugins/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
diff --git a/src/plugins/cfitsio/histo.c b/src/plugins/cfitsio/histo.c
new file mode 100644
index 0000000..6af856f
--- /dev/null
+++ b/src/plugins/cfitsio/histo.c
@@ -0,0 +1,2221 @@
+/* Globally defined histogram parameters */
+#include <string.h>
+#include <ctype.h>
+#include <math.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+typedef struct { /* Structure holding all the histogramming information */
+ union { /* the iterator work functions (ffwritehist, ffcalchist) */
+ char *b; /* need to do their job... passed via *userPointer. */
+ short *i;
+ int *j;
+ float *r;
+ double *d;
+ } hist;
+
+ fitsfile *tblptr;
+
+ int haxis, hcolnum[4], himagetype;
+ long haxis1, haxis2, haxis3, haxis4;
+ float amin1, amin2, amin3, amin4;
+ float maxbin1, maxbin2, maxbin3, maxbin4;
+ float binsize1, binsize2, binsize3, binsize4;
+ int wtrecip, wtcolnum;
+ float weight;
+ char *rowselector;
+
+} histType;
+
+/*--------------------------------------------------------------------------*/
+int ffbins(char *binspec, /* I - binning specification */
+ int *imagetype, /* O - image type, TINT or TSHORT */
+ int *histaxis, /* O - no. of axes in the histogram */
+ char colname[4][FLEN_VALUE], /* column name for axis */
+ double *minin, /* minimum value for each axis */
+ double *maxin, /* maximum value for each axis */
+ double *binsizein, /* size of bins on each axis */
+ char minname[4][FLEN_VALUE], /* keyword name for min */
+ char maxname[4][FLEN_VALUE], /* keyword name for max */
+ char binname[4][FLEN_VALUE], /* keyword name for binsize */
+ double *wt, /* weighting factor */
+ char *wtname, /* keyword or column name for weight */
+ int *recip, /* the reciprocal of the weight? */
+ int *status)
+{
+/*
+ Parse the input binning specification string, returning the binning
+ parameters. Supports up to 4 dimensions. The binspec string has
+ one of these forms:
+
+ bin binsize - 2D histogram with binsize on each axis
+ bin xcol - 1D histogram on column xcol
+ bin (xcol, ycol) = binsize - 2D histogram with binsize on each axis
+ bin x=min:max:size, y=min:max:size, z..., t...
+ bin x=:max, y=::size
+ bin x=size, y=min::size
+
+ most other reasonable combinations are supported.
+*/
+ int ii, slen, defaulttype;
+ char *ptr, tmpname[30], *file_expr = NULL;
+ double dummy;
+
+ if (*status > 0)
+ return(*status);
+
+ /* set the default values */
+ *histaxis = 2;
+ *imagetype = TINT;
+ defaulttype = 1;
+ *wt = 1.;
+ *recip = 0;
+ *wtname = '\0';
+
+ /* set default values */
+ for (ii = 0; ii < 4; ii++)
+ {
+ *colname[ii] = '\0';
+ *minname[ii] = '\0';
+ *maxname[ii] = '\0';
+ *binname[ii] = '\0';
+ minin[ii] = DOUBLENULLVALUE; /* undefined values */
+ maxin[ii] = DOUBLENULLVALUE;
+ binsizein[ii] = DOUBLENULLVALUE;
+ }
+
+ ptr = binspec + 3; /* skip over 'bin' */
+
+ if (*ptr == 'i' ) /* bini */
+ {
+ *imagetype = TSHORT;
+ defaulttype = 0;
+ ptr++;
+ }
+ else if (*ptr == 'j' ) /* binj; same as default */
+ {
+ defaulttype = 0;
+ ptr ++;
+ }
+ else if (*ptr == 'r' ) /* binr */
+ {
+ *imagetype = TFLOAT;
+ defaulttype = 0;
+ ptr ++;
+ }
+ else if (*ptr == 'd' ) /* bind */
+ {
+ *imagetype = TDOUBLE;
+ defaulttype = 0;
+ ptr ++;
+ }
+ else if (*ptr == 'b' ) /* binb */
+ {
+ *imagetype = TBYTE;
+ defaulttype = 0;
+ ptr ++;
+ }
+
+ if (*ptr == '\0') /* use all defaults for other parameters */
+ return(*status);
+ else if (*ptr != ' ') /* must be at least one blank */
+ {
+ ffpmsg("binning specification syntax error:");
+ ffpmsg(binspec);
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+
+ if (*ptr == '\0') /* no other parameters; use defaults */
+ return(*status);
+
+ /* Check if need to import expression from a file */
+
+ if( *ptr=='@' ) {
+ if( ffimport_file( ptr+1, &file_expr, status ) ) return(*status);
+ ptr = file_expr;
+ while (*ptr == ' ')
+ ptr++; /* skip leading white space... again */
+ }
+
+ if (*ptr == '(' )
+ {
+ /* this must be the opening parenthesis around a list of column */
+ /* names, optionally followed by a '=' and the binning spec. */
+
+ for (ii = 0; ii < 4; ii++)
+ {
+ ptr++; /* skip over the '(', ',', or ' ') */
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+
+ slen = strcspn(ptr, " ,)");
+ strncat(colname[ii], ptr, slen); /* copy 1st column name */
+
+ ptr += slen;
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+
+ if (*ptr == ')' ) /* end of the list of names */
+ {
+ *histaxis = ii + 1;
+ break;
+ }
+ }
+
+ if (ii == 4) /* too many names in the list , or missing ')' */
+ {
+ ffpmsg(
+ "binning specification has too many column names or is missing closing ')':");
+ ffpmsg(binspec);
+ if( file_expr ) free( file_expr );
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ ptr++; /* skip over the closing parenthesis */
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+
+ if (*ptr == '\0') {
+ if( file_expr ) free( file_expr );
+ return(*status); /* parsed the entire string */
+ }
+
+ else if (*ptr != '=') /* must be an equals sign now*/
+ {
+ ffpmsg("illegal binning specification in URL:");
+ ffpmsg(" an equals sign '=' must follow the column names");
+ ffpmsg(binspec);
+ if( file_expr ) free( file_expr );
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ ptr++; /* skip over the equals sign */
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+
+ /* get the single range specification for all the columns */
+ ffbinr(&ptr, tmpname, minin,
+ maxin, binsizein, minname[0],
+ maxname[0], binname[0], status);
+ if (*status > 0)
+ {
+ ffpmsg("illegal binning specification in URL:");
+ ffpmsg(binspec);
+ if( file_expr ) free( file_expr );
+ return(*status);
+ }
+
+ for (ii = 1; ii < *histaxis; ii++)
+ {
+ minin[ii] = minin[0];
+ maxin[ii] = maxin[0];
+ binsizein[ii] = binsizein[0];
+ strcpy(minname[ii], minname[0]);
+ strcpy(maxname[ii], maxname[0]);
+ strcpy(binname[ii], binname[0]);
+ }
+
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+
+ if (*ptr == ';')
+ goto getweight; /* a weighting factor is specified */
+
+ if (*ptr != '\0') /* must have reached end of string */
+ {
+ ffpmsg("illegal syntax after binning range specification in URL:");
+ ffpmsg(binspec);
+ if( file_expr ) free( file_expr );
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ return(*status);
+ } /* end of case with list of column names in ( ) */
+
+ /* if we've reached this point, then the binning specification */
+ /* must be of the form: XCOL = min:max:binsize, YCOL = ... */
+ /* where the column name followed by '=' are optional. */
+ /* If the column name is not specified, then use the default name */
+
+ for (ii = 0; ii < 4; ii++) /* allow up to 4 histogram dimensions */
+ {
+ ffbinr(&ptr, colname[ii], &minin[ii],
+ &maxin[ii], &binsizein[ii], minname[ii],
+ maxname[ii], binname[ii], status);
+
+ if (*status > 0)
+ {
+ ffpmsg("illegal syntax in binning range specification in URL:");
+ ffpmsg(binspec);
+ if( file_expr ) free( file_expr );
+ return(*status);
+ }
+
+ if (*ptr == '\0' || *ptr == ';')
+ break; /* reached the end of the string */
+
+ if (*ptr == ' ')
+ {
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+
+ if (*ptr == '\0' || *ptr == ';')
+ break; /* reached the end of the string */
+
+ if (*ptr == ',')
+ ptr++; /* comma separates the next column specification */
+ }
+ else if (*ptr == ',')
+ {
+ ptr++; /* comma separates the next column specification */
+ }
+ else
+ {
+ ffpmsg("illegal characters following binning specification in URL:");
+ ffpmsg(binspec);
+ if( file_expr ) free( file_expr );
+ return(*status = URL_PARSE_ERROR);
+ }
+ }
+
+ if (ii == 4)
+ {
+ /* there are yet more characters in the string */
+ ffpmsg("illegal binning specification in URL:");
+ ffpmsg("apparently greater than 4 histogram dimensions");
+ ffpmsg(binspec);
+ return(*status = URL_PARSE_ERROR);
+ }
+ else
+ *histaxis = ii + 1;
+
+ /* special case: if a single number was entered it should be */
+ /* interpreted as the binning factor for the default X and Y axes */
+
+ if (*histaxis == 1 && *colname[0] == '\0' &&
+ minin[0] == DOUBLENULLVALUE && maxin[0] == DOUBLENULLVALUE)
+ {
+ *histaxis = 2;
+ binsizein[1] = binsizein[0];
+ }
+
+getweight:
+ if (*ptr == ';') /* looks like a weighting factor is given */
+ {
+ ptr++;
+
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+
+ recip = 0;
+ if (*ptr == '/')
+ {
+ *recip = 1; /* the reciprocal of the weight is entered */
+ ptr++;
+
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+ }
+
+ /* parse the weight as though it were a binrange. */
+ /* either a column name or a numerical value will be returned */
+
+ ffbinr(&ptr, wtname, &dummy, &dummy, wt, tmpname,
+ tmpname, tmpname, status);
+
+ if (*status > 0)
+ {
+ ffpmsg("illegal binning weight specification in URL:");
+ ffpmsg(binspec);
+ if( file_expr ) free( file_expr );
+ return(*status);
+ }
+
+ /* creat a float datatype histogram by default, if weight */
+ /* factor is not = 1.0 */
+
+ if ( (defaulttype && *wt != 1.0) || (defaulttype && *wtname) )
+ *imagetype = TFLOAT;
+ }
+
+ while (*ptr == ' ') /* skip over blanks */
+ ptr++;
+
+ if (*ptr != '\0') /* should have reached the end of string */
+ {
+ ffpmsg("illegal syntax after binning weight specification in URL:");
+ ffpmsg(binspec);
+ *status = URL_PARSE_ERROR;
+ }
+
+ if( file_expr ) free( file_expr );
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffbinr(char **ptr,
+ char *colname,
+ double *minin,
+ double *maxin,
+ double *binsizein,
+ char *minname,
+ char *maxname,
+ char *binname,
+ int *status)
+/*
+ Parse the input binning range specification string, returning
+ the column name, histogram min and max values, and bin size.
+*/
+{
+ int slen, isanumber;
+ char token[FLEN_VALUE];
+
+ if (*status > 0)
+ return(*status);
+
+ slen = fits_get_token(ptr, " ,=:;", token, &isanumber); /* get 1st token */
+
+ if (slen == 0 && (**ptr == '\0' || **ptr == ',' || **ptr == ';') )
+ return(*status); /* a null range string */
+
+ if (!isanumber && **ptr != ':')
+ {
+ /* this looks like the column name */
+
+ if (token[0] == '#' && isdigit((int) token[1]) )
+ {
+ /* omit the leading '#' in the column number */
+ strcpy(colname, token+1);
+ }
+ else
+ strcpy(colname, token);
+
+ while (**ptr == ' ') /* skip over blanks */
+ (*ptr)++;
+
+ if (**ptr != '=')
+ return(*status); /* reached the end */
+
+ (*ptr)++; /* skip over the = sign */
+
+ while (**ptr == ' ') /* skip over blanks */
+ (*ptr)++;
+
+ slen = fits_get_token(ptr, " ,:;", token, &isanumber); /* get token */
+ }
+
+ if (**ptr != ':')
+ {
+ /* this is the first token, and since it is not followed by */
+ /* a ':' this must be the binsize token */
+ if (!isanumber)
+ strcpy(binname, token);
+ else
+ *binsizein = strtod(token, NULL);
+
+ return(*status); /* reached the end */
+ }
+ else
+ {
+ /* the token contains the min value */
+ if (slen)
+ {
+ if (!isanumber)
+ strcpy(minname, token);
+ else
+ *minin = strtod(token, NULL);
+ }
+ }
+
+ (*ptr)++; /* skip the colon between the min and max values */
+ slen = fits_get_token(ptr, " ,:;", token, &isanumber); /* get token */
+
+ /* the token contains the max value */
+ if (slen)
+ {
+ if (!isanumber)
+ strcpy(maxname, token);
+ else
+ *maxin = strtod(token, NULL);
+ }
+
+ if (**ptr != ':')
+ return(*status); /* reached the end; no binsize token */
+
+ (*ptr)++; /* skip the colon between the max and binsize values */
+ slen = fits_get_token(ptr, " ,:;", token, &isanumber); /* get token */
+
+ /* the token contains the binsize value */
+ if (slen)
+ {
+ if (!isanumber)
+ strcpy(binname, token);
+ else
+ *binsizein = strtod(token, NULL);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffhist2(fitsfile **fptr, /* IO - pointer to table with X and Y cols; */
+ /* on output, points to histogram image */
+ char *outfile, /* I - name for the output histogram file */
+ int imagetype, /* I - datatype for image: TINT, TSHORT, etc */
+ int naxis, /* I - number of axes in the histogram image */
+ char colname[4][FLEN_VALUE], /* I - column names */
+ double *minin, /* I - minimum histogram value, for each axis */
+ double *maxin, /* I - maximum histogram value, for each axis */
+ double *binsizein, /* I - bin size along each axis */
+ char minname[4][FLEN_VALUE], /* I - optional keywords for min */
+ char maxname[4][FLEN_VALUE], /* I - optional keywords for max */
+ char binname[4][FLEN_VALUE], /* I - optional keywords for binsize */
+ double weightin, /* I - binning weighting factor */
+ char wtcol[FLEN_VALUE], /* I - optional keyword or col for weight*/
+ int recip, /* I - use reciprocal of the weight? */
+ char *selectrow, /* I - optional array (length = no. of */
+ /* rows in the table). If the element is true */
+ /* then the corresponding row of the table will*/
+ /* be included in the histogram, otherwise the */
+ /* row will be skipped. Ingnored if *selectrow*/
+ /* is equal to NULL. */
+ int *status)
+{
+ fitsfile *histptr;
+ int bitpix, colnum[4], wtcolnum;
+ long haxes[4];
+ float amin[4], amax[4], binsize[4], weight;
+
+ if (*status > 0)
+ return(*status);
+
+ if (naxis > 4)
+ {
+ ffpmsg("histogram has more than 4 dimensions");
+ return(*status = BAD_DIMEN);
+ }
+
+ /* reset position to the correct HDU if necessary */
+ if ((*fptr)->HDUposition != ((*fptr)->Fptr)->curhdu)
+ ffmahd(*fptr, ((*fptr)->HDUposition) + 1, NULL, status);
+
+ if (imagetype == TBYTE)
+ bitpix = BYTE_IMG;
+ else if (imagetype == TSHORT)
+ bitpix = SHORT_IMG;
+ else if (imagetype == TINT)
+ bitpix = LONG_IMG;
+ else if (imagetype == TFLOAT)
+ bitpix = FLOAT_IMG;
+ else if (imagetype == TDOUBLE)
+ bitpix = DOUBLE_IMG;
+ else
+ return(*status = BAD_DATATYPE);
+
+
+ /* Calculate the binning parameters: */
+ /* columm numbers, axes length, min values, max values, and binsizes. */
+
+ if (fits_calc_binning(
+ *fptr, naxis, colname, minin, maxin, binsizein, minname, maxname, binname,
+ colnum, haxes, amin, amax, binsize, status) > 0)
+ {
+ ffpmsg("failed to determine binning parameters");
+ return(*status);
+ }
+
+ /* get the histogramming weighting factor, if any */
+ if (*wtcol)
+ {
+ /* first, look for a keyword with the weight value */
+ if (ffgky(*fptr, TFLOAT, wtcol, &weight, NULL, status) )
+ {
+ /* not a keyword, so look for column with this name */
+ *status = 0;
+
+ /* get the column number in the table */
+ if (ffgcno(*fptr, CASEINSEN, wtcol, &wtcolnum, status) > 0)
+ {
+ ffpmsg(
+ "keyword or column for histogram weights doesn't exist: ");
+ ffpmsg(wtcol);
+ return(*status);
+ }
+
+ weight = FLOATNULLVALUE;
+ }
+ }
+ else
+ weight = (float) weightin;
+
+ if (weight <= 0. && weight != FLOATNULLVALUE)
+ {
+ ffpmsg("Illegal histogramming weighting factor <= 0.");
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ if (recip && weight != FLOATNULLVALUE)
+ /* take reciprocal of weight */
+ weight = (float) (1.0 / weight);
+
+ /* size of histogram is now known, so create temp output file */
+ if (fits_create_file(&histptr, outfile, status) > 0)
+ {
+ ffpmsg("failed to create temp output file for histogram");
+ return(*status);
+ }
+
+ /* create output FITS image HDU */
+ if (ffcrim(histptr, bitpix, naxis, haxes, status) > 0)
+ {
+ ffpmsg("failed to create output histogram FITS image");
+ return(*status);
+ }
+
+ /* copy header keywords, converting pixel list WCS keywords to image WCS form */
+ if (fits_copy_pixlist2image(*fptr, histptr, 9, naxis, colnum, status) > 0)
+ {
+ ffpmsg("failed to copy pixel list keywords to new histogram header");
+ return(*status);
+ }
+
+ /* if the table columns have no WCS keywords, then write default keywords */
+ fits_write_keys_histo(*fptr, histptr, naxis, colnum, status);
+
+ /* update the WCS keywords for the ref. pixel location, and pixel size */
+ fits_rebin_wcs(histptr, naxis, amin, binsize, status);
+
+ /* now compute the output image by binning the column values */
+ if (fits_make_hist(*fptr, histptr, bitpix, naxis, haxes, colnum, amin, amax,
+ binsize, weight, wtcolnum, recip, selectrow, status) > 0)
+ {
+ ffpmsg("failed to calculate new histogram values");
+ return(*status);
+ }
+
+ /* finally, close the original file and return ptr to the new image */
+ ffclos(*fptr, status);
+ *fptr = histptr;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffhist(fitsfile **fptr, /* IO - pointer to table with X and Y cols; */
+ /* on output, points to histogram image */
+ char *outfile, /* I - name for the output histogram file */
+ int imagetype, /* I - datatype for image: TINT, TSHORT, etc */
+ int naxis, /* I - number of axes in the histogram image */
+ char colname[4][FLEN_VALUE], /* I - column names */
+ double *minin, /* I - minimum histogram value, for each axis */
+ double *maxin, /* I - maximum histogram value, for each axis */
+ double *binsizein, /* I - bin size along each axis */
+ char minname[4][FLEN_VALUE], /* I - optional keywords for min */
+ char maxname[4][FLEN_VALUE], /* I - optional keywords for max */
+ char binname[4][FLEN_VALUE], /* I - optional keywords for binsize */
+ double weightin, /* I - binning weighting factor */
+ char wtcol[FLEN_VALUE], /* I - optional keyword or col for weight*/
+ int recip, /* I - use reciprocal of the weight? */
+ char *selectrow, /* I - optional array (length = no. of */
+ /* rows in the table). If the element is true */
+ /* then the corresponding row of the table will*/
+ /* be included in the histogram, otherwise the */
+ /* row will be skipped. Ingnored if *selectrow*/
+ /* is equal to NULL. */
+ int *status)
+{
+ int ii, datatype, repeat, imin, imax, ibin, bitpix, tstatus, use_datamax = 0;
+ long haxes[4];
+ fitsfile *histptr;
+ char errmsg[FLEN_ERRMSG], keyname[FLEN_KEYWORD], card[FLEN_CARD];
+ tcolumn *colptr;
+ iteratorCol imagepars[1];
+ int n_cols = 1, nkeys;
+ long offset = 0;
+ long n_per_loop = -1; /* force whole array to be passed at one time */
+ histType histData; /* Structure holding histogram info for iterator */
+
+ float amin[4], amax[4], binsize[4], maxbin[4];
+ float datamin = FLOATNULLVALUE, datamax = FLOATNULLVALUE;
+ char svalue[FLEN_VALUE];
+ double dvalue;
+ char cpref[4][FLEN_VALUE];
+ char *cptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (naxis > 4)
+ {
+ ffpmsg("histogram has more than 4 dimensions");
+ return(*status = BAD_DIMEN);
+ }
+
+ /* reset position to the correct HDU if necessary */
+ if ((*fptr)->HDUposition != ((*fptr)->Fptr)->curhdu)
+ ffmahd(*fptr, ((*fptr)->HDUposition) + 1, NULL, status);
+
+ histData.tblptr = *fptr;
+ histData.himagetype = imagetype;
+ histData.haxis = naxis;
+ histData.rowselector = selectrow;
+
+ if (imagetype == TBYTE)
+ bitpix = BYTE_IMG;
+ else if (imagetype == TSHORT)
+ bitpix = SHORT_IMG;
+ else if (imagetype == TINT)
+ bitpix = LONG_IMG;
+ else if (imagetype == TFLOAT)
+ bitpix = FLOAT_IMG;
+ else if (imagetype == TDOUBLE)
+ bitpix = DOUBLE_IMG;
+ else
+ return(*status = BAD_DATATYPE);
+
+ /* The CPREF keyword, if it exists, gives the preferred columns. */
+ /* Otherwise, assume "X", "Y", "Z", and "T" */
+
+ tstatus = 0;
+ ffgky(*fptr, TSTRING, "CPREF", cpref[0], NULL, &tstatus);
+
+ if (!tstatus)
+ {
+ /* Preferred column names are given; separate them */
+ cptr = cpref[0];
+
+ /* the first preferred axis... */
+ while (*cptr != ',' && *cptr != '\0')
+ cptr++;
+
+ if (*cptr != '\0')
+ {
+ *cptr = '\0';
+ cptr++;
+ while (*cptr == ' ')
+ cptr++;
+
+ strcpy(cpref[1], cptr);
+ cptr = cpref[1];
+
+ /* the second preferred axis... */
+ while (*cptr != ',' && *cptr != '\0')
+ cptr++;
+
+ if (*cptr != '\0')
+ {
+ *cptr = '\0';
+ cptr++;
+ while (*cptr == ' ')
+ cptr++;
+
+ strcpy(cpref[2], cptr);
+ cptr = cpref[2];
+
+ /* the third preferred axis... */
+ while (*cptr != ',' && *cptr != '\0')
+ cptr++;
+
+ if (*cptr != '\0')
+ {
+ *cptr = '\0';
+ cptr++;
+ while (*cptr == ' ')
+ cptr++;
+
+ strcpy(cpref[3], cptr);
+
+ }
+ }
+ }
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+
+ /* get the min, max, and binsize values from keywords, if specified */
+
+ if (*minname[ii])
+ {
+ if (ffgky(*fptr, TDOUBLE, minname[ii], &minin[ii], NULL, status) )
+ {
+ ffpmsg("error reading histogramming minimum keyword");
+ ffpmsg(minname[ii]);
+ return(*status);
+ }
+ }
+
+ if (*maxname[ii])
+ {
+ if (ffgky(*fptr, TDOUBLE, maxname[ii], &maxin[ii], NULL, status) )
+ {
+ ffpmsg("error reading histogramming maximum keyword");
+ ffpmsg(maxname[ii]);
+ return(*status);
+ }
+ }
+
+ if (*binname[ii])
+ {
+ if (ffgky(*fptr, TDOUBLE, binname[ii], &binsizein[ii], NULL, status) )
+ {
+ ffpmsg("error reading histogramming binsize keyword");
+ ffpmsg(binname[ii]);
+ return(*status);
+ }
+ }
+
+ if (binsizein[ii] == 0.)
+ {
+ ffpmsg("error: histogram binsize = 0");
+ return(*status = ZERO_SCALE);
+ }
+
+ if (*colname[ii] == '\0')
+ {
+ strcpy(colname[ii], cpref[ii]); /* try using the preferred column */
+ if (*colname[ii] == '\0')
+ {
+ if (ii == 0)
+ strcpy(colname[ii], "X");
+ else if (ii == 1)
+ strcpy(colname[ii], "Y");
+ else if (ii == 2)
+ strcpy(colname[ii], "Z");
+ else if (ii == 3)
+ strcpy(colname[ii], "T");
+ }
+ }
+
+ /* get the column number in the table */
+ if (ffgcno(*fptr, CASEINSEN, colname[ii], histData.hcolnum+ii, status)
+ > 0)
+ {
+ strcpy(errmsg, "column for histogram axis doesn't exist: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status);
+ }
+
+ colptr = ((*fptr)->Fptr)->tableptr;
+ colptr += (histData.hcolnum[ii] - 1);
+
+ repeat = (int) colptr->trepeat; /* vector repeat factor of the column */
+ if (repeat > 1)
+ {
+ strcpy(errmsg, "Can't bin a vector column: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATATYPE);
+ }
+
+ /* get the datatype of the column */
+ fits_get_coltype(*fptr, histData.hcolnum[ii], &datatype,
+ NULL, NULL, status);
+
+ if (datatype < 0 || datatype == TSTRING)
+ {
+ strcpy(errmsg, "Inappropriate datatype; can't bin this column: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATATYPE);
+ }
+
+ /* use TLMINn and TLMAXn keyword values if min and max were not given */
+ /* else use actual data min and max if TLMINn and TLMAXn don't exist */
+
+ if (minin[ii] == DOUBLENULLVALUE)
+ {
+ ffkeyn("TLMIN", histData.hcolnum[ii], keyname, status);
+ if (ffgky(*fptr, TFLOAT, keyname, amin+ii, NULL, status) > 0)
+ {
+ /* use actual data minimum value for the histogram minimum */
+ *status = 0;
+ if (fits_get_col_minmax(*fptr, histData.hcolnum[ii], amin+ii, &datamax, status) > 0)
+ {
+ strcpy(errmsg, "Error calculating datamin and datamax for column: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status);
+ }
+ }
+ }
+ else
+ {
+ amin[ii] = (float) minin[ii];
+ }
+
+ if (maxin[ii] == DOUBLENULLVALUE)
+ {
+ ffkeyn("TLMAX", histData.hcolnum[ii], keyname, status);
+ if (ffgky(*fptr, TFLOAT, keyname, &amax[ii], NULL, status) > 0)
+ {
+ *status = 0;
+ if(datamax != FLOATNULLVALUE) /* already computed max value */
+ {
+ amax[ii] = datamax;
+ }
+ else
+ {
+ /* use actual data maximum value for the histogram maximum */
+ if (fits_get_col_minmax(*fptr, histData.hcolnum[ii], &datamin, &amax[ii], status) > 0)
+ {
+ strcpy(errmsg, "Error calculating datamin and datamax for column: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status);
+ }
+ }
+ }
+ use_datamax = 1; /* flag that the max was determined by the data values */
+ /* and not specifically set by the calling program */
+ }
+ else
+ {
+ amax[ii] = (float) maxin[ii];
+ }
+
+ /* use TDBINn keyword or else 1 if bin size is not given */
+ if (binsizein[ii] == DOUBLENULLVALUE)
+ {
+ tstatus = 0;
+ ffkeyn("TDBIN", histData.hcolnum[ii], keyname, &tstatus);
+
+ if (ffgky(*fptr, TDOUBLE, keyname, binsizein + ii, NULL, &tstatus) > 0)
+ {
+ /* make at least 10 bins */
+ binsizein[ii] = (amax[ii] - amin[ii]) / 10. ;
+ if (binsizein[ii] > 1.)
+ binsizein[ii] = 1.; /* use default bin size */
+ }
+ }
+
+ if ( (amin[ii] > amax[ii] && binsizein[ii] > 0. ) ||
+ (amin[ii] < amax[ii] && binsizein[ii] < 0. ) )
+ binsize[ii] = (float) -binsizein[ii]; /* reverse the sign of binsize */
+ else
+ binsize[ii] = (float) binsizein[ii]; /* binsize has the correct sign */
+
+ ibin = (int) binsize[ii];
+ imin = (int) amin[ii];
+ imax = (int) amax[ii];
+
+ /* Determine the range and number of bins in the histogram. This */
+ /* depends on whether the input columns are integer or floats, so */
+ /* treat each case separately. */
+
+ if (datatype <= TLONG && (float) imin == amin[ii] &&
+ (float) imax == amax[ii] &&
+ (float) ibin == binsize[ii] )
+ {
+ /* This is an integer column and integer limits were entered. */
+ /* Shift the lower and upper histogramming limits by 0.5, so that */
+ /* the values fall in the center of the bin, not on the edge. */
+
+ haxes[ii] = (imax - imin) / ibin + 1; /* last bin may only */
+ /* be partially full */
+ maxbin[ii] = (float) (haxes[ii] + 1.); /* add 1. instead of .5 to avoid roundoff */
+
+ if (amin[ii] < amax[ii])
+ {
+ amin[ii] = (float) (amin[ii] - 0.5);
+ amax[ii] = (float) (amax[ii] + 0.5);
+ }
+ else
+ {
+ amin[ii] = (float) (amin[ii] + 0.5);
+ amax[ii] = (float) (amax[ii] - 0.5);
+ }
+ }
+ else if (use_datamax)
+ {
+ /* Either the column datatype and/or the limits are floating point, */
+ /* and the histogram limits are being defined by the min and max */
+ /* values of the array. Add 1 to the number of histogram bins to */
+ /* make sure that pixels that are equal to the maximum or are */
+ /* in the last partial bin are included. */
+
+ maxbin[ii] = (amax[ii] - amin[ii]) / binsize[ii];
+ haxes[ii] = (long) (maxbin[ii] + 1);
+ }
+ else
+ {
+ /* float datatype column and/or limits, and the maximum value to */
+ /* include in the histogram is specified by the calling program. */
+ /* The lower limit is inclusive, but upper limit is exclusive */
+ maxbin[ii] = (amax[ii] - amin[ii]) / binsize[ii];
+ haxes[ii] = (long) maxbin[ii];
+
+ if (amin[ii] < amax[ii])
+ {
+ if (amin[ii] + (haxes[ii] * binsize[ii]) < amax[ii])
+ haxes[ii]++; /* need to include another partial bin */
+ }
+ else
+ {
+ if (amin[ii] + (haxes[ii] * binsize[ii]) > amax[ii])
+ haxes[ii]++; /* need to include another partial bin */
+ }
+ }
+ }
+
+ /* get the histogramming weighting factor */
+ if (*wtcol)
+ {
+ /* first, look for a keyword with the weight value */
+ if (ffgky(*fptr, TFLOAT, wtcol, &histData.weight, NULL, status) )
+ {
+ /* not a keyword, so look for column with this name */
+ *status = 0;
+
+ /* get the column number in the table */
+ if (ffgcno(*fptr, CASEINSEN, wtcol, &histData.wtcolnum, status) > 0)
+ {
+ ffpmsg(
+ "keyword or column for histogram weights doesn't exist: ");
+ ffpmsg(wtcol);
+ return(*status);
+ }
+
+ histData.weight = FLOATNULLVALUE;
+ }
+ }
+ else
+ histData.weight = (float) weightin;
+
+ if (histData.weight <= 0. && histData.weight != FLOATNULLVALUE)
+ {
+ ffpmsg("Illegal histogramming weighting factor <= 0.");
+ return(*status = URL_PARSE_ERROR);
+ }
+
+ if (recip && histData.weight != FLOATNULLVALUE)
+ /* take reciprocal of weight */
+ histData.weight = (float) (1.0 / histData.weight);
+
+ histData.wtrecip = recip;
+
+ /* size of histogram is now known, so create temp output file */
+ if (ffinit(&histptr, outfile, status) > 0)
+ {
+ ffpmsg("failed to create temp output file for histogram");
+ return(*status);
+ }
+
+ if (ffcrim(histptr, bitpix, histData.haxis, haxes, status) > 0)
+ {
+ ffpmsg("failed to create primary array histogram in temp file");
+ ffclos(histptr, status);
+ return(*status);
+ }
+
+ /* copy all non-structural keywords from the table to the image */
+ fits_get_hdrspace(*fptr, &nkeys, NULL, status);
+ for (ii = 1; ii <= nkeys; ii++)
+ {
+ fits_read_record(*fptr, ii, card, status);
+ if (fits_get_keyclass(card) >= 120)
+ fits_write_record(histptr, card, status);
+ }
+
+ /* Set global variables with histogram parameter values. */
+ /* Use separate scalar variables rather than arrays because */
+ /* it is more efficient when computing the histogram. */
+
+ histData.amin1 = amin[0];
+ histData.maxbin1 = maxbin[0];
+ histData.binsize1 = binsize[0];
+ histData.haxis1 = haxes[0];
+
+ if (histData.haxis > 1)
+ {
+ histData.amin2 = amin[1];
+ histData.maxbin2 = maxbin[1];
+ histData.binsize2 = binsize[1];
+ histData.haxis2 = haxes[1];
+
+ if (histData.haxis > 2)
+ {
+ histData.amin3 = amin[2];
+ histData.maxbin3 = maxbin[2];
+ histData.binsize3 = binsize[2];
+ histData.haxis3 = haxes[2];
+
+ if (histData.haxis > 3)
+ {
+ histData.amin4 = amin[3];
+ histData.maxbin4 = maxbin[3];
+ histData.binsize4 = binsize[3];
+ histData.haxis4 = haxes[3];
+ }
+ }
+ }
+
+ /* define parameters of image for the iterator function */
+ fits_iter_set_file(imagepars, histptr); /* pointer to image */
+ fits_iter_set_datatype(imagepars, imagetype); /* image datatype */
+ fits_iter_set_iotype(imagepars, OutputCol); /* image is output */
+
+ /* call the iterator function to write out the histogram image */
+ if (fits_iterate_data(n_cols, imagepars, offset, n_per_loop,
+ ffwritehisto, (void*)&histData, status) )
+ return(*status);
+
+ /* write the World Coordinate System (WCS) keywords */
+ /* create default values if WCS keywords are not present in the table */
+ for (ii = 0; ii < histData.haxis; ii++)
+ {
+ /* CTYPEn */
+ tstatus = 0;
+ ffkeyn("TCTYP", histData.hcolnum[ii], keyname, &tstatus);
+ ffgky(*fptr, TSTRING, keyname, svalue, NULL, &tstatus);
+ if (tstatus)
+ { /* just use column name as the type */
+ tstatus = 0;
+ ffkeyn("TTYPE", histData.hcolnum[ii], keyname, &tstatus);
+ ffgky(*fptr, TSTRING, keyname, svalue, NULL, &tstatus);
+ }
+
+ if (!tstatus)
+ {
+ ffkeyn("CTYPE", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TSTRING, keyname, svalue, "Coordinate Type", &tstatus);
+ }
+ else
+ tstatus = 0;
+
+ /* CUNITn */
+ ffkeyn("TCUNI", histData.hcolnum[ii], keyname, &tstatus);
+ ffgky(*fptr, TSTRING, keyname, svalue, NULL, &tstatus);
+ if (tstatus)
+ { /* use the column units */
+ tstatus = 0;
+ ffkeyn("TUNIT", histData.hcolnum[ii], keyname, &tstatus);
+ ffgky(*fptr, TSTRING, keyname, svalue, NULL, &tstatus);
+ }
+
+ if (!tstatus)
+ {
+ ffkeyn("CUNIT", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TSTRING, keyname, svalue, "Coordinate Units", &tstatus);
+ }
+ else
+ tstatus = 0;
+
+ /* CRPIXn - Reference Pixel */
+ ffkeyn("TCRPX", histData.hcolnum[ii], keyname, &tstatus);
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus);
+ if (tstatus)
+ {
+ dvalue = 1.0; /* choose first pixel in new image as ref. pix. */
+ tstatus = 0;
+ }
+ else
+ {
+ /* calculate locate of the ref. pix. in the new image */
+ dvalue = (dvalue - amin[ii]) / binsize[ii] + .5;
+ }
+
+ ffkeyn("CRPIX", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TDOUBLE, keyname, &dvalue, "Reference Pixel", &tstatus);
+
+ /* CRVALn - Value at the location of the reference pixel */
+ ffkeyn("TCRVL", histData.hcolnum[ii], keyname, &tstatus);
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus);
+ if (tstatus)
+ {
+ /* calculate value at ref. pix. location (at center of 1st pixel) */
+ dvalue = amin[ii] + binsize[ii]/2.;
+ tstatus = 0;
+ }
+
+ ffkeyn("CRVAL", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TDOUBLE, keyname, &dvalue, "Reference Value", &tstatus);
+
+ /* CDELTn - unit size of pixels */
+ ffkeyn("TCDLT", histData.hcolnum[ii], keyname, &tstatus);
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus);
+ if (tstatus)
+ {
+ dvalue = 1.0; /* use default pixel size */
+ tstatus = 0;
+ }
+
+ dvalue = dvalue * binsize[ii];
+ ffkeyn("CDELT", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TDOUBLE, keyname, &dvalue, "Pixel size", &tstatus);
+
+ /* CROTAn - Rotation angle (degrees CCW) */
+ /* There should only be a CROTA2 keyword, and only for 2+ D images */
+ if (ii == 1)
+ {
+ ffkeyn("TCROT", histData.hcolnum[ii], keyname, &tstatus);
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus);
+ if (!tstatus && dvalue != 0.) /* only write keyword if angle != 0 */
+ {
+ ffkeyn("CROTA", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TDOUBLE, keyname, &dvalue,
+ "Rotation angle", &tstatus);
+ }
+ else
+ {
+ /* didn't find CROTA for the 2nd axis, so look for one */
+ /* on the first axis */
+ tstatus = 0;
+ ffkeyn("TCROT", histData.hcolnum[0], keyname, &tstatus);
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus);
+ if (!tstatus && dvalue != 0.) /* only write keyword if angle != 0 */
+ {
+ dvalue *= -1.; /* negate the value, because mirror image */
+ ffkeyn("CROTA", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TDOUBLE, keyname, &dvalue,
+ "Rotation angle", &tstatus);
+ }
+ }
+ }
+ }
+
+ /* convert any TPn_k keywords to PCi_j; the value remains unchanged */
+ /* also convert any TCn_k to CDi_j; the value is modified by n binning size */
+ /* This is a bit of a kludge, and only works for 2D WCS */
+
+ if (histData.haxis == 2) {
+
+ /* PC1_1 */
+ tstatus = 0;
+ ffkeyn("TP", histData.hcolnum[0], card, &tstatus);
+ strcat(card,"_");
+ ffkeyn(card, histData.hcolnum[0], keyname, &tstatus);
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, card, &tstatus);
+ if (!tstatus)
+ ffpky(histptr, TDOUBLE, "PC1_1", &dvalue, card, &tstatus);
+
+ tstatus = 0;
+ keyname[1] = 'C';
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, card, &tstatus);
+ if (!tstatus) {
+ dvalue *= binsize[0];
+ ffpky(histptr, TDOUBLE, "CD1_1", &dvalue, card, &tstatus);
+ }
+
+ /* PC1_2 */
+ tstatus = 0;
+ ffkeyn("TP", histData.hcolnum[0], card, &tstatus);
+ strcat(card,"_");
+ ffkeyn(card, histData.hcolnum[1], keyname, &tstatus);
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, card, &tstatus);
+ if (!tstatus)
+ ffpky(histptr, TDOUBLE, "PC1_2", &dvalue, card, &tstatus);
+
+ tstatus = 0;
+ keyname[1] = 'C';
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, card, &tstatus);
+ if (!tstatus) {
+ dvalue *= binsize[0];
+ ffpky(histptr, TDOUBLE, "CD1_2", &dvalue, card, &tstatus);
+ }
+
+ /* PC2_1 */
+ tstatus = 0;
+ ffkeyn("TP", histData.hcolnum[1], card, &tstatus);
+ strcat(card,"_");
+ ffkeyn(card, histData.hcolnum[0], keyname, &tstatus);
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, card, &tstatus);
+ if (!tstatus)
+ ffpky(histptr, TDOUBLE, "PC2_1", &dvalue, card, &tstatus);
+
+ tstatus = 0;
+ keyname[1] = 'C';
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, card, &tstatus);
+ if (!tstatus) {
+ dvalue *= binsize[1];
+ ffpky(histptr, TDOUBLE, "CD2_1", &dvalue, card, &tstatus);
+ }
+
+ /* PC2_2 */
+ tstatus = 0;
+ ffkeyn("TP", histData.hcolnum[1], card, &tstatus);
+ strcat(card,"_");
+ ffkeyn(card, histData.hcolnum[1], keyname, &tstatus);
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, card, &tstatus);
+ if (!tstatus)
+ ffpky(histptr, TDOUBLE, "PC2_2", &dvalue, card, &tstatus);
+
+ tstatus = 0;
+ keyname[1] = 'C';
+ ffgky(*fptr, TDOUBLE, keyname, &dvalue, card, &tstatus);
+ if (!tstatus) {
+ dvalue *= binsize[1];
+ ffpky(histptr, TDOUBLE, "CD2_2", &dvalue, card, &tstatus);
+ }
+ }
+
+ /* finally, close the original file and return ptr to the new image */
+ ffclos(*fptr, status);
+ *fptr = histptr;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_calc_binning(
+ fitsfile *fptr, /* IO - pointer to table to be binned ; */
+ int naxis, /* I - number of axes/columns in the binned image */
+ char colname[4][FLEN_VALUE], /* I - optional column names */
+ double *minin, /* I - optional lower bound value for each axis */
+ double *maxin, /* I - optional upper bound value, for each axis */
+ double *binsizein, /* I - optional bin size along each axis */
+ char minname[4][FLEN_VALUE], /* I - optional keywords for min */
+ char maxname[4][FLEN_VALUE], /* I - optional keywords for max */
+ char binname[4][FLEN_VALUE], /* I - optional keywords for binsize */
+
+ /* The returned parameters for each axis of the n-dimensional histogram are */
+
+ int *colnum, /* O - column numbers, to be binned */
+ long *haxes, /* O - number of bins in each histogram axis */
+ float *amin, /* O - lower bound of the histogram axes */
+ float *amax, /* O - upper bound of the histogram axes */
+ float *binsize, /* O - width of histogram bins/pixels on each axis */
+ int *status)
+/*_
+ Calculate the actual binning parameters, based on various user input
+ options.
+*/
+{
+ tcolumn *colptr;
+ char *cptr, cpref[4][FLEN_VALUE];
+ char errmsg[FLEN_ERRMSG], keyname[FLEN_KEYWORD];
+ int tstatus, ii;
+ int datatype, repeat, imin, imax, ibin, use_datamax = 0;
+ float datamin, datamax;
+
+ /* check inputs */
+
+ if (*status > 0)
+ return(*status);
+
+ if (naxis > 4)
+ {
+ ffpmsg("histograms with more than 4 dimensions are not supported");
+ return(*status = BAD_DIMEN);
+ }
+
+ /* reset position to the correct HDU if necessary */
+ if ((fptr)->HDUposition != ((fptr)->Fptr)->curhdu)
+ ffmahd(fptr, ((fptr)->HDUposition) + 1, NULL, status);
+
+ /* ============================================================= */
+ /* The CPREF keyword, if it exists, gives the preferred columns. */
+ /* Otherwise, assume "X", "Y", "Z", and "T" */
+
+ *cpref[0] = '\0';
+ *cpref[1] = '\0';
+ *cpref[2] = '\0';
+ *cpref[3] = '\0';
+
+ tstatus = 0;
+ ffgky(fptr, TSTRING, "CPREF", cpref[0], NULL, &tstatus);
+
+ if (!tstatus)
+ {
+ /* Preferred column names are given; separate them */
+ cptr = cpref[0];
+
+ /* the first preferred axis... */
+ while (*cptr != ',' && *cptr != '\0')
+ cptr++;
+
+ if (*cptr != '\0')
+ {
+ *cptr = '\0';
+ cptr++;
+ while (*cptr == ' ')
+ cptr++;
+
+ strcpy(cpref[1], cptr);
+ cptr = cpref[1];
+
+ /* the second preferred axis... */
+ while (*cptr != ',' && *cptr != '\0')
+ cptr++;
+
+ if (*cptr != '\0')
+ {
+ *cptr = '\0';
+ cptr++;
+ while (*cptr == ' ')
+ cptr++;
+
+ strcpy(cpref[2], cptr);
+ cptr = cpref[2];
+
+ /* the third preferred axis... */
+ while (*cptr != ',' && *cptr != '\0')
+ cptr++;
+
+ if (*cptr != '\0')
+ {
+ *cptr = '\0';
+ cptr++;
+ while (*cptr == ' ')
+ cptr++;
+
+ strcpy(cpref[3], cptr);
+
+ }
+ }
+ }
+ }
+
+ /* ============================================================= */
+ /* Main Loop for calculating parameters for each column */
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+
+ /* =========================================================== */
+ /* Determine column Number, based on, in order of priority,
+ 1 input column name, or
+ 2 name given by CPREF keyword, or
+ 3 assume X, Y, Z and T for the name
+ */
+
+ if (*colname[ii] == '\0')
+ {
+ strcpy(colname[ii], cpref[ii]); /* try using the preferred column */
+ if (*colname[ii] == '\0')
+ {
+ if (ii == 0)
+ strcpy(colname[ii], "X");
+ else if (ii == 1)
+ strcpy(colname[ii], "Y");
+ else if (ii == 2)
+ strcpy(colname[ii], "Z");
+ else if (ii == 3)
+ strcpy(colname[ii], "T");
+ }
+ }
+
+ /* get the column number in the table */
+ if (ffgcno(fptr, CASEINSEN, colname[ii], colnum+ii, status)
+ > 0)
+ {
+ strcpy(errmsg, "column for histogram axis doesn't exist: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status);
+ }
+
+ /* ================================================================ */
+ /* check tha column is not a vector or a string */
+
+ colptr = ((fptr)->Fptr)->tableptr;
+ colptr += (colnum[ii] - 1);
+
+ repeat = (int) colptr->trepeat; /* vector repeat factor of the column */
+ if (repeat > 1)
+ {
+ strcpy(errmsg, "Can't bin a vector column: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATATYPE);
+ }
+
+ /* get the datatype of the column */
+ fits_get_coltype(fptr, colnum[ii], &datatype,
+ NULL, NULL, status);
+
+ if (datatype < 0 || datatype == TSTRING)
+ {
+ strcpy(errmsg, "Inappropriate datatype; can't bin this column: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATATYPE);
+ }
+
+ /* ================================================================ */
+ /* get the minimum value */
+
+ datamin = FLOATNULLVALUE;
+ datamax = FLOATNULLVALUE;
+
+ if (*minname[ii])
+ {
+ if (ffgky(fptr, TDOUBLE, minname[ii], &minin[ii], NULL, status) )
+ {
+ ffpmsg("error reading histogramming minimum keyword");
+ ffpmsg(minname[ii]);
+ return(*status);
+ }
+ }
+
+ if (minin[ii] != DOUBLENULLVALUE)
+ {
+ amin[ii] = (float) minin[ii];
+ }
+ else
+ {
+ ffkeyn("TLMIN", colnum[ii], keyname, status);
+ if (ffgky(fptr, TFLOAT, keyname, amin+ii, NULL, status) > 0)
+ {
+ /* use actual data minimum value for the histogram minimum */
+ *status = 0;
+ if (fits_get_col_minmax(fptr, colnum[ii], amin+ii, &datamax, status) > 0)
+ {
+ strcpy(errmsg, "Error calculating datamin and datamax for column: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status);
+ }
+ }
+ }
+
+ /* ================================================================ */
+ /* get the maximum value */
+
+ if (*maxname[ii])
+ {
+ if (ffgky(fptr, TDOUBLE, maxname[ii], &maxin[ii], NULL, status) )
+ {
+ ffpmsg("error reading histogramming maximum keyword");
+ ffpmsg(maxname[ii]);
+ return(*status);
+ }
+ }
+
+ if (maxin[ii] != DOUBLENULLVALUE)
+ {
+ amax[ii] = (float) maxin[ii];
+ }
+ else
+ {
+ ffkeyn("TLMAX", colnum[ii], keyname, status);
+ if (ffgky(fptr, TFLOAT, keyname, &amax[ii], NULL, status) > 0)
+ {
+ *status = 0;
+ if(datamax != FLOATNULLVALUE) /* already computed max value */
+ {
+ amax[ii] = datamax;
+ }
+ else
+ {
+ /* use actual data maximum value for the histogram maximum */
+ if (fits_get_col_minmax(fptr, colnum[ii], &datamin, &amax[ii], status) > 0)
+ {
+ strcpy(errmsg, "Error calculating datamin and datamax for column: ");
+ strcat(errmsg, colname[ii]);
+ ffpmsg(errmsg);
+ return(*status);
+ }
+ }
+ }
+ use_datamax = 1; /* flag that the max was determined by the data values */
+ /* and not specifically set by the calling program */
+ }
+
+
+ /* ================================================================ */
+ /* determine binning size and range */
+
+ if (*binname[ii])
+ {
+ if (ffgky(fptr, TDOUBLE, binname[ii], &binsizein[ii], NULL, status) )
+ {
+ ffpmsg("error reading histogramming binsize keyword");
+ ffpmsg(binname[ii]);
+ return(*status);
+ }
+ }
+
+ if (binsizein[ii] == 0.)
+ {
+ ffpmsg("error: histogram binsize = 0");
+ return(*status = ZERO_SCALE);
+ }
+
+ /* use TDBINn keyword or else 1 if bin size is not given */
+ if (binsizein[ii] != DOUBLENULLVALUE)
+ {
+ binsize[ii] = (float) binsizein[ii];
+ }
+ else
+ {
+ tstatus = 0;
+ ffkeyn("TDBIN", colnum[ii], keyname, &tstatus);
+
+ if (ffgky(fptr, TDOUBLE, keyname, binsizein + ii, NULL, &tstatus) > 0)
+ {
+ /* make at least 10 bins */
+ binsize[ii] = (amax[ii] - amin[ii]) / 10.F ;
+ if (binsize[ii] > 1.)
+ binsize[ii] = 1.; /* use default bin size */
+ }
+ }
+
+ /* ================================================================ */
+ /* if the min is greater than the max, make the binsize negative */
+ if ( (amin[ii] > amax[ii] && binsize[ii] > 0. ) ||
+ (amin[ii] < amax[ii] && binsize[ii] < 0. ) )
+ binsize[ii] = -binsize[ii]; /* reverse the sign of binsize */
+
+
+ ibin = (int) binsize[ii];
+ imin = (int) amin[ii];
+ imax = (int) amax[ii];
+
+ /* Determine the range and number of bins in the histogram. This */
+ /* depends on whether the input columns are integer or floats, so */
+ /* treat each case separately. */
+
+ if (datatype <= TLONG && (float) imin == amin[ii] &&
+ (float) imax == amax[ii] &&
+ (float) ibin == binsize[ii] )
+ {
+ /* This is an integer column and integer limits were entered. */
+ /* Shift the lower and upper histogramming limits by 0.5, so that */
+ /* the values fall in the center of the bin, not on the edge. */
+
+ haxes[ii] = (imax - imin) / ibin + 1; /* last bin may only */
+ /* be partially full */
+ if (amin[ii] < amax[ii])
+ {
+ amin[ii] = (float) (amin[ii] - 0.5);
+ amax[ii] = (float) (amax[ii] + 0.5);
+ }
+ else
+ {
+ amin[ii] = (float) (amin[ii] + 0.5);
+ amax[ii] = (float) (amax[ii] - 0.5);
+ }
+ }
+ else if (use_datamax)
+ {
+ /* Either the column datatype and/or the limits are floating point, */
+ /* and the histogram limits are being defined by the min and max */
+ /* values of the array. Add 1 to the number of histogram bins to */
+ /* make sure that pixels that are equal to the maximum or are */
+ /* in the last partial bin are included. */
+
+ haxes[ii] = (long) (((amax[ii] - amin[ii]) / binsize[ii]) + 1.);
+ }
+ else
+ {
+ /* float datatype column and/or limits, and the maximum value to */
+ /* include in the histogram is specified by the calling program. */
+ /* The lower limit is inclusive, but upper limit is exclusive */
+ haxes[ii] = (long) ((amax[ii] - amin[ii]) / binsize[ii]);
+
+ if (amin[ii] < amax[ii])
+ {
+ if (amin[ii] + (haxes[ii] * binsize[ii]) < amax[ii])
+ haxes[ii]++; /* need to include another partial bin */
+ }
+ else
+ {
+ if (amin[ii] + (haxes[ii] * binsize[ii]) > amax[ii])
+ haxes[ii]++; /* need to include another partial bin */
+ }
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_write_keys_histo(
+ fitsfile *fptr, /* I - pointer to table to be binned */
+ fitsfile *histptr, /* I - pointer to output histogram image HDU */
+ int naxis, /* I - number of axes in the histogram image */
+ int *colnum, /* I - column numbers (array length = naxis) */
+ int *status)
+{
+ /* Write default WCS keywords in the output histogram image header */
+ /* if the keywords do not already exist. */
+
+ int ii, tstatus;
+ char keyname[FLEN_KEYWORD], svalue[FLEN_VALUE];
+ double dvalue;
+
+ if (*status > 0)
+ return(*status);
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ /* CTYPEn */
+ tstatus = 0;
+ ffkeyn("CTYPE", ii+1, keyname, &tstatus);
+ ffgky(histptr, TSTRING, keyname, svalue, NULL, &tstatus);
+
+ if (!tstatus) continue; /* keyword already exists, so skip to next axis */
+
+ /* use column name as the axis name */
+ tstatus = 0;
+ ffkeyn("TTYPE", colnum[ii], keyname, &tstatus);
+ ffgky(fptr, TSTRING, keyname, svalue, NULL, &tstatus);
+
+ if (!tstatus)
+ {
+ ffkeyn("CTYPE", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TSTRING, keyname, svalue, "Coordinate Type", &tstatus);
+ }
+
+ /* CUNITn, use the column units */
+ tstatus = 0;
+ ffkeyn("TUNIT", colnum[ii], keyname, &tstatus);
+ ffgky(fptr, TSTRING, keyname, svalue, NULL, &tstatus);
+
+ if (!tstatus)
+ {
+ ffkeyn("CUNIT", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TSTRING, keyname, svalue, "Coordinate Units", &tstatus);
+ }
+
+ /* CRPIXn - Reference Pixel choose first pixel in new image as ref. pix. */
+ dvalue = 1.0;
+ tstatus = 0;
+ ffkeyn("CRPIX", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TDOUBLE, keyname, &dvalue, "Reference Pixel", &tstatus);
+
+ /* CRVALn - Value at the location of the reference pixel */
+ dvalue = 1.0;
+ tstatus = 0;
+ ffkeyn("CRVAL", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TDOUBLE, keyname, &dvalue, "Reference Value", &tstatus);
+
+ /* CDELTn - unit size of pixels */
+ dvalue = 1.0;
+ tstatus = 0;
+ dvalue = 1.;
+ ffkeyn("CDELT", ii + 1, keyname, &tstatus);
+ ffpky(histptr, TDOUBLE, keyname, &dvalue, "Pixel size", &tstatus);
+
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_rebin_wcs(
+ fitsfile *fptr, /* I - pointer to table to be binned */
+ int naxis, /* I - number of axes in the histogram image */
+ float *amin, /* I - first pixel include in each axis */
+ float *binsize, /* I - binning factor for each axis */
+ int *status)
+{
+ /* Update the WCS keywords that define the location of the reference */
+ /* pixel, and the pixel size, along each axis. */
+
+ int ii, jj, tstatus, reset ;
+ char keyname[FLEN_KEYWORD], svalue[FLEN_VALUE];
+ double dvalue;
+
+ if (*status > 0)
+ return(*status);
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ reset = 0; /* flag to reset the reference pixel */
+ tstatus = 0;
+ ffkeyn("CRVAL", ii + 1, keyname, &tstatus);
+ /* get previous (pre-binning) value */
+ ffgky(fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus);
+ if (!tstatus && dvalue == 1.0)
+ reset = 1;
+
+ tstatus = 0;
+ /* CRPIXn - update location of the ref. pix. in the binned image */
+ ffkeyn("CRPIX", ii + 1, keyname, &tstatus);
+
+ /* get previous (pre-binning) value */
+ ffgky(fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus);
+
+ if (!tstatus)
+ {
+ if (dvalue != 1.0)
+ reset = 0;
+
+ /* updated value to give pixel location after binning */
+ dvalue = (dvalue - amin[ii]) / ((double) binsize[ii]) + .5;
+
+ fits_modify_key_dbl(fptr, keyname, dvalue, -14, NULL, &tstatus);
+ } else {
+ reset = 0;
+ }
+
+ /* CDELTn - update unit size of pixels */
+ tstatus = 0;
+ ffkeyn("CDELT", ii + 1, keyname, &tstatus);
+
+ /* get previous (pre-binning) value */
+ ffgky(fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus);
+
+ if (!tstatus)
+ {
+ if (dvalue != 1.0)
+ reset = 0;
+
+ /* updated to give post-binning value */
+ dvalue = dvalue * binsize[ii];
+
+ fits_modify_key_dbl(fptr, keyname, dvalue, -14, NULL, &tstatus);
+ }
+ else
+ { /* no CDELTn keyword, so look for a CDij keywords */
+ reset = 0;
+
+ for (jj = 0; jj < naxis; jj++)
+ {
+ tstatus = 0;
+ ffkeyn("CD", jj + 1, svalue, &tstatus);
+ strcat(svalue,"_");
+ ffkeyn(svalue, ii + 1, keyname, &tstatus);
+
+ /* get previous (pre-binning) value */
+ ffgky(fptr, TDOUBLE, keyname, &dvalue, NULL, &tstatus);
+
+ if (!tstatus)
+ {
+ /* updated to give post-binning value */
+ dvalue = dvalue * binsize[ii];
+
+ fits_modify_key_dbl(fptr, keyname, dvalue, -14, NULL, &tstatus);
+ }
+ }
+ }
+
+ if (reset) {
+ /* the original CRPIX, CRVAL, and CDELT keywords were all = 1.0 */
+ /* In this special case, reset the reference pixel to be the */
+ /* first pixel in the array (instead of possibly far off the array) */
+
+ dvalue = 1.0;
+ ffkeyn("CRPIX", ii + 1, keyname, &tstatus);
+ fits_modify_key_dbl(fptr, keyname, dvalue, -14, NULL, &tstatus);
+
+ ffkeyn("CRVAL", ii + 1, keyname, &tstatus);
+ dvalue = amin[ii] + (binsize[ii] / 2.0);
+ fits_modify_key_dbl(fptr, keyname, dvalue, -14, NULL, &tstatus);
+ }
+
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+
+int fits_make_hist(fitsfile *fptr, /* IO - pointer to table with X and Y cols; */
+ fitsfile *histptr, /* I - pointer to output FITS image */
+ int bitpix, /* I - datatype for image: 16, 32, -32, etc */
+ int naxis, /* I - number of axes in the histogram image */
+ long *naxes, /* I - size of axes in the histogram image */
+ int *colnum, /* I - column numbers (array length = naxis) */
+ float *amin, /* I - minimum histogram value, for each axis */
+ float *amax, /* I - maximum histogram value, for each axis */
+ float *binsize, /* I - bin size along each axis */
+ float weight, /* I - binning weighting factor */
+ int wtcolnum, /* I - optional keyword or col for weight*/
+ int recip, /* I - use reciprocal of the weight? */
+ char *selectrow, /* I - optional array (length = no. of */
+ /* rows in the table). If the element is true */
+ /* then the corresponding row of the table will*/
+ /* be included in the histogram, otherwise the */
+ /* row will be skipped. Ingnored if *selectrow*/
+ /* is equal to NULL. */
+ int *status)
+{
+ int ii, imagetype, datatype;
+ int n_cols = 1;
+ long imin, imax, ibin;
+ long offset = 0;
+ long n_per_loop = -1; /* force whole array to be passed at one time */
+ float taxes[4], tmin[4], tmax[4], tbin[4], maxbin[4];
+ histType histData; /* Structure holding histogram info for iterator */
+ iteratorCol imagepars[1];
+
+ /* check inputs */
+
+ if (*status > 0)
+ return(*status);
+
+ if (naxis > 4)
+ {
+ ffpmsg("histogram has more than 4 dimensions");
+ return(*status = BAD_DIMEN);
+ }
+
+ if (bitpix == BYTE_IMG)
+ imagetype = TBYTE;
+ else if (bitpix == SHORT_IMG)
+ imagetype = TSHORT;
+ else if (bitpix == LONG_IMG)
+ imagetype = TINT;
+ else if (bitpix == FLOAT_IMG)
+ imagetype = TFLOAT;
+ else if (bitpix == DOUBLE_IMG)
+ imagetype = TDOUBLE;
+ else
+ return(*status = BAD_DATATYPE);
+
+ /* reset position to the correct HDU if necessary */
+ if ((fptr)->HDUposition != ((fptr)->Fptr)->curhdu)
+ ffmahd(fptr, ((fptr)->HDUposition) + 1, NULL, status);
+
+ histData.weight = weight;
+ histData.wtcolnum = wtcolnum;
+ histData.wtrecip = recip;
+ histData.tblptr = fptr;
+ histData.himagetype = imagetype;
+ histData.haxis = naxis;
+ histData.rowselector = selectrow;
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ taxes[ii] = (float) naxes[ii];
+ tmin[ii] = amin[ii];
+ tmax[ii] = amax[ii];
+ if ( (amin[ii] > amax[ii] && binsize[ii] > 0. ) ||
+ (amin[ii] < amax[ii] && binsize[ii] < 0. ) )
+ tbin[ii] = -binsize[ii]; /* reverse the sign of binsize */
+ else
+ tbin[ii] = binsize[ii]; /* binsize has the correct sign */
+
+ imin = (long) tmin[ii];
+ imax = (long) tmax[ii];
+ ibin = (long) tbin[ii];
+
+ /* get the datatype of the column */
+ fits_get_coltype(fptr, colnum[ii], &datatype, NULL, NULL, status);
+
+ if (datatype <= TLONG && (float) imin == tmin[ii] &&
+ (float) imax == tmax[ii] &&
+ (float) ibin == tbin[ii] )
+ {
+ /* This is an integer column and integer limits were entered. */
+ /* Shift the lower and upper histogramming limits by 0.5, so that */
+ /* the values fall in the center of the bin, not on the edge. */
+
+ maxbin[ii] = (taxes[ii] + 1.F); /* add 1. instead of .5 to avoid roundoff */
+
+ if (tmin[ii] < tmax[ii])
+ {
+ tmin[ii] = tmin[ii] - 0.5F;
+ tmax[ii] = tmax[ii] + 0.5F;
+ }
+ else
+ {
+ tmin[ii] = tmin[ii] + 0.5F;
+ tmax[ii] = tmax[ii] - 0.5F;
+ }
+ } else { /* not an integer column with integer limits */
+ maxbin[ii] = (tmax[ii] - tmin[ii]) / tbin[ii];
+ }
+ }
+
+ /* Set global variables with histogram parameter values. */
+ /* Use separate scalar variables rather than arrays because */
+ /* it is more efficient when computing the histogram. */
+
+ histData.hcolnum[0] = colnum[0];
+ histData.amin1 = tmin[0];
+ histData.maxbin1 = maxbin[0];
+ histData.binsize1 = tbin[0];
+ histData.haxis1 = (long) taxes[0];
+
+ if (histData.haxis > 1)
+ {
+ histData.hcolnum[1] = colnum[1];
+ histData.amin2 = tmin[1];
+ histData.maxbin2 = maxbin[1];
+ histData.binsize2 = tbin[1];
+ histData.haxis2 = (long) taxes[1];
+
+ if (histData.haxis > 2)
+ {
+ histData.hcolnum[2] = colnum[2];
+ histData.amin3 = tmin[2];
+ histData.maxbin3 = maxbin[2];
+ histData.binsize3 = tbin[2];
+ histData.haxis3 = (long) taxes[2];
+
+ if (histData.haxis > 3)
+ {
+ histData.hcolnum[3] = colnum[3];
+ histData.amin4 = tmin[3];
+ histData.maxbin4 = maxbin[3];
+ histData.binsize4 = tbin[3];
+ histData.haxis4 = (long) taxes[3];
+ }
+ }
+ }
+
+ /* define parameters of image for the iterator function */
+ fits_iter_set_file(imagepars, histptr); /* pointer to image */
+ fits_iter_set_datatype(imagepars, imagetype); /* image datatype */
+ fits_iter_set_iotype(imagepars, OutputCol); /* image is output */
+
+ /* call the iterator function to write out the histogram image */
+ fits_iterate_data(n_cols, imagepars, offset, n_per_loop,
+ ffwritehisto, (void*)&histData, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_get_col_minmax(fitsfile *fptr, int colnum, float *datamin,
+ float *datamax, int *status)
+/*
+ Simple utility routine to compute the min and max value in a column
+*/
+{
+ int anynul;
+ long nrows, ntodo, firstrow, ii;
+ float array[1000], nulval;
+
+ ffgky(fptr, TLONG, "NAXIS2", &nrows, NULL, status); /* no. of rows */
+
+ firstrow = 1;
+ nulval = FLOATNULLVALUE;
+ *datamin = 9.0E36F;
+ *datamax = -9.0E36F;
+
+ while(nrows)
+ {
+ ntodo = minvalue(nrows, 100);
+ ffgcv(fptr, TFLOAT, colnum, firstrow, 1, ntodo, &nulval, array,
+ &anynul, status);
+
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (array[ii] != nulval)
+ {
+ *datamin = minvalue(*datamin, array[ii]);
+ *datamax = maxvalue(*datamax, array[ii]);
+ }
+ }
+
+ nrows -= ntodo;
+ firstrow += ntodo;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffwritehisto(long totaln, long pixoffset, long firstn, long nvalues,
+ int narrays, iteratorCol *imagepars, void *userPointer)
+/*
+ Interator work function that writes out the histogram.
+ The histogram values are calculated by another work function, ffcalchisto.
+ This work function only gets called once, and totaln = nvalues.
+*/
+{
+ iteratorCol colpars[5];
+ int ii, status = 0, ncols;
+ long rows_per_loop = 0, offset = 0;
+ histType *histData;
+
+ histData = (histType *)userPointer;
+
+ /* store pointer to the histogram array, and initialize to zero */
+
+ switch( histData->himagetype ) {
+ case TBYTE:
+ histData->hist.b = (char * ) fits_iter_get_array(imagepars);
+ break;
+ case TSHORT:
+ histData->hist.i = (short * ) fits_iter_get_array(imagepars);
+ break;
+ case TINT:
+ histData->hist.j = (int * ) fits_iter_get_array(imagepars);
+ break;
+ case TFLOAT:
+ histData->hist.r = (float * ) fits_iter_get_array(imagepars);
+ break;
+ case TDOUBLE:
+ histData->hist.d = (double *) fits_iter_get_array(imagepars);
+ break;
+ }
+
+ /* set the column parameters for the iterator function */
+ for (ii = 0; ii < histData->haxis; ii++)
+ {
+ fits_iter_set_by_num(&colpars[ii], histData->tblptr,
+ histData->hcolnum[ii], TFLOAT, InputCol);
+ }
+ ncols = histData->haxis;
+
+ if (histData->weight == FLOATNULLVALUE)
+ {
+ fits_iter_set_by_num(&colpars[histData->haxis], histData->tblptr,
+ histData->wtcolnum, TFLOAT, InputCol);
+ ncols = histData->haxis + 1;
+ }
+
+ /* call iterator function to calc the histogram pixel values */
+
+ /* must lock this call in multithreaded environoments because */
+ /* the ffcalchist work routine uses static vaiables that would */
+ /* get clobbered if multiple threads were running at the same time */
+ FFLOCK;
+ fits_iterate_data(ncols, colpars, offset, rows_per_loop,
+ ffcalchist, (void*)histData, &status);
+ FFUNLOCK;
+
+ return(status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcalchist(long totalrows, long offset, long firstrow, long nrows,
+ int ncols, iteratorCol *colpars, void *userPointer)
+/*
+ Interator work function that calculates values for the 2D histogram.
+*/
+{
+ long ii, ipix, iaxisbin;
+ float pix, axisbin;
+ static float *col1, *col2, *col3, *col4; /* static to preserve values */
+ static float *wtcol;
+ static long incr2, incr3, incr4;
+ static histType histData;
+ static char *rowselect;
+
+ /* Initialization procedures: execute on the first call */
+ if (firstrow == 1)
+ {
+
+ /* Copy input histogram data to static local variable so we */
+ /* don't have to constantly dereference it. */
+
+ histData = *(histType*)userPointer;
+ rowselect = histData.rowselector;
+
+ /* assign the input array pointers to local pointers */
+ col1 = (float *) fits_iter_get_array(&colpars[0]);
+ if (histData.haxis > 1)
+ {
+ col2 = (float *) fits_iter_get_array(&colpars[1]);
+ incr2 = histData.haxis1;
+
+ if (histData.haxis > 2)
+ {
+ col3 = (float *) fits_iter_get_array(&colpars[2]);
+ incr3 = incr2 * histData.haxis2;
+
+ if (histData.haxis > 3)
+ {
+ col4 = (float *) fits_iter_get_array(&colpars[3]);
+ incr4 = incr3 * histData.haxis3;
+ }
+ }
+ }
+
+ if (ncols > histData.haxis) /* then weights are give in a column */
+ {
+ wtcol = (float *) fits_iter_get_array(&colpars[histData.haxis]);
+ }
+ } /* end of Initialization procedures */
+
+ /* Main loop: increment the histogram at position of each event */
+ for (ii = 1; ii <= nrows; ii++)
+ {
+ if (rowselect) /* if a row selector array is supplied... */
+ {
+ if (*rowselect)
+ {
+ rowselect++; /* this row is included in the histogram */
+ }
+ else
+ {
+ rowselect++; /* this row is excluded from the histogram */
+ continue;
+ }
+ }
+
+ if (col1[ii] == FLOATNULLVALUE) /* test for null value */
+ continue;
+
+ pix = (col1[ii] - histData.amin1) / histData.binsize1;
+ ipix = (long) (pix + 1.); /* add 1 because the 1st pixel is the null value */
+
+ /* test if bin is within range */
+ if (ipix < 1 || ipix > histData.haxis1 || pix > histData.maxbin1)
+ continue;
+
+ if (histData.haxis > 1)
+ {
+ if (col2[ii] == FLOATNULLVALUE)
+ continue;
+
+ axisbin = (col2[ii] - histData.amin2) / histData.binsize2;
+ iaxisbin = (long) axisbin;
+
+ if (axisbin < 0. || iaxisbin >= histData.haxis2 || axisbin > histData.maxbin2)
+ continue;
+
+ ipix += (iaxisbin * incr2);
+
+ if (histData.haxis > 2)
+ {
+ if (col3[ii] == FLOATNULLVALUE)
+ continue;
+
+ axisbin = (col3[ii] - histData.amin3) / histData.binsize3;
+ iaxisbin = (long) axisbin;
+ if (axisbin < 0. || iaxisbin >= histData.haxis3 || axisbin > histData.maxbin3)
+ continue;
+
+ ipix += (iaxisbin * incr3);
+
+ if (histData.haxis > 3)
+ {
+ if (col4[ii] == FLOATNULLVALUE)
+ continue;
+
+ axisbin = (col4[ii] - histData.amin4) / histData.binsize4;
+ iaxisbin = (long) axisbin;
+ if (axisbin < 0. || iaxisbin >= histData.haxis4 || axisbin > histData.maxbin4)
+ continue;
+
+ ipix += (iaxisbin * incr4);
+
+ } /* end of haxis > 3 case */
+ } /* end of haxis > 2 case */
+ } /* end of haxis > 1 case */
+
+ /* increment the histogram pixel */
+ if (histData.weight != FLOATNULLVALUE) /* constant weight factor */
+ {
+ if (histData.himagetype == TINT)
+ histData.hist.j[ipix] += (int) histData.weight;
+ else if (histData.himagetype == TSHORT)
+ histData.hist.i[ipix] += (short) histData.weight;
+ else if (histData.himagetype == TFLOAT)
+ histData.hist.r[ipix] += histData.weight;
+ else if (histData.himagetype == TDOUBLE)
+ histData.hist.d[ipix] += histData.weight;
+ else if (histData.himagetype == TBYTE)
+ histData.hist.b[ipix] += (char) histData.weight;
+ }
+ else if (histData.wtrecip) /* use reciprocal of the weight */
+ {
+ if (histData.himagetype == TINT)
+ histData.hist.j[ipix] += (int) (1./wtcol[ii]);
+ else if (histData.himagetype == TSHORT)
+ histData.hist.i[ipix] += (short) (1./wtcol[ii]);
+ else if (histData.himagetype == TFLOAT)
+ histData.hist.r[ipix] += (float) (1./wtcol[ii]);
+ else if (histData.himagetype == TDOUBLE)
+ histData.hist.d[ipix] += 1./wtcol[ii];
+ else if (histData.himagetype == TBYTE)
+ histData.hist.b[ipix] += (char) (1./wtcol[ii]);
+ }
+ else /* no weights */
+ {
+ if (histData.himagetype == TINT)
+ histData.hist.j[ipix] += (int) wtcol[ii];
+ else if (histData.himagetype == TSHORT)
+ histData.hist.i[ipix] += (short) wtcol[ii];
+ else if (histData.himagetype == TFLOAT)
+ histData.hist.r[ipix] += wtcol[ii];
+ else if (histData.himagetype == TDOUBLE)
+ histData.hist.d[ipix] += wtcol[ii];
+ else if (histData.himagetype == TBYTE)
+ histData.hist.b[ipix] += (char) wtcol[ii];
+ }
+
+ } /* end of main loop over all rows */
+
+ return(0);
+}
+
diff --git a/src/plugins/cfitsio/imcompress.c b/src/plugins/cfitsio/imcompress.c
new file mode 100644
index 0000000..6330bf8
--- /dev/null
+++ b/src/plugins/cfitsio/imcompress.c
@@ -0,0 +1,9247 @@
+# include <stdio.h>
+# include <stdlib.h>
+# include <string.h>
+# include <math.h>
+# include <ctype.h>
+# include <time.h>
+# include "fitsio2.h"
+
+#define NULL_VALUE -2147483647 /* value used to represent undefined pixels */
+
+/* nearest integer function */
+# define NINT(x) ((x >= 0.) ? (int) (x + 0.5) : (int) (x - 0.5))
+
+/* special quantize level value indicates that floating point image pixels */
+/* should not be quantized and instead losslessly compressed (with GZIP) */
+#define NO_QUANTIZE 9999
+
+
+/* string array for storing the individual column compression stats */
+char results[999][60];
+float trans_ratio[999];
+
+float *fits_rand_value = 0;
+
+int imcomp_write_nocompress_tile(fitsfile *outfptr, long row, int datatype,
+ void *tiledata, long tilelen, int nullcheck, void *nullflagval, int *status);
+int imcomp_convert_tile_tshort(fitsfile *outfptr, void *tiledata, long tilelen,
+ int nullcheck, void *nullflagval, int nullval, int zbitpix, double scale,
+ double zero, double actual_bzero, int *intlength, int *status);
+int imcomp_convert_tile_tushort(fitsfile *outfptr, void *tiledata, long tilelen,
+ int nullcheck, void *nullflagval, int nullval, int zbitpix, double scale,
+ double zero, int *intlength, int *status);
+int imcomp_convert_tile_tint(fitsfile *outfptr, void *tiledata, long tilelen,
+ int nullcheck, void *nullflagval, int nullval, int zbitpix, double scale,
+ double zero, int *intlength, int *status);
+int imcomp_convert_tile_tuint(fitsfile *outfptr, void *tiledata, long tilelen,
+ int nullcheck, void *nullflagval, int nullval, int zbitpix, double scale,
+ double zero, int *intlength, int *status);
+int imcomp_convert_tile_tbyte(fitsfile *outfptr, void *tiledata, long tilelen,
+ int nullcheck, void *nullflagval, int nullval, int zbitpix, double scale,
+ double zero, int *intlength, int *status);
+int imcomp_convert_tile_tsbyte(fitsfile *outfptr, void *tiledata, long tilelen,
+ int nullcheck, void *nullflagval, int nullval, int zbitpix, double scale,
+ double zero, int *intlength, int *status);
+int imcomp_convert_tile_tfloat(fitsfile *outfptr, long row, void *tiledata, long tilelen,
+ long tilenx, long tileny, int nullcheck, void *nullflagval, int nullval, int zbitpix,
+ double scale, double zero, int *intlength, int *flag, double *bscale, double *bzero,int *status);
+int imcomp_convert_tile_tdouble(fitsfile *outfptr, long row, void *tiledata, long tilelen,
+ long tilenx, long tileny, int nullcheck, void *nullflagval, int nullval, int zbitpix,
+ double scale, double zero, int *intlength, int *flag, double *bscale, double *bzero, int *status);
+
+static int unquantize_i1r4(long row,
+ unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status); /* IO - error status */
+static int unquantize_i2r4(long row,
+ short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status); /* IO - error status */
+static int unquantize_i4r4(long row,
+ INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status); /* IO - error status */
+static int unquantize_i1r8(long row,
+ unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status); /* IO - error status */
+static int unquantize_i2r8(long row,
+ short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status); /* IO - error status */
+static int unquantize_i4r8(long row,
+ INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status); /* IO - error status */
+static int imcomp_float2nan(float *indata, long tilelen, int *outdata,
+ float nullflagval, int *status);
+static int imcomp_double2nan(double *indata, long tilelen, LONGLONG *outdata,
+ double nullflagval, int *status);
+static int fits_read_write_compressed_img(fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the array to be returned */
+ LONGLONG *infpixel, /* I - 'bottom left corner' of the subsection */
+ LONGLONG *inlpixel, /* I - 'top right corner' of the subsection */
+ long *ininc, /* I - increment to be applied in each dimension */
+ int nullcheck, /* I - 0 for no null checking */
+ /* 1: set undefined pixels = nullval */
+ void *nullval, /* I - value for undefined pixels */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ fitsfile *outfptr, /* I - FITS file pointer */
+ int *status);
+
+static int fits_shuffle_8bytes(char *heap, LONGLONG length, int *status);
+static int fits_shuffle_4bytes(char *heap, LONGLONG length, int *status);
+static int fits_shuffle_2bytes(char *heap, LONGLONG length, int *status);
+static int fits_gzip_heap(fitsfile *infptr, fitsfile *outfptr, int *status);
+static int fits_unshuffle_8bytes(char *heap, LONGLONG length, int *status);
+static int fits_unshuffle_4bytes(char *heap, LONGLONG length, int *status);
+static int fits_unshuffle_2bytes(char *heap, LONGLONG length, int *status);
+static int fits_gunzip_heap(fitsfile *infptr, fitsfile *outfptr, int *status);
+
+/*---------------------------------------------------------------------------*/
+int fits_init_randoms(void) {
+
+/* initialize an array of random numbers */
+
+ int ii;
+ double a = 16807.0;
+ double m = 2147483647.0;
+ double temp, seed;
+
+ FFLOCK;
+
+ if (fits_rand_value) {
+ FFUNLOCK;
+ return(0); /* array is already initialized */
+ }
+
+ /* allocate array for the random number sequence */
+ /* THIS MEMORY IS NEVER FREED */
+ fits_rand_value = calloc(N_RANDOM, sizeof(float));
+
+ if (!fits_rand_value) {
+ FFUNLOCK;
+ return(MEMORY_ALLOCATION);
+ }
+
+ /* We need a portable algorithm that anyone can use to generate this
+ exact same sequence of random number. The C 'rand' function is not
+ suitable because it is not available to Fortran or Java programmers.
+ Instead, use a well known simple algorithm published here:
+ "Random number generators: good ones are hard to find", Communications of the ACM,
+ Volume 31 , Issue 10 (October 1988) Pages: 1192 - 1201
+ */
+
+ /* initialize the random numbers */
+ seed = 1;
+ for (ii = 0; ii < N_RANDOM; ii++) {
+ temp = a * seed;
+ seed = temp -m * ((int) (temp / m) );
+ fits_rand_value[ii] = (float) (seed / m);
+ }
+
+ FFUNLOCK;
+
+ /*
+ IMPORTANT NOTE: the 10000th seed value must have the value 1043618065 if the
+ algorithm has been implemented correctly */
+
+ if ( (int) seed != 1043618065) {
+ ffpmsg("fits_init_randoms generated incorrect random number sequence");
+ return(1);
+ } else {
+ return(0);
+ }
+}
+/*--------------------------------------------------------------------------*/
+void bz_internal_error(int errcode)
+{
+ /* external function declared by the bzip2 code in bzlib_private.h */
+ ffpmsg("bzip2 returned an internal error");
+ ffpmsg("This should never happen");
+ return;
+}
+/*--------------------------------------------------------------------------*/
+int fits_set_compression_type(fitsfile *fptr, /* I - FITS file pointer */
+ int ctype, /* image compression type code; */
+ /* allowed values: RICE_1, GZIP_1, GZIP_2, PLIO_1, */
+ /* HCOMPRESS_1, BZIP2_1, and NOCOMPRESS */
+ int *status) /* IO - error status */
+{
+/*
+ This routine specifies the image compression algorithm that should be
+ used when writing a FITS image. The image is divided into tiles, and
+ each tile is compressed and stored in a row of at variable length binary
+ table column.
+*/
+ (fptr->Fptr)->request_compress_type = ctype;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_set_tile_dim(fitsfile *fptr, /* I - FITS file pointer */
+ int ndim, /* number of dimensions in the compressed image */
+ long *dims, /* size of image compression tile in each dimension */
+ /* default tile size = (NAXIS1, 1, 1, ...) */
+ int *status) /* IO - error status */
+{
+/*
+ This routine specifies the size (dimension) of the image
+ compression tiles that should be used when writing a FITS
+ image. The image is divided into tiles, and each tile is compressed
+ and stored in a row of at variable length binary table column.
+*/
+ int ii;
+
+ if (ndim < 0 || ndim > MAX_COMPRESS_DIM)
+ {
+ *status = BAD_DIMEN;
+ return(*status);
+ }
+
+ for (ii = 0; ii < ndim; ii++)
+ {
+ (fptr->Fptr)->request_tilesize[ii] = dims[ii];
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_set_quantize_level(fitsfile *fptr, /* I - FITS file pointer */
+ float qlevel, /* floating point quantization level */
+ int *status) /* IO - error status */
+{
+/*
+ This routine specifies the value of the quantization level, q, that
+ should be used when compressing floating point images. The image is
+ divided into tiles, and each tile is compressed and stored in a row
+ of at variable length binary table column.
+*/
+ if (qlevel == 0.)
+ {
+ /* this means don't quantize the floating point values. Instead, */
+ /* the floating point values will be losslessly compressed */
+ (fptr->Fptr)->quantize_level = NO_QUANTIZE;
+ } else {
+
+ (fptr->Fptr)->quantize_level = qlevel;
+
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_set_quantize_dither(fitsfile *fptr, /* I - FITS file pointer */
+ int dither, /* dither type */
+ int *status) /* IO - error status */
+{
+/*
+ This routine specifies what type of dithering (randomization) should
+ be performed when quantizing floating point images to integer prior to
+ compression. A value of -1 means do no dithering. A value of 0 means
+ used the default SUBTRACTIVE_DITHER_1 (which is equivalent to dither = 1).
+ A value of -1 means do not apply any dither.
+*/
+
+ if (dither == 0) dither = 1;
+ (fptr->Fptr)->request_quantize_dither = dither;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_set_dither_offset(fitsfile *fptr, /* I - FITS file pointer */
+ int offset, /* random dithering offset value (1 to 10000) */
+ int *status) /* IO - error status */
+{
+/*
+ This routine specifies the value of the offset that should be applied when
+ calculating the random dithering when quantizing floating point iamges.
+ A random offset should be applied to each image to avoid quantization
+ effects when taking the difference of 2 images, or co-adding a set of
+ images. Without this random offset, the corresponding pixel in every image
+ will have exactly the same dithering.
+
+ offset = 0 means use the default random dithering based on system time
+ offset = negative means randomly chose dithering based on 1st tile checksum
+ offset = [1 - 10000] means use that particular dithering pattern
+
+*/
+ /* if positive, ensure that the value is in the range 1 to 10000 */
+ if (offset > 0)
+ (fptr->Fptr)->request_dither_offset = ((offset - 1) % 10000 ) + 1;
+ else
+ (fptr->Fptr)->request_dither_offset = offset;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_set_noise_bits(fitsfile *fptr, /* I - FITS file pointer */
+ int noisebits, /* noise_bits parameter value */
+ /* (default = 4) */
+ int *status) /* IO - error status */
+{
+/*
+ ********************************************************************
+ ********************************************************************
+ THIS ROUTINE IS PROVIDED ONLY FOR BACKWARDS COMPATIBILITY;
+ ALL NEW SOFTWARE SHOULD CALL fits_set_quantize_level INSTEAD
+ ********************************************************************
+ ********************************************************************
+
+ This routine specifies the value of the noice_bits parameter that
+ should be used when compressing floating point images. The image is
+ divided into tiles, and each tile is compressed and stored in a row
+ of at variable length binary table column.
+
+ Feb 2008: the "noisebits" parameter has been replaced with the more
+ general "quantize level" parameter.
+*/
+ float qlevel;
+
+ if (noisebits < 1 || noisebits > 16)
+ {
+ *status = DATA_COMPRESSION_ERR;
+ return(*status);
+ }
+
+ qlevel = (float) pow (2., (double)noisebits);
+ fits_set_quantize_level(fptr, qlevel, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_set_hcomp_scale(fitsfile *fptr, /* I - FITS file pointer */
+ float scale, /* hcompress scale parameter value */
+ /* (default = 0.) */
+ int *status) /* IO - error status */
+{
+/*
+ This routine specifies the value of the hcompress scale parameter that
+ The image is
+ divided into tiles, and each tile is compressed and stored in a row
+ of at variable length binary table column.
+*/
+ (fptr->Fptr)->request_hcomp_scale = scale;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_set_hcomp_smooth(fitsfile *fptr, /* I - FITS file pointer */
+ int smooth, /* hcompress smooth parameter value */
+ /* if scale > 1 and smooth != 0, then */
+ /* the image will be smoothed when it is */
+ /* decompressed to remove some of the */
+ /* 'blockiness' in the image produced */
+ /* by the lossy compression */
+ int *status) /* IO - error status */
+{
+/*
+ This routine specifies the value of the hcompress scale parameter that
+ The image is
+ divided into tiles, and each tile is compressed and stored in a row
+ of at variable length binary table column.
+*/
+
+ (fptr->Fptr)->request_hcomp_smooth = smooth;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_set_lossy_int(fitsfile *fptr, /* I - FITS file pointer */
+ int lossy_int, /* I - True (!= 0) or False (0) */
+ int *status) /* IO - error status */
+{
+/*
+ This routine specifies whether images with integer pixel values should
+ quantized and compressed the same way float images are compressed.
+ The default is to not do this, and instead apply a lossless compression
+ algorithm to integer images.
+*/
+
+ (fptr->Fptr)->request_lossy_int_compress = lossy_int;
+ return(*status);
+}/*--------------------------------------------------------------------------*/
+int fits_get_compression_type(fitsfile *fptr, /* I - FITS file pointer */
+ int *ctype, /* image compression type code; */
+ /* allowed values: */
+ /* RICE_1, GZIP_1, GZIP_2, PLIO_1, HCOMPRESS_1, BZIP2_1 */
+ int *status) /* IO - error status */
+{
+/*
+ This routine returns the image compression algorithm that should be
+ used when writing a FITS image. The image is divided into tiles, and
+ each tile is compressed and stored in a row of at variable length binary
+ table column.
+*/
+ *ctype = (fptr->Fptr)->request_compress_type;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_get_tile_dim(fitsfile *fptr, /* I - FITS file pointer */
+ int ndim, /* number of dimensions in the compressed image */
+ long *dims, /* size of image compression tile in each dimension */
+ /* default tile size = (NAXIS1, 1, 1, ...) */
+ int *status) /* IO - error status */
+{
+/*
+ This routine returns the size (dimension) of the image
+ compression tiles that should be used when writing a FITS
+ image. The image is divided into tiles, and each tile is compressed
+ and stored in a row of at variable length binary table column.
+*/
+ int ii;
+
+ if (ndim < 0 || ndim > MAX_COMPRESS_DIM)
+ {
+ *status = BAD_DIMEN;
+ return(*status);
+ }
+
+ for (ii = 0; ii < ndim; ii++)
+ {
+ dims[ii] = (fptr->Fptr)->request_tilesize[ii];
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_get_noise_bits(fitsfile *fptr, /* I - FITS file pointer */
+ int *noisebits, /* noise_bits parameter value */
+ /* (default = 4) */
+ int *status) /* IO - error status */
+{
+/*
+ ********************************************************************
+ ********************************************************************
+ THIS ROUTINE IS PROVIDED ONLY FOR BACKWARDS COMPATIBILITY;
+ ALL NEW SOFTWARE SHOULD CALL fits_set_quantize_level INSTEAD
+ ********************************************************************
+ ********************************************************************
+
+
+ This routine returns the value of the noice_bits parameter that
+ should be used when compressing floating point images. The image is
+ divided into tiles, and each tile is compressed and stored in a row
+ of at variable length binary table column.
+
+ Feb 2008: code changed to use the more general "quantize level" parameter
+ rather than the "noise bits" parameter. If quantize level is greater than
+ zero, then the previous noisebits parameter is approximately given by
+
+ noise bits = natural logarithm (quantize level) / natural log (2)
+
+ This result is rounded to the nearest integer.
+*/
+ double qlevel;
+
+ qlevel = (fptr->Fptr)->quantize_level;
+
+ if (qlevel > 0. && qlevel < 65537. )
+ *noisebits = (int) ((log(qlevel) / log(2.0)) + 0.5);
+ else
+ *noisebits = 0;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_get_quantize_level(fitsfile *fptr, /* I - FITS file pointer */
+ float *qlevel, /* quantize level parameter value */
+ int *status) /* IO - error status */
+{
+/*
+ This routine returns the value of the noice_bits parameter that
+ should be used when compressing floating point images. The image is
+ divided into tiles, and each tile is compressed and stored in a row
+ of at variable length binary table column.
+*/
+
+ if ((fptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ *qlevel = 0;
+ } else {
+ *qlevel = (fptr->Fptr)->quantize_level;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_get_dither_offset(fitsfile *fptr, /* I - FITS file pointer */
+ int *offset, /* dithering offset parameter value */
+ int *status) /* IO - error status */
+{
+/*
+ This routine returns the value of the dithering offset parameter that
+ is used when compressing floating point images. The image is
+ divided into tiles, and each tile is compressed and stored in a row
+ of at variable length binary table column.
+*/
+
+ *offset = (fptr->Fptr)->request_dither_offset;
+ return(*status);
+}/*--------------------------------------------------------------------------*/
+int fits_get_hcomp_scale(fitsfile *fptr, /* I - FITS file pointer */
+ float *scale, /* Hcompress scale parameter value */
+ int *status) /* IO - error status */
+
+{
+/*
+ This routine returns the value of the noice_bits parameter that
+ should be used when compressing floating point images. The image is
+ divided into tiles, and each tile is compressed and stored in a row
+ of at variable length binary table column.
+*/
+
+ *scale = (fptr->Fptr)->request_hcomp_scale;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_get_hcomp_smooth(fitsfile *fptr, /* I - FITS file pointer */
+ int *smooth, /* Hcompress smooth parameter value */
+ int *status) /* IO - error status */
+
+{
+ *smooth = (fptr->Fptr)->request_hcomp_smooth;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_img_compress(fitsfile *infptr, /* pointer to image to be compressed */
+ fitsfile *outfptr, /* empty HDU for output compressed image */
+ int *status) /* IO - error status */
+
+/*
+ This routine initializes the output table, copies all the keywords,
+ and loops through the input image, compressing the data and
+ writing the compressed tiles to the output table.
+
+ This is a high level routine that is called by the fpack and funpack
+ FITS compression utilities.
+*/
+{
+ int bitpix, naxis;
+ long naxes[MAX_COMPRESS_DIM];
+
+ if (*status > 0)
+ return(*status);
+
+ /* get datatype and size of input image */
+ if (fits_get_img_param(infptr, MAX_COMPRESS_DIM, &bitpix,
+ &naxis, naxes, status) > 0)
+ return(*status);
+
+ if (naxis < 1 || naxis > MAX_COMPRESS_DIM)
+ {
+ ffpmsg("Image cannot be compressed: NAXIS out of range");
+ return(*status = BAD_NAXIS);
+ }
+
+ /* if requested, treat integer images same as a float image. */
+ /* Then the pixels will be quantized (lossy algorithm) to achieve */
+ /* higher amounts of compression than with lossless algorithms */
+
+ if ( (outfptr->Fptr)->request_lossy_int_compress != 0 && bitpix > 0)
+ bitpix = FLOAT_IMG; /* compress integer images as if float */
+
+ /* initialize output table */
+ if (imcomp_init_table(outfptr, bitpix, naxis, naxes, 0, status) > 0)
+ return (*status);
+
+ /* Copy the image header keywords to the table header. */
+ if (imcomp_copy_img2comp(infptr, outfptr, status) > 0)
+ return (*status);
+
+ /* turn off any intensity scaling (defined by BSCALE and BZERO */
+ /* keywords) so that unscaled values will be read by CFITSIO */
+ /* (except if quantizing an int image, same as a float image) */
+ if ( (outfptr->Fptr)->request_lossy_int_compress == 0 && bitpix > 0)
+ ffpscl(infptr, 1.0, 0.0, status);
+
+ /* force a rescan of the output file keywords, so that */
+ /* the compression parameters will be copied to the internal */
+ /* fitsfile structure used by CFITSIO */
+ ffrdef(outfptr, status);
+
+ /* turn off any intensity scaling (defined by BSCALE and BZERO */
+ /* keywords) so that unscaled values will be written by CFITSIO */
+ /* (except if quantizing an int image, same as a float image) */
+ if ( (outfptr->Fptr)->request_lossy_int_compress == 0 && bitpix > 0)
+ ffpscl(outfptr, 1.0, 0.0, status);
+
+ /* Read each image tile, compress, and write to a table row. */
+ imcomp_compress_image (infptr, outfptr, status);
+
+ /* force another rescan of the output file keywords, to */
+ /* update PCOUNT and TFORMn = '1PB(iii)' keyword values. */
+ ffrdef(outfptr, status);
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_compress_img_OBSOLETE(fitsfile *infptr, /* pointer to image to be compressed */
+ fitsfile *outfptr, /* empty HDU for output compressed image */
+ int compress_type, /* compression type code */
+ /* RICE_1, HCOMPRESS_1, etc. */
+ long *intilesize, /* size in each dimension of the tiles */
+ /* NULL pointer means tile by rows */
+ int blocksize, /* compression parameter: blocksize */
+ int nbits, /* compression parameter: nbits */
+ int *status) /* IO - error status */
+
+/*
+ !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!!
+ This routine is obsolete and should not be used. The
+ ftools 'fimgzip' task used to call this routine (but that task has been deleted);
+
+ The name of the routine was changed 4/27/2011, to see if anyone complains.
+ If not, then this routine should be deleted from the source code.
+ !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!! !!!
+
+ This routine initializes the output table, copies all the keywords,
+ and loops through the input image, compressing the data and
+ writing the compressed tiles to the output table.
+*/
+{
+ int bitpix, naxis;
+ long naxes[MAX_COMPRESS_DIM];
+
+ if (*status > 0)
+ return(*status);
+
+ /* get datatype and size of input image */
+ if (fits_get_img_param(infptr, MAX_COMPRESS_DIM, &bitpix,
+ &naxis, naxes, status) > 0)
+ return(*status);
+
+ if (naxis < 1 || naxis > MAX_COMPRESS_DIM)
+ {
+ ffpmsg("Image cannot be compressed: NAXIS out of range");
+ return(*status = BAD_NAXIS);
+ }
+
+ /* initialize output table */
+ if (imcomp_init_table(outfptr, bitpix, naxis, naxes, 0, status) > 0)
+ return (*status);
+
+ /* Copy the image header keywords to the table header. */
+ if (imcomp_copy_imheader(infptr, outfptr, status) > 0)
+ return (*status);
+
+ /* turn off any intensity scaling (defined by BSCALE and BZERO */
+ /* keywords) so that unscaled values will be read by CFITSIO */
+ ffpscl(infptr, 1.0, 0.0, status);
+
+ /* force a rescan of the output file keywords, so that */
+ /* the compression parameters will be copied to the internal */
+ /* fitsfile structure used by CFITSIO */
+ ffrdef(outfptr, status);
+
+ /* Read each image tile, compress, and write to a table row. */
+ imcomp_compress_image (infptr, outfptr, status);
+
+ /* force another rescan of the output file keywords, to */
+ /* update PCOUNT and TFORMn = '1PB(iii)' keyword values. */
+ ffrdef(outfptr, status);
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_init_table(fitsfile *outfptr,
+ int inbitpix,
+ int naxis,
+ long *naxes,
+ int writebitpix, /* write the ZBITPIX, ZNAXIS, and ZNAXES keyword? */
+ int *status)
+/*
+ create a BINTABLE extension for the output compressed image.
+*/
+{
+ char keyname[FLEN_KEYWORD], zcmptype[12];
+ int ii, remain, ncols, bitpix;
+ long nrows;
+ char *ttype[] = {"COMPRESSED_DATA", "ZSCALE", "ZZERO"};
+ char *tform[3];
+ char tf0[4], tf1[4], tf2[4];
+ char *tunit[] = {"\0", "\0", "\0" };
+ char comm[FLEN_COMMENT];
+ long actual_tilesize[MAX_COMPRESS_DIM]; /* Actual size to use for tiles */
+
+ if (*status > 0)
+ return(*status);
+
+ /* check for special case of losslessly compressing floating point */
+ /* images. Only compression algorithm that supports this is GZIP */
+ if ( (outfptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ if (((outfptr->Fptr)->request_compress_type != GZIP_1) &&
+ ((outfptr->Fptr)->request_compress_type != GZIP_2)) {
+ ffpmsg("Lossless compression of floating point images must use GZIP (imcomp_init_table)");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+ }
+
+ /* test for the 2 special cases that represent unsigned integers */
+ if (inbitpix == USHORT_IMG)
+ bitpix = SHORT_IMG;
+ else if (inbitpix == ULONG_IMG)
+ bitpix = LONG_IMG;
+ else if (inbitpix == SBYTE_IMG)
+ bitpix = BYTE_IMG;
+ else
+ bitpix = inbitpix;
+
+ /* reset default tile dimensions too if required */
+ memcpy(actual_tilesize, outfptr->Fptr->request_tilesize, MAX_COMPRESS_DIM * sizeof(long));
+
+ if ((outfptr->Fptr)->request_compress_type == HCOMPRESS_1) {
+
+ if (naxis < 2 ) {
+ ffpmsg("Hcompress cannot be used with 1-dimensional images (imcomp_init_table)");
+ return(*status = DATA_COMPRESSION_ERR);
+
+ } else if (naxes[0] < 4 || naxes[1] < 4) {
+ ffpmsg("Hcompress minimum image dimension is 4 pixels (imcomp_init_table)");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ if ((actual_tilesize[0] == 0) &&
+ (actual_tilesize[1] == 0) ){
+
+ /* compress the whole image as a single tile */
+ actual_tilesize[0] = naxes[0];
+ actual_tilesize[1] = naxes[1];
+
+ for (ii = 2; ii < naxis; ii++) {
+ /* set all higher tile dimensions = 1 */
+ actual_tilesize[ii] = 1;
+ }
+
+ } else if ((actual_tilesize[0] == 0) &&
+ (actual_tilesize[1] == 1) ){
+
+ /*
+ The Hcompress algorithm is inherently 2D in nature, so the row by row
+ tiling that is used for other compression algorithms is not appropriate.
+ If the image has less than 30 rows, then the entire image will be compressed
+ as a single tile. Otherwise the tiles will consist of 16 rows of the image.
+ This keeps the tiles to a reasonable size, and it also includes enough rows
+ to allow good compression efficiency. If the last tile of the image
+ happens to contain less than 4 rows, then find another tile size with
+ between 14 and 30 rows (preferably even), so that the last tile has
+ at least 4 rows
+ */
+
+ /* 1st tile dimension is the row length of the image */
+ actual_tilesize[0] = naxes[0];
+
+ if (naxes[1] <= 30) { /* use whole image if it is small */
+ actual_tilesize[1] = naxes[1];
+ } else {
+ /* look for another good tile dimension */
+ if (naxes[1] % 16 == 0 || naxes[1] % 16 > 3) {
+ actual_tilesize[1] = 16;
+ } else if (naxes[1] % 24 == 0 || naxes[1] % 24 > 3) {
+ actual_tilesize[1] = 24;
+ } else if (naxes[1] % 20 == 0 || naxes[1] % 20 > 3) {
+ actual_tilesize[1] = 20;
+ } else if (naxes[1] % 30 == 0 || naxes[1] % 30 > 3) {
+ actual_tilesize[1] = 30;
+ } else if (naxes[1] % 28 == 0 || naxes[1] % 28 > 3) {
+ actual_tilesize[1] = 28;
+ } else if (naxes[1] % 26 == 0 || naxes[1] % 26 > 3) {
+ actual_tilesize[1] = 26;
+ } else if (naxes[1] % 22 == 0 || naxes[1] % 22 > 3) {
+ actual_tilesize[1] = 22;
+ } else if (naxes[1] % 18 == 0 || naxes[1] % 18 > 3) {
+ actual_tilesize[1] = 18;
+ } else if (naxes[1] % 14 == 0 || naxes[1] % 14 > 3) {
+ actual_tilesize[1] = 14;
+ } else {
+ actual_tilesize[1] = 17;
+
+ }
+ }
+
+ } else if (actual_tilesize[0] < 4 ||
+ actual_tilesize[1] < 4) {
+
+ /* user-specified tile size is too small */
+ ffpmsg("Hcompress minimum tile dimension is 4 pixels (imcomp_init_table)");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ /* check if requested tile size causes the last tile to to have less than 4 pixels */
+ remain = naxes[0] % (actual_tilesize[0]); /* 1st dimension */
+ if (remain > 0 && remain < 4) {
+ (actual_tilesize[0])++; /* try increasing tile size by 1 */
+
+ remain = naxes[0] % (actual_tilesize[0]);
+ if (remain > 0 && remain < 4) {
+ ffpmsg("Last tile along 1st dimension has less than 4 pixels (imcomp_init_table)");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+ }
+
+ remain = naxes[1] % (actual_tilesize[1]); /* 2nd dimension */
+ if (remain > 0 && remain < 4) {
+ (actual_tilesize[1])++; /* try increasing tile size by 1 */
+
+ remain = naxes[1] % (actual_tilesize[1]);
+ if (remain > 0 && remain < 4) {
+ ffpmsg("Last tile along 2nd dimension has less than 4 pixels (imcomp_init_table)");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+ }
+
+ } /* end, if HCOMPRESS_1 */
+
+ for (ii = 0; ii < naxis; ii++) {
+ if (actual_tilesize[ii] <= 0) {
+ /* tile size of 0 means use the image size of that dimension */
+ actual_tilesize[ii] = naxes[ii];
+ }
+ }
+
+ /* ---- set up array of TFORM strings -------------------------------*/
+ strcpy(tf0, "1PB");
+ strcpy(tf1, "1D");
+ strcpy(tf2, "1D");
+
+ tform[0] = tf0;
+ tform[1] = tf1;
+ tform[2] = tf2;
+
+ /* calculate number of rows in output table */
+ nrows = 1;
+ for (ii = 0; ii < naxis; ii++)
+ {
+ nrows = nrows * ((naxes[ii] - 1)/ (actual_tilesize[ii]) + 1);
+ }
+
+ /* determine the default number of columns in the output table */
+ if (bitpix < 0 && (outfptr->Fptr)->quantize_level != NO_QUANTIZE)
+ ncols = 3; /* quantized and scaled floating point image */
+ else
+ ncols = 1; /* default table has just one 'COMPRESSED_DATA' column */
+
+ if ((outfptr->Fptr)->request_compress_type == RICE_1)
+ {
+ strcpy(zcmptype, "RICE_1");
+ }
+ else if ((outfptr->Fptr)->request_compress_type == GZIP_1)
+ {
+ strcpy(zcmptype, "GZIP_1");
+ }
+ else if ((outfptr->Fptr)->request_compress_type == GZIP_2)
+ {
+ strcpy(zcmptype, "GZIP_2");
+ }
+ else if ((outfptr->Fptr)->request_compress_type == BZIP2_1)
+ {
+ strcpy(zcmptype, "BZIP2_1");
+ }
+ else if ((outfptr->Fptr)->request_compress_type == PLIO_1)
+ {
+ strcpy(zcmptype, "PLIO_1");
+ /* the PLIO compression algorithm outputs short integers, not bytes */
+ strcpy(tform[0], "1PI");
+ }
+ else if ((outfptr->Fptr)->request_compress_type == HCOMPRESS_1)
+ {
+ strcpy(zcmptype, "HCOMPRESS_1");
+ }
+ else if ((outfptr->Fptr)->request_compress_type == NOCOMPRESS)
+ {
+ strcpy(zcmptype, "NOCOMPRESS");
+ }
+ else
+ {
+ ffpmsg("unknown compression type (imcomp_init_table)");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ /* create the bintable extension to contain the compressed image */
+ ffcrtb(outfptr, BINARY_TBL, nrows, ncols, ttype,
+ tform, tunit, 0, status);
+
+ /* Add standard header keywords. */
+ ffpkyl (outfptr, "ZIMAGE", 1,
+ "extension contains compressed image", status);
+
+ if (writebitpix) {
+ /* write the keywords defining the datatype and dimensions of */
+ /* the uncompressed image. If not, these keywords will be */
+ /* copied later from the input uncompressed image */
+
+ ffpkyj (outfptr, "ZBITPIX", bitpix,
+ "data type of original image", status);
+ ffpkyj (outfptr, "ZNAXIS", naxis,
+ "dimension of original image", status);
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ sprintf (keyname, "ZNAXIS%d", ii+1);
+ ffpkyj (outfptr, keyname, naxes[ii],
+ "length of original image axis", status);
+ }
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ sprintf (keyname, "ZTILE%d", ii+1);
+ ffpkyj (outfptr, keyname, actual_tilesize[ii],
+ "size of tiles to be compressed", status);
+ }
+
+ if (bitpix < 0) {
+
+ if ((outfptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ ffpkys(outfptr, "ZQUANTIZ", "NONE",
+ "Lossless compression without quantization", status);
+ } else {
+
+ /* Unless dithering has been specifically turned off by setting */
+ /* request_quantize_dither = -1, use dithering by default */
+ /* when quantizing floating point images. */
+
+ if ( (outfptr->Fptr)->request_quantize_dither == 0)
+ (outfptr->Fptr)->request_quantize_dither = SUBTRACTIVE_DITHER_1;
+
+ if ((outfptr->Fptr)->request_quantize_dither == SUBTRACTIVE_DITHER_1) {
+ ffpkys(outfptr, "ZQUANTIZ", "SUBTRACTIVE_DITHER_1",
+ "Pixel Quantization Algorithm", status);
+
+ /* also write the associated ZDITHER0 keyword with a default value */
+ /* which may get updated later. */
+ ffpky(outfptr, TINT, "ZDITHER0", &((outfptr->Fptr)->request_dither_offset),
+ "dithering offset when quantizing floats", status);
+ }
+ }
+ }
+
+ ffpkys (outfptr, "ZCMPTYPE", zcmptype,
+ "compression algorithm", status);
+
+ /* write any algorithm-specific keywords */
+ if ((outfptr->Fptr)->request_compress_type == RICE_1)
+ {
+ ffpkys (outfptr, "ZNAME1", "BLOCKSIZE",
+ "compression block size", status);
+
+ /* for now at least, the block size is always 32 */
+ ffpkyj (outfptr, "ZVAL1", 32,
+ "pixels per block", status);
+
+ ffpkys (outfptr, "ZNAME2", "BYTEPIX",
+ "bytes per pixel (1, 2, 4, or 8)", status);
+
+ if (bitpix == BYTE_IMG)
+ ffpkyj (outfptr, "ZVAL2", 1,
+ "bytes per pixel (1, 2, 4, or 8)", status);
+ else if (bitpix == SHORT_IMG)
+ ffpkyj (outfptr, "ZVAL2", 2,
+ "bytes per pixel (1, 2, 4, or 8)", status);
+ else
+ ffpkyj (outfptr, "ZVAL2", 4,
+ "bytes per pixel (1, 2, 4, or 8)", status);
+
+ }
+ else if ((outfptr->Fptr)->request_compress_type == HCOMPRESS_1)
+ {
+ ffpkys (outfptr, "ZNAME1", "SCALE",
+ "HCOMPRESS scale factor", status);
+ ffpkye (outfptr, "ZVAL1", (outfptr->Fptr)->request_hcomp_scale,
+ 7, "HCOMPRESS scale factor", status);
+
+ ffpkys (outfptr, "ZNAME2", "SMOOTH",
+ "HCOMPRESS smooth option", status);
+ ffpkyj (outfptr, "ZVAL2", (long) (outfptr->Fptr)->request_hcomp_smooth,
+ "HCOMPRESS smooth option", status);
+ }
+
+ /* Write the BSCALE and BZERO keywords, if an unsigned integer image */
+ if (inbitpix == USHORT_IMG)
+ {
+ strcpy(comm, "offset data range to that of unsigned short");
+ ffpkyg(outfptr, "BZERO", 32768., 0, comm, status);
+ strcpy(comm, "default scaling factor");
+ ffpkyg(outfptr, "BSCALE", 1.0, 0, comm, status);
+ }
+ else if (inbitpix == SBYTE_IMG)
+ {
+ strcpy(comm, "offset data range to that of signed byte");
+ ffpkyg(outfptr, "BZERO", -128., 0, comm, status);
+ strcpy(comm, "default scaling factor");
+ ffpkyg(outfptr, "BSCALE", 1.0, 0, comm, status);
+ }
+ else if (inbitpix == ULONG_IMG)
+ {
+ strcpy(comm, "offset data range to that of unsigned long");
+ ffpkyg(outfptr, "BZERO", 2147483648., 0, comm, status);
+ strcpy(comm, "default scaling factor");
+ ffpkyg(outfptr, "BSCALE", 1.0, 0, comm, status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_calc_max_elem (int comptype, int nx, int zbitpix, int blocksize)
+
+/* This function returns the maximum number of bytes in a compressed
+ image line.
+
+ nx = maximum number of pixels in a tile
+ blocksize is only relevant for RICE compression
+*/
+{
+ if (comptype == RICE_1)
+ {
+ if (zbitpix == 16)
+ return (sizeof(short) * nx + nx / blocksize + 2 + 4);
+ else
+ return (sizeof(float) * nx + nx / blocksize + 2 + 4);
+ }
+ else if ((comptype == GZIP_1) || (comptype == GZIP_2))
+ {
+ /* gzip usually compressed by at least a factor of 2 for I*4 images */
+ /* and somewhat less for I*2 images */
+ /* If this size turns out to be too small, then the gzip */
+ /* compression routine will allocate more space as required */
+ /* to be on the safe size, allocate buffer same size as input */
+
+ if (zbitpix == 16)
+ return(nx * 2);
+ else if (zbitpix == 8)
+ return(nx);
+ else
+ return(nx * 4);
+ }
+ else if (comptype == BZIP2_1)
+ {
+ /* To guarantee that the compressed data will fit, allocate an output
+ buffer of size 1% larger than the uncompressed data, plus 600 bytes */
+
+ return((int) (nx * 1.01 * zbitpix / 8. + 601.));
+ }
+ else if (comptype == HCOMPRESS_1)
+ {
+ /* Imperical evidence suggests in the worst case,
+ the compressed stream could be up to 10% larger than the original
+ image. Add 26 byte overhead, only significant for very small tiles
+
+ Possible improvement: may need to allow a larger size for 32-bit images */
+
+ if (zbitpix == 16 || zbitpix == 8)
+
+ return( (int) (nx * 2.2 + 26)); /* will be compressing 16-bit int array */
+ else
+ return( (int) (nx * 4.4 + 26)); /* will be compressing 32-bit int array */
+ }
+ else
+ return(nx * sizeof(int));
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_compress_image (fitsfile *infptr, fitsfile *outfptr, int *status)
+
+/* This routine does the following:
+ - reads an image one tile at a time
+ - if it is a float or double image, then it tries to quantize the pixels
+ into scaled integers.
+ - it then compressess the integer pixels, or if the it was not
+ possible to quantize the floating point pixels, then it losslessly
+ compresses them with gzip
+ - writes the compressed byte stream to the output FITS file
+*/
+{
+ double *tiledata;
+ int anynul, gotnulls = 0, datatype;
+ long ii, row;
+ int naxis;
+ double dummy = 0., dblnull = DOUBLENULLVALUE;
+ float fltnull = FLOATNULLVALUE;
+ long maxtilelen, tilelen, incre[] = {1, 1, 1, 1, 1, 1};
+ long naxes[MAX_COMPRESS_DIM], fpixel[MAX_COMPRESS_DIM];
+ long lpixel[MAX_COMPRESS_DIM], tile[MAX_COMPRESS_DIM];
+ long tilesize[MAX_COMPRESS_DIM];
+ long i0, i1, i2, i3, i4, i5;
+ char card[FLEN_CARD];
+
+ if (*status > 0)
+ return(*status);
+
+ maxtilelen = (outfptr->Fptr)->maxtilelen;
+
+ /*
+ Allocate buffer to hold 1 tile of data; size depends on which compression
+ algorithm is used:
+
+ Rice and GZIP will compress byte, short, or int arrays without conversion.
+ PLIO requires 4-byte int values, so byte and short arrays must be converted to int.
+ HCompress internally converts byte or short values to ints, and
+ converts int values to 8-byte longlong integers.
+ */
+
+ if ((outfptr->Fptr)->zbitpix == FLOAT_IMG)
+ {
+ datatype = TFLOAT;
+
+ if ( (outfptr->Fptr)->compress_type == HCOMPRESS_1) {
+ /* need twice as much scratch space (8 bytes per pixel) */
+ tiledata = (double*) malloc (maxtilelen * 2 *sizeof (float));
+ } else {
+ tiledata = (double*) malloc (maxtilelen * sizeof (float));
+ }
+ }
+ else if ((outfptr->Fptr)->zbitpix == DOUBLE_IMG)
+ {
+ datatype = TDOUBLE;
+ tiledata = (double*) malloc (maxtilelen * sizeof (double));
+ }
+ else if ((outfptr->Fptr)->zbitpix == SHORT_IMG)
+ {
+ datatype = TSHORT;
+ if ( (outfptr->Fptr)->compress_type == RICE_1 ||
+ (outfptr->Fptr)->compress_type == GZIP_1 ||
+ (outfptr->Fptr)->compress_type == GZIP_2 ||
+ (outfptr->Fptr)->compress_type == BZIP2_1 ||
+ (outfptr->Fptr)->compress_type == NOCOMPRESS) {
+ /* only need buffer of I*2 pixels for gzip, bzip2, and Rice */
+
+ tiledata = (double*) malloc (maxtilelen * sizeof (short));
+ } else {
+ /* need buffer of I*4 pixels for Hcompress and PLIO */
+ tiledata = (double*) malloc (maxtilelen * sizeof (int));
+ }
+ }
+ else if ((outfptr->Fptr)->zbitpix == BYTE_IMG)
+ {
+
+ datatype = TBYTE;
+ if ( (outfptr->Fptr)->compress_type == RICE_1 ||
+ (outfptr->Fptr)->compress_type == BZIP2_1 ||
+ (outfptr->Fptr)->compress_type == GZIP_1 ||
+ (outfptr->Fptr)->compress_type == GZIP_2) {
+ /* only need buffer of I*1 pixels for gzip, bzip2, and Rice */
+
+ tiledata = (double*) malloc (maxtilelen);
+ } else {
+ /* need buffer of I*4 pixels for Hcompress and PLIO */
+ tiledata = (double*) malloc (maxtilelen * sizeof (int));
+ }
+ }
+ else if ((outfptr->Fptr)->zbitpix == LONG_IMG)
+ {
+ datatype = TINT;
+ if ( (outfptr->Fptr)->compress_type == HCOMPRESS_1) {
+ /* need twice as much scratch space (8 bytes per pixel) */
+
+ tiledata = (double*) malloc (maxtilelen * 2 * sizeof (int));
+ } else {
+ /* only need buffer of I*4 pixels for gzip, bzip2, Rice, and PLIO */
+
+ tiledata = (double*) malloc (maxtilelen * sizeof (int));
+ }
+ }
+ else
+ {
+ ffpmsg("Bad image datatype. (imcomp_compress_image)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ if (tiledata == NULL)
+ {
+ ffpmsg("Out of memory. (imcomp_compress_image)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* calculate size of tile in each dimension */
+ naxis = (outfptr->Fptr)->zndim;
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ if (ii < naxis)
+ {
+ naxes[ii] = (outfptr->Fptr)->znaxis[ii];
+ tilesize[ii] = (outfptr->Fptr)->tilesize[ii];
+ }
+ else
+ {
+ naxes[ii] = 1;
+ tilesize[ii] = 1;
+ }
+ }
+ row = 1;
+
+ /* set up big loop over up to 6 dimensions */
+ for (i5 = 1; i5 <= naxes[5]; i5 += tilesize[5])
+ {
+ fpixel[5] = i5;
+ lpixel[5] = minvalue(i5 + tilesize[5] - 1, naxes[5]);
+ tile[5] = lpixel[5] - fpixel[5] + 1;
+ for (i4 = 1; i4 <= naxes[4]; i4 += tilesize[4])
+ {
+ fpixel[4] = i4;
+ lpixel[4] = minvalue(i4 + tilesize[4] - 1, naxes[4]);
+ tile[4] = lpixel[4] - fpixel[4] + 1;
+ for (i3 = 1; i3 <= naxes[3]; i3 += tilesize[3])
+ {
+ fpixel[3] = i3;
+ lpixel[3] = minvalue(i3 + tilesize[3] - 1, naxes[3]);
+ tile[3] = lpixel[3] - fpixel[3] + 1;
+ for (i2 = 1; i2 <= naxes[2]; i2 += tilesize[2])
+ {
+ fpixel[2] = i2;
+ lpixel[2] = minvalue(i2 + tilesize[2] - 1, naxes[2]);
+ tile[2] = lpixel[2] - fpixel[2] + 1;
+ for (i1 = 1; i1 <= naxes[1]; i1 += tilesize[1])
+ {
+ fpixel[1] = i1;
+ lpixel[1] = minvalue(i1 + tilesize[1] - 1, naxes[1]);
+ tile[1] = lpixel[1] - fpixel[1] + 1;
+ for (i0 = 1; i0 <= naxes[0]; i0 += tilesize[0])
+ {
+ fpixel[0] = i0;
+ lpixel[0] = minvalue(i0 + tilesize[0] - 1, naxes[0]);
+ tile[0] = lpixel[0] - fpixel[0] + 1;
+
+ /* number of pixels in this tile */
+ tilelen = tile[0];
+ for (ii = 1; ii < naxis; ii++)
+ {
+ tilelen *= tile[ii];
+ }
+
+ /* read next tile of data from image */
+ anynul = 0;
+ if (datatype == TFLOAT)
+ {
+ ffgsve(infptr, 1, naxis, naxes, fpixel, lpixel, incre,
+ FLOATNULLVALUE, (float *) tiledata, &anynul, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffgsvd(infptr, 1, naxis, naxes, fpixel, lpixel, incre,
+ DOUBLENULLVALUE, tiledata, &anynul, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffgsvk(infptr, 1, naxis, naxes, fpixel, lpixel, incre,
+ 0, (int *) tiledata, &anynul, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffgsvi(infptr, 1, naxis, naxes, fpixel, lpixel, incre,
+ 0, (short *) tiledata, &anynul, status);
+ }
+ else if (datatype == TBYTE)
+ {
+ ffgsvb(infptr, 1, naxis, naxes, fpixel, lpixel, incre,
+ 0, (unsigned char *) tiledata, &anynul, status);
+ }
+ else
+ {
+ ffpmsg("Error bad datatype of image tile to compress");
+ free(tiledata);
+ return (*status);
+ }
+
+ /* now compress the tile, and write to row of binary table */
+ /* NOTE: we don't have to worry about the presence of null values in the
+ array if it is an integer array: the null value is simply encoded
+ in the compressed array just like any other pixel value.
+
+ If it is a floating point array, then we need to check for null
+ only if the anynul parameter returned a true value when reading the tile
+ */
+ if (anynul && datatype == TFLOAT) {
+ imcomp_compress_tile(outfptr, row, datatype, tiledata, tilelen,
+ tile[0], tile[1], 1, &fltnull, status);
+ } else if (anynul && datatype == TDOUBLE) {
+ imcomp_compress_tile(outfptr, row, datatype, tiledata, tilelen,
+ tile[0], tile[1], 1, &dblnull, status);
+ } else {
+ imcomp_compress_tile(outfptr, row, datatype, tiledata, tilelen,
+ tile[0], tile[1], 0, &dummy, status);
+ }
+
+ /* set flag if we found any null values */
+ if (anynul)
+ gotnulls = 1;
+
+ /* check for any error in the previous operations */
+ if (*status > 0)
+ {
+ ffpmsg("Error writing compressed image to table");
+ free(tiledata);
+ return (*status);
+ }
+
+ row++;
+ }
+ }
+ }
+ }
+ }
+ }
+
+ free (tiledata); /* finished with this buffer */
+
+ /* insert ZBLANK keyword if necessary; only for TFLOAT or TDOUBLE images */
+ if (gotnulls)
+ {
+ ffgcrd(outfptr, "ZCMPTYPE", card, status);
+ ffikyj(outfptr, "ZBLANK", COMPRESS_NULL_VALUE,
+ "null value in the compressed integer array", status);
+ }
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_compress_tile (fitsfile *outfptr,
+ long row, /* tile number = row in the binary table that holds the compressed data */
+ int datatype,
+ void *tiledata,
+ long tilelen,
+ long tilenx,
+ long tileny,
+ int nullcheck,
+ void *nullflagval,
+ int *status)
+
+/*
+ This is the main compression routine.
+
+ This routine does the following to the input tile of pixels:
+ - if it is a float or double image, then it quantizes the pixels
+ - compresses the integer pixel values
+ - writes the compressed byte stream to the FITS file.
+
+ If the tile cannot be quantized than the raw float or double values
+ are losslessly compressed with gzip and then written to the output table.
+
+ This input array may be modified by this routine. If the array is of type TINT
+ or TFLOAT, and the compression type is HCOMPRESS, then it must have been
+ allocated to be twice as large (8 bytes per pixel) to provide scratch space.
+
+ Note that this routine does not fully support the implicit datatype conversion that
+ is supported when writing to normal FITS images. The datatype of the input array
+ must have the same datatype (either signed or unsigned) as the output (compressed)
+ FITS image in some cases.
+*/
+{
+ int *idata; /* quantized integer data */
+ int cn_zblank, zbitpix, nullval;
+ int flag = 1; /* true by default; only = 0 if float data couldn't be quantized */
+ int intlength; /* size of integers to be compressed */
+ double scale, zero, actual_bzero;
+ long ii;
+ size_t clen; /* size of cbuf */
+ short *cbuf; /* compressed data */
+ int nelem = 0; /* number of bytes */
+ size_t gzip_nelem = 0;
+ unsigned int bzlen;
+ int ihcompscale;
+ float hcompscale;
+ double noise2, noise3, noise5;
+ double bscale[1] = {1.}, bzero[1] = {0.}; /* scaling parameters */
+ long hcomp_len;
+ LONGLONG *lldata;
+
+ if (*status > 0)
+ return(*status);
+
+ /* check for special case of losslessly compressing floating point */
+ /* images. Only compression algorithm that supports this is GZIP */
+ if ( (outfptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ if (((outfptr->Fptr)->compress_type != GZIP_1) &&
+ ((outfptr->Fptr)->compress_type != GZIP_2)) {
+ ffpmsg("Lossless compression of floating point images must use GZIP");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+ }
+
+ /* free the previously saved tile if the input tile is for the same row */
+ if ((outfptr->Fptr)->tilerow == row) {
+ if ((outfptr->Fptr)->tiledata) {
+ free((outfptr->Fptr)->tiledata);
+ }
+
+ if ((outfptr->Fptr)->tilenullarray) {
+ free((outfptr->Fptr)->tilenullarray);
+ }
+
+ (outfptr->Fptr)->tiledata = 0;
+ (outfptr->Fptr)->tilenullarray = 0;
+ (outfptr->Fptr)->tilerow = 0;
+ (outfptr->Fptr)->tiledatasize = 0;
+ (outfptr->Fptr)->tiletype = 0;
+ }
+
+ if ( (outfptr->Fptr)->compress_type == NOCOMPRESS) {
+ /* Special case when using NOCOMPRESS for diagnostic purposes in fpack */
+ if (imcomp_write_nocompress_tile(outfptr, row, datatype, tiledata, tilelen,
+ nullcheck, nullflagval, status) > 0) {
+ return(*status);
+ }
+ return(*status);
+ }
+
+ /* =========================================================================== */
+ /* initialize various parameters */
+ idata = (int *) tiledata; /* may overwrite the input tiledata in place */
+
+ /* zbitpix is the BITPIX keyword value in the uncompressed FITS image */
+ zbitpix = (outfptr->Fptr)->zbitpix;
+
+ /* if the tile/image has an integer datatype, see if a null value has */
+ /* been defined (with the BLANK keyword in a normal FITS image). */
+ /* If so, and if the input tile array also contains null pixels, */
+ /* (represented by pixels that have a value = nullflagval) then */
+ /* any pixels whose value = nullflagval, must be set to the value = nullval */
+ /* before the pixel array is compressed. These null pixel values must */
+ /* not be inverse scaled by the BSCALE/BZERO values, if present. */
+
+ cn_zblank = (outfptr->Fptr)->cn_zblank;
+ nullval = (outfptr->Fptr)->zblank;
+
+ if (zbitpix > 0 && cn_zblank != -1) /* If the integer image has no defined null */
+ nullcheck = 0; /* value, then don't bother checking input array for nulls. */
+
+ /* if the BSCALE and BZERO keywords exist, then the input values must */
+ /* be inverse scaled by this factor, before the values are compressed. */
+ /* (The program may have turned off scaling, which over rides the keywords) */
+
+ scale = (outfptr->Fptr)->cn_bscale;
+ zero = (outfptr->Fptr)->cn_bzero;
+ actual_bzero = (outfptr->Fptr)->cn_actual_bzero;
+
+ /* =========================================================================== */
+ /* prepare the tile of pixel values for compression */
+ if (datatype == TSHORT) {
+ imcomp_convert_tile_tshort(outfptr, tiledata, tilelen, nullcheck, nullflagval,
+ nullval, zbitpix, scale, zero, actual_bzero, &intlength, status);
+ } else if (datatype == TUSHORT) {
+ imcomp_convert_tile_tushort(outfptr, tiledata, tilelen, nullcheck, nullflagval,
+ nullval, zbitpix, scale, zero, &intlength, status);
+ } else if (datatype == TBYTE) {
+ imcomp_convert_tile_tbyte(outfptr, tiledata, tilelen, nullcheck, nullflagval,
+ nullval, zbitpix, scale, zero, &intlength, status);
+ } else if (datatype == TSBYTE) {
+ imcomp_convert_tile_tsbyte(outfptr, tiledata, tilelen, nullcheck, nullflagval,
+ nullval, zbitpix, scale, zero, &intlength, status);
+ } else if (datatype == TINT) {
+ imcomp_convert_tile_tint(outfptr, tiledata, tilelen, nullcheck, nullflagval,
+ nullval, zbitpix, scale, zero, &intlength, status);
+ } else if (datatype == TUINT) {
+ imcomp_convert_tile_tuint(outfptr, tiledata, tilelen, nullcheck, nullflagval,
+ nullval, zbitpix, scale, zero, &intlength, status);
+ } else if (datatype == TLONG && sizeof(long) == 8) {
+ ffpmsg("Integer*8 Long datatype is not supported when writing to compressed images");
+ return(*status = BAD_DATATYPE);
+ } else if (datatype == TULONG && sizeof(long) == 8) {
+ ffpmsg("Unsigned integer*8 datatype is not supported when writing to compressed images");
+ return(*status = BAD_DATATYPE);
+ } else if (datatype == TFLOAT) {
+ imcomp_convert_tile_tfloat(outfptr, row, tiledata, tilelen, tilenx, tileny, nullcheck,
+ nullflagval, nullval, zbitpix, scale, zero, &intlength, &flag, bscale, bzero, status);
+ } else if (datatype == TDOUBLE) {
+ imcomp_convert_tile_tdouble(outfptr, row, tiledata, tilelen, tilenx, tileny, nullcheck,
+ nullflagval, nullval, zbitpix, scale, zero, &intlength, &flag, bscale, bzero, status);
+ } else {
+ ffpmsg("unsupported image datatype (imcomp_compress_tile)");
+ return(*status = BAD_DATATYPE);
+ }
+
+ if (*status > 0)
+ return(*status); /* return if error occurs */
+
+ /* =========================================================================== */
+ if (flag) /* now compress the integer data array */
+ {
+ /* allocate buffer for the compressed tile bytes */
+ clen = (outfptr->Fptr)->maxelem;
+ cbuf = (short *) calloc (clen, sizeof (unsigned char));
+
+ if (cbuf == NULL) {
+ ffpmsg("Memory allocation failure. (imcomp_compress_tile)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* =========================================================================== */
+ if ( (outfptr->Fptr)->compress_type == RICE_1)
+ {
+ if (intlength == 2) {
+ nelem = fits_rcomp_short ((short *)idata, tilelen, (unsigned char *) cbuf,
+ clen, (outfptr->Fptr)->rice_blocksize);
+ } else if (intlength == 1) {
+ nelem = fits_rcomp_byte ((signed char *)idata, tilelen, (unsigned char *) cbuf,
+ clen, (outfptr->Fptr)->rice_blocksize);
+ } else {
+ nelem = fits_rcomp (idata, tilelen, (unsigned char *) cbuf,
+ clen, (outfptr->Fptr)->rice_blocksize);
+ }
+
+ if (nelem < 0) /* data compression error condition */
+ {
+ free (cbuf);
+ ffpmsg("error Rice compressing image tile (imcomp_compress_tile)");
+ return (*status = DATA_COMPRESSION_ERR);
+ }
+
+ /* Write the compressed byte stream. */
+ ffpclb(outfptr, (outfptr->Fptr)->cn_compressed, row, 1,
+ nelem, (unsigned char *) cbuf, status);
+ }
+
+ /* =========================================================================== */
+ else if ( (outfptr->Fptr)->compress_type == PLIO_1)
+ {
+ for (ii = 0; ii < tilelen; ii++) {
+ if (idata[ii] < 0 || idata[ii] > 16777215)
+ {
+ /* plio algorithn only supports positive 24 bit ints */
+ ffpmsg("data out of range for PLIO compression (0 - 2**24)");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+ }
+
+ nelem = pl_p2li (idata, 1, cbuf, tilelen);
+
+ if (nelem < 0) /* data compression error condition */
+ {
+ free (cbuf);
+ ffpmsg("error PLIO compressing image tile (imcomp_compress_tile)");
+ return (*status = DATA_COMPRESSION_ERR);
+ }
+
+ /* Write the compressed byte stream. */
+ ffpcli(outfptr, (outfptr->Fptr)->cn_compressed, row, 1,
+ nelem, cbuf, status);
+ }
+
+ /* =========================================================================== */
+ else if ( ((outfptr->Fptr)->compress_type == GZIP_1) ||
+ ((outfptr->Fptr)->compress_type == GZIP_2) ) {
+
+ if ((outfptr->Fptr)->quantize_level == NO_QUANTIZE && datatype == TFLOAT) {
+ /* Special case of losslessly compressing floating point pixels with GZIP */
+ /* In this case we compress the input tile array directly */
+
+#if BYTESWAPPED
+ ffswap4((int*) tiledata, tilelen);
+#endif
+ if ( (outfptr->Fptr)->compress_type == GZIP_2 )
+ fits_shuffle_4bytes((char *) tiledata, tilelen, status);
+
+ compress2mem_from_mem((char *) tiledata, tilelen * sizeof(float),
+ (char **) &cbuf, &clen, realloc, &gzip_nelem, status);
+
+ } else if ((outfptr->Fptr)->quantize_level == NO_QUANTIZE && datatype == TDOUBLE) {
+ /* Special case of losslessly compressing double pixels with GZIP */
+ /* In this case we compress the input tile array directly */
+
+#if BYTESWAPPED
+ ffswap8((double *) tiledata, tilelen);
+#endif
+ if ( (outfptr->Fptr)->compress_type == GZIP_2 )
+ fits_shuffle_8bytes((char *) tiledata, tilelen, status);
+
+ compress2mem_from_mem((char *) tiledata, tilelen * sizeof(double),
+ (char **) &cbuf, &clen, realloc, &gzip_nelem, status);
+
+ } else {
+
+ /* compress the integer idata array */
+
+#if BYTESWAPPED
+ if (intlength == 2)
+ ffswap2((short *) idata, tilelen);
+ else if (intlength == 4)
+ ffswap4(idata, tilelen);
+#endif
+
+ if (intlength == 2) {
+
+ if ( (outfptr->Fptr)->compress_type == GZIP_2 )
+ fits_shuffle_2bytes((char *) tiledata, tilelen, status);
+
+ compress2mem_from_mem((char *) idata, tilelen * sizeof(short),
+ (char **) &cbuf, &clen, realloc, &gzip_nelem, status);
+
+ } else if (intlength == 1) {
+
+ compress2mem_from_mem((char *) idata, tilelen * sizeof(unsigned char),
+ (char **) &cbuf, &clen, realloc, &gzip_nelem, status);
+
+ } else {
+
+ if ( (outfptr->Fptr)->compress_type == GZIP_2 )
+ fits_shuffle_4bytes((char *) tiledata, tilelen, status);
+
+ compress2mem_from_mem((char *) idata, tilelen * sizeof(int),
+ (char **) &cbuf, &clen, realloc, &gzip_nelem, status);
+ }
+ }
+
+ /* Write the compressed byte stream. */
+ ffpclb(outfptr, (outfptr->Fptr)->cn_compressed, row, 1,
+ gzip_nelem, (unsigned char *) cbuf, status);
+
+ /* =========================================================================== */
+ } else if ( (outfptr->Fptr)->compress_type == BZIP2_1) {
+
+#if BYTESWAPPED
+ if (intlength == 2)
+ ffswap2((short *) idata, tilelen);
+ else if (intlength == 4)
+ ffswap4(idata, tilelen);
+#endif
+
+ bzlen = (unsigned int) clen;
+
+ /* call bzip2 with blocksize = 900K, verbosity = 0, and default workfactor */
+
+/* bzip2 is not supported in the public release. This is only for test purposes.
+ if (BZ2_bzBuffToBuffCompress( (char *) cbuf, &bzlen,
+ (char *) idata, (unsigned int) (tilelen * intlength), 9, 0, 0) )
+*/
+ {
+ ffpmsg("bzip2 compression error");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ /* Write the compressed byte stream. */
+ ffpclb(outfptr, (outfptr->Fptr)->cn_compressed, row, 1,
+ bzlen, (unsigned char *) cbuf, status);
+
+ /* =========================================================================== */
+ } else if ( (outfptr->Fptr)->compress_type == HCOMPRESS_1) {
+ /*
+ if hcompscale is positive, then we have to multiply
+ the value by the RMS background noise to get the
+ absolute scale value. If negative, then it gives the
+ absolute scale value directly.
+ */
+ hcompscale = (outfptr->Fptr)->hcomp_scale;
+
+ if (hcompscale > 0.) {
+ fits_img_stats_int(idata, tilenx, tileny, nullcheck,
+ nullval, 0,0,0,0,0,0,&noise2,&noise3,&noise5,status);
+
+ /* use the minimum of the 3 noise estimates */
+ if (noise2 != 0. && noise2 < noise3) noise3 = noise2;
+ if (noise5 != 0. && noise5 < noise3) noise3 = noise5;
+
+ hcompscale = (float) (hcompscale * noise3);
+
+ } else if (hcompscale < 0.) {
+
+ hcompscale = hcompscale * -1.0F;
+ }
+
+ ihcompscale = (int) (hcompscale + 0.5);
+
+ hcomp_len = clen; /* allocated size of the buffer */
+
+ if (zbitpix == BYTE_IMG || zbitpix == SHORT_IMG) {
+ fits_hcompress(idata, tilenx, tileny,
+ ihcompscale, (char *) cbuf, &hcomp_len, status);
+
+ } else {
+ /* have to convert idata to an I*8 array, in place */
+ /* idata must have been allocated large enough to do this */
+ lldata = (LONGLONG *) idata;
+
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ lldata[ii] = idata[ii];
+ }
+
+ fits_hcompress64(lldata, tilenx, tileny,
+ ihcompscale, (char *) cbuf, &hcomp_len, status);
+ }
+
+ /* Write the compressed byte stream. */
+ ffpclb(outfptr, (outfptr->Fptr)->cn_compressed, row, 1,
+ hcomp_len, (unsigned char *) cbuf, status);
+ }
+
+ /* =========================================================================== */
+ if ((outfptr->Fptr)->cn_zscale > 0)
+ {
+ /* write the linear scaling parameters for this tile */
+ ffpcld (outfptr, (outfptr->Fptr)->cn_zscale, row, 1, 1,
+ bscale, status);
+ ffpcld (outfptr, (outfptr->Fptr)->cn_zzero, row, 1, 1,
+ bzero, status);
+ }
+
+ free(cbuf); /* finished with this buffer */
+
+ /* =========================================================================== */
+ } else { /* if flag == 0., floating point data couldn't be quantized */
+
+ /* losslessly compress the data with gzip. */
+
+ /* if gzip2 compressed data column doesn't exist, create it */
+ if ((outfptr->Fptr)->cn_gzip_data < 1) {
+ fits_insert_col(outfptr, 999, "GZIP_COMPRESSED_DATA", "1PB", status);
+
+ if (*status <= 0) /* save the number of this column */
+ ffgcno(outfptr, CASEINSEN, "GZIP_COMPRESSED_DATA",
+ &(outfptr->Fptr)->cn_gzip_data, status);
+ }
+
+ if (datatype == TFLOAT) {
+ /* allocate buffer for the compressed tile bytes */
+ /* make it 10% larger than the original uncompressed data */
+ clen = tilelen * sizeof(float) * 1.1;
+ cbuf = (short *) calloc (clen, sizeof (unsigned char));
+
+ if (cbuf == NULL)
+ {
+ ffpmsg("Memory allocation error. (imcomp_compress_tile)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* convert null values to NaNs in place, if necessary */
+ if (nullcheck == 1) {
+ imcomp_float2nan((float *) tiledata, tilelen, (int *) tiledata,
+ *(float *) (nullflagval), status);
+ }
+
+#if BYTESWAPPED
+ ffswap4((int*) tiledata, tilelen);
+#endif
+ compress2mem_from_mem((char *) tiledata, tilelen * sizeof(float),
+ (char **) &cbuf, &clen, realloc, &gzip_nelem, status);
+
+ } else if (datatype == TDOUBLE) {
+
+ /* allocate buffer for the compressed tile bytes */
+ /* make it 10% larger than the original uncompressed data */
+ clen = tilelen * sizeof(double) * 1.1;
+ cbuf = (short *) calloc (clen, sizeof (unsigned char));
+
+ if (cbuf == NULL)
+ {
+ ffpmsg("Memory allocation error. (imcomp_compress_tile)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* convert null values to NaNs in place, if necessary */
+ if (nullcheck == 1) {
+ imcomp_double2nan((double *) tiledata, tilelen, (LONGLONG *) tiledata,
+ *(double *) (nullflagval), status);
+ }
+
+#if BYTESWAPPED
+ ffswap8((double*) tiledata, tilelen);
+#endif
+ compress2mem_from_mem((char *) tiledata, tilelen * sizeof(double),
+ (char **) &cbuf, &clen, realloc, &gzip_nelem, status);
+ }
+
+ /* Write the compressed byte stream. */
+ ffpclb(outfptr, (outfptr->Fptr)->cn_gzip_data, row, 1,
+ gzip_nelem, (unsigned char *) cbuf, status);
+
+ free(cbuf); /* finished with this buffer */
+ }
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int imcomp_write_nocompress_tile(fitsfile *outfptr,
+ long row,
+ int datatype,
+ void *tiledata,
+ long tilelen,
+ int nullcheck,
+ void *nullflagval,
+ int *status)
+{
+ char coltype[4];
+
+ /* Write the uncompressed image tile pixels to the tile-compressed image file. */
+ /* This is a special case when using NOCOMPRESS for diagnostic purposes in fpack. */
+ /* Currently, this only supports a limited number of data types and */
+ /* does not fully support null-valued pixels in the image. */
+
+ if ((outfptr->Fptr)->cn_uncompressed < 1) {
+ /* uncompressed data column doesn't exist, so append new column to table */
+ if (datatype == TSHORT) {
+ strcpy(coltype, "1PI");
+ } else if (datatype == TINT) {
+ strcpy(coltype, "1PJ");
+ } else if (datatype == TFLOAT) {
+ strcpy(coltype, "1PE");
+ } else {
+ ffpmsg("NOCOMPRESSION option only supported for int*2, int*4, and float*4 images");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ fits_insert_col(outfptr, 999, "UNCOMPRESSED_DATA", coltype, status); /* create column */
+ }
+
+ fits_get_colnum(outfptr, CASEINSEN, "UNCOMPRESSED_DATA",
+ &(outfptr->Fptr)->cn_uncompressed, status); /* save col. num. */
+
+ fits_write_col(outfptr, datatype, (outfptr->Fptr)->cn_uncompressed, row, 1,
+ tilelen, tiledata, status); /* write the tile data */
+ return (*status);
+}
+ /*--------------------------------------------------------------------------*/
+int imcomp_convert_tile_tshort(
+ fitsfile *outfptr,
+ void *tiledata,
+ long tilelen,
+ int nullcheck,
+ void *nullflagval,
+ int nullval,
+ int zbitpix,
+ double scale,
+ double zero,
+ double actual_bzero,
+ int *intlength,
+ int *status)
+{
+ /* Prepare the input tile array of pixels for compression.
+ /* Convert input integer*2 tile array in place to 4 or 8-byte ints for compression, */
+ /* If needed, convert 4 or 8-byte ints and do null value substitution. */
+ /* Note that the calling routine must have allocated the input array big enough */
+ /* to be able to do this. */
+
+ short *sbuff;
+ int flagval, *idata;
+ long ii;
+
+ /* We only support writing this integer*2 tile data to a FITS image with
+ BITPIX = 16 and with BZERO = 0 and BSCALE = 1. */
+
+ if (zbitpix != SHORT_IMG || scale != 1.0 || zero != 0.0) {
+ ffpmsg("Datatype conversion/scaling is not supported when writing to compressed images");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ sbuff = (short *) tiledata;
+ idata = (int *) tiledata;
+
+ if ( (outfptr->Fptr)->compress_type == RICE_1 || (outfptr->Fptr)->compress_type == GZIP_1
+ || (outfptr->Fptr)->compress_type == GZIP_2 || (outfptr->Fptr)->compress_type == BZIP2_1 )
+ {
+ /* don't have to convert to int if using gzip, bzip2 or Rice compression */
+ *intlength = 2;
+
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to the FITS null value, prior to compression */
+ flagval = *(short *) (nullflagval);
+ if (flagval != nullval) {
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (sbuff[ii] == (short) flagval)
+ sbuff[ii] = (short) nullval;
+ }
+ }
+ }
+ } else if ((outfptr->Fptr)->compress_type == HCOMPRESS_1) {
+ /* have to convert to int if using HCOMPRESS */
+ *intlength = 4;
+
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to the FITS null value, prior to compression */
+ flagval = *(short *) (nullflagval);
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (sbuff[ii] == (short) flagval)
+ idata[ii] = nullval;
+ else
+ idata[ii] = (int) sbuff[ii];
+ }
+ } else { /* just do the data type conversion to int */
+ for (ii = tilelen - 1; ii >= 0; ii--)
+ idata[ii] = (int) sbuff[ii];
+ }
+ } else {
+ /* have to convert to int if using PLIO */
+ *intlength = 4;
+ if (zero == 0. && actual_bzero == 32768.) {
+ /* Here we are compressing unsigned 16-bit integers that have */
+ /* been offset by -32768 using the standard FITS convention. */
+ /* Since PLIO cannot deal with negative values, we must apply */
+ /* the shift of 32786 to the values to make them all positive. */
+ /* The inverse negative shift will be applied in */
+ /* imcomp_decompress_tile when reading the compressed tile. */
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to the FITS null value, prior to compression */
+ flagval = *(short *) (nullflagval);
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (sbuff[ii] == (short) flagval)
+ idata[ii] = nullval;
+ else
+ idata[ii] = (int) sbuff[ii] + 32768;
+ }
+ } else { /* just do the data type conversion to int */
+ for (ii = tilelen - 1; ii >= 0; ii--)
+ idata[ii] = (int) sbuff[ii] + 32768;
+ }
+ } else {
+ /* This is not an unsigned 16-bit integer array, so process normally */
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to the FITS null value, prior to compression */
+ flagval = *(short *) (nullflagval);
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (sbuff[ii] == (short) flagval)
+ idata[ii] = nullval;
+ else
+ idata[ii] = (int) sbuff[ii];
+ }
+ } else { /* just do the data type conversion to int */
+ for (ii = tilelen - 1; ii >= 0; ii--)
+ idata[ii] = (int) sbuff[ii];
+ }
+ }
+ }
+ return(*status);
+}
+ /*--------------------------------------------------------------------------*/
+int imcomp_convert_tile_tushort(
+ fitsfile *outfptr,
+ void *tiledata,
+ long tilelen,
+ int nullcheck,
+ void *nullflagval,
+ int nullval,
+ int zbitpix,
+ double scale,
+ double zero,
+ int *intlength,
+ int *status)
+{
+ /* Prepare the input tile array of pixels for compression.
+ /* Convert input integer*2 tile array in place to 4 or 8-byte ints for compression, */
+ /* If needed, convert 4 or 8-byte ints and do null value substitution. */
+ /* Note that the calling routine must have allocated the input array big enough */
+ /* to be able to do this. */
+
+ unsigned short *usbuff;
+ short *sbuff;
+ int flagval, *idata;
+ long ii;
+
+ /* datatype of input array is unsigned short. We only support writing this datatype
+ to a FITS image with BITPIX = 16 and with BZERO = 0 and BSCALE = 32768. */
+
+ if (zbitpix != SHORT_IMG || scale != 1.0 || zero != 32768.) {
+ ffpmsg("Implicit datatype conversion is not supported when writing to compressed images");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ usbuff = (unsigned short *) tiledata;
+ sbuff = (short *) tiledata;
+ idata = (int *) tiledata;
+
+ if ((outfptr->Fptr)->compress_type == RICE_1 || (outfptr->Fptr)->compress_type == GZIP_1
+ || (outfptr->Fptr)->compress_type == GZIP_2 || (outfptr->Fptr)->compress_type == BZIP2_1)
+ {
+ /* don't have to convert to int if using gzip, bzip2, or Rice compression */
+ *intlength = 2;
+
+ /* offset the unsigned value by -32768 to a signed short value. */
+ /* It is more efficient to do this by just flipping the most significant of the 16 bits */
+
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to the FITS null value, prior to compression */
+ flagval = *(unsigned short *) (nullflagval);
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (usbuff[ii] == (unsigned short) flagval)
+ sbuff[ii] = (short) nullval;
+ else
+ usbuff[ii] = (usbuff[ii]) ^ 0x8000;
+ }
+ } else {
+ /* just offset the pixel values by 32768 (by flipping the MSB */
+ for (ii = tilelen - 1; ii >= 0; ii--)
+ usbuff[ii] = (usbuff[ii]) ^ 0x8000;
+ }
+ } else {
+ /* have to convert to int if using HCOMPRESS or PLIO */
+ *intlength = 4;
+
+ if (nullcheck == 1) {
+ /* offset the pixel values by 32768, and */
+ /* reset pixels equal to flagval to nullval */
+ flagval = *(unsigned short *) (nullflagval);
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (usbuff[ii] == (unsigned short) flagval)
+ idata[ii] = nullval;
+ else
+ idata[ii] = ((int) usbuff[ii]) - 32768;
+ }
+ } else { /* just do the data type conversion to int */
+ for (ii = tilelen - 1; ii >= 0; ii--)
+ idata[ii] = ((int) usbuff[ii]) - 32768;
+ }
+ }
+
+ return(*status);
+}
+ /*--------------------------------------------------------------------------*/
+int imcomp_convert_tile_tint(
+ fitsfile *outfptr,
+ void *tiledata,
+ long tilelen,
+ int nullcheck,
+ void *nullflagval,
+ int nullval,
+ int zbitpix,
+ double scale,
+ double zero,
+ int *intlength,
+ int *status)
+{
+ /* Prepare the input tile array of pixels for compression.
+ /* Convert input integer*2 tile array in place to 4 or 8-byte ints for compression, */
+ /* If needed, convert 4 or 8-byte ints and do null value substitution. */
+ /* Note that the calling routine must have allocated the input array big enough */
+ /* to be able to do this. */
+
+ int flagval, *idata;
+ long ii;
+
+
+ /* datatype of input array is int. We only support writing this datatype
+ to a FITS image with BITPIX = 32 and with BZERO = 0 and BSCALE = 1. */
+
+ if (zbitpix != LONG_IMG || scale != 1.0 || zero != 0.) {
+ ffpmsg("Implicit datatype conversion is not supported when writing to compressed images");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ idata = (int *) tiledata;
+ *intlength = 4;
+
+ if (nullcheck == 1) {
+ /* no datatype conversion is required for any of the compression algorithms,
+ except possibly for HCOMPRESS (to I*8), which is handled later.
+ Just reset pixels equal to flagval to the FITS null value */
+ flagval = *(int *) (nullflagval);
+ if (flagval != nullval) {
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (idata[ii] == flagval)
+ idata[ii] = nullval;
+ }
+ }
+ }
+
+ return(*status);
+}
+ /*--------------------------------------------------------------------------*/
+int imcomp_convert_tile_tuint(
+ fitsfile *outfptr,
+ void *tiledata,
+ long tilelen,
+ int nullcheck,
+ void *nullflagval,
+ int nullval,
+ int zbitpix,
+ double scale,
+ double zero,
+ int *intlength,
+ int *status)
+{
+ /* Prepare the input tile array of pixels for compression.
+ /* Convert input integer*2 tile array in place to 4 or 8-byte ints for compression, */
+ /* If needed, convert 4 or 8-byte ints and do null value substitution. */
+ /* Note that the calling routine must have allocated the input array big enough */
+ /* to be able to do this. */
+
+ int flagval, *idata;
+ unsigned int *uintbuff, uintflagval;
+ long ii;
+
+
+ /* datatype of input array is unsigned int. We only support writing this datatype
+ to a FITS image with BITPIX = 32 and with BZERO = 0 and BSCALE = 2147483648. */
+
+ if (zbitpix != LONG_IMG || scale != 1.0 || zero != 2147483648.) {
+ ffpmsg("Implicit datatype conversion is not supported when writing to compressed images");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ *intlength = 4;
+ idata = (int *) tiledata;
+ uintbuff = (unsigned int *) tiledata;
+
+ /* offset the unsigned value by -2147483648 to a signed int value. */
+ /* It is more efficient to do this by just flipping the most significant of the 32 bits */
+
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to nullval and */
+ /* offset the other pixel values (by flipping the MSB) */
+ uintflagval = *(unsigned int *) (nullflagval);
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (uintbuff[ii] == uintflagval)
+ idata[ii] = nullval;
+ else
+ uintbuff[ii] = (uintbuff[ii]) ^ 0x80000000;
+ }
+ } else {
+ /* just offset the pixel values (by flipping the MSB) */
+ for (ii = tilelen - 1; ii >= 0; ii--)
+ uintbuff[ii] = (uintbuff[ii]) ^ 0x80000000;
+ }
+
+ return(*status);
+}
+ /*--------------------------------------------------------------------------*/
+int imcomp_convert_tile_tbyte(
+ fitsfile *outfptr,
+ void *tiledata,
+ long tilelen,
+ int nullcheck,
+ void *nullflagval,
+ int nullval,
+ int zbitpix,
+ double scale,
+ double zero,
+ int *intlength,
+ int *status)
+{
+ /* Prepare the input tile array of pixels for compression.
+ /* Convert input integer*2 tile array in place to 4 or 8-byte ints for compression, */
+ /* If needed, convert 4 or 8-byte ints and do null value substitution. */
+ /* Note that the calling routine must have allocated the input array big enough */
+ /* to be able to do this. */
+
+ int flagval, *idata;
+ long ii;
+ unsigned char *usbbuff;
+
+ /* datatype of input array is unsigned byte. We only support writing this datatype
+ to a FITS image with BITPIX = 8 and with BZERO = 0 and BSCALE = 1. */
+
+ if (zbitpix != BYTE_IMG || scale != 1.0 || zero != 0.) {
+ ffpmsg("Implicit datatype conversion is not supported when writing to compressed images");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ idata = (int *) tiledata;
+ usbbuff = (unsigned char *) tiledata;
+
+ if ( (outfptr->Fptr)->compress_type == RICE_1 || (outfptr->Fptr)->compress_type == GZIP_1
+ || (outfptr->Fptr)->compress_type == GZIP_2 || (outfptr->Fptr)->compress_type == BZIP2_1 )
+ {
+ /* don't have to convert to int if using gzip, bzip2, or Rice compression */
+ *intlength = 1;
+
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to the FITS null value, prior to compression */
+ flagval = *(unsigned char *) (nullflagval);
+ if (flagval != nullval) {
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (usbbuff[ii] == (unsigned char) flagval)
+ usbbuff[ii] = (unsigned char) nullval;
+ }
+ }
+ }
+ } else {
+ /* have to convert to int if using HCOMPRESS or PLIO */
+ *intlength = 4;
+
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to the FITS null value, prior to compression */
+ flagval = *(unsigned char *) (nullflagval);
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (usbbuff[ii] == (unsigned char) flagval)
+ idata[ii] = nullval;
+ else
+ idata[ii] = (int) usbbuff[ii];
+ }
+ } else { /* just do the data type conversion to int */
+ for (ii = tilelen - 1; ii >= 0; ii--)
+ idata[ii] = (int) usbbuff[ii];
+ }
+ }
+
+ return(*status);
+}
+ /*--------------------------------------------------------------------------*/
+int imcomp_convert_tile_tsbyte(
+ fitsfile *outfptr,
+ void *tiledata,
+ long tilelen,
+ int nullcheck,
+ void *nullflagval,
+ int nullval,
+ int zbitpix,
+ double scale,
+ double zero,
+ int *intlength,
+ int *status)
+{
+ /* Prepare the input tile array of pixels for compression.
+ /* Convert input integer*2 tile array in place to 4 or 8-byte ints for compression, */
+ /* If needed, convert 4 or 8-byte ints and do null value substitution. */
+ /* Note that the calling routine must have allocated the input array big enough */
+ /* to be able to do this. */
+
+ int flagval, *idata;
+ long ii;
+ signed char *sbbuff;
+
+ /* datatype of input array is signed byte. We only support writing this datatype
+ to a FITS image with BITPIX = 8 and with BZERO = 0 and BSCALE = -128. */
+
+ if (zbitpix != BYTE_IMG|| scale != 1.0 || zero != -128.) {
+ ffpmsg("Implicit datatype conversion is not supported when writing to compressed images");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ idata = (int *) tiledata;
+ sbbuff = (signed char *) tiledata;
+
+ if ( (outfptr->Fptr)->compress_type == RICE_1 || (outfptr->Fptr)->compress_type == GZIP_1
+ || (outfptr->Fptr)->compress_type == GZIP_2 || (outfptr->Fptr)->compress_type == BZIP2_1 )
+ {
+ /* don't have to convert to int if using gzip, bzip2 or Rice compression */
+ *intlength = 1;
+
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to the FITS null value, prior to compression */
+ /* offset the other pixel values (by flipping the MSB) */
+
+ flagval = *(signed char *) (nullflagval);
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (sbbuff[ii] == (signed char) flagval)
+ sbbuff[ii] = (signed char) nullval;
+ else
+ sbbuff[ii] = (sbbuff[ii]) ^ 0x80; }
+ } else { /* just offset the pixel values (by flipping the MSB) */
+ for (ii = tilelen - 1; ii >= 0; ii--)
+ sbbuff[ii] = (sbbuff[ii]) ^ 0x80;
+ }
+
+ } else {
+ /* have to convert to int if using HCOMPRESS or PLIO */
+ *intlength = 4;
+
+ if (nullcheck == 1) {
+ /* reset pixels equal to flagval to the FITS null value, prior to compression */
+ flagval = *(signed char *) (nullflagval);
+ for (ii = tilelen - 1; ii >= 0; ii--) {
+ if (sbbuff[ii] == (signed char) flagval)
+ idata[ii] = nullval;
+ else
+ idata[ii] = ((int) sbbuff[ii]) + 128;
+ }
+ } else { /* just do the data type conversion to int */
+ for (ii = tilelen - 1; ii >= 0; ii--)
+ idata[ii] = ((int) sbbuff[ii]) + 128;
+ }
+ }
+
+ return(*status);
+}
+ /*--------------------------------------------------------------------------*/
+int imcomp_convert_tile_tfloat(
+ fitsfile *outfptr,
+ long row,
+ void *tiledata,
+ long tilelen,
+ long tilenx,
+ long tileny,
+ int nullcheck,
+ void *nullflagval,
+ int nullval,
+ int zbitpix,
+ double scale,
+ double zero,
+ int *intlength,
+ int *flag,
+ double *bscale,
+ double *bzero,
+ int *status)
+{
+ /* Prepare the input tile array of pixels for compression.
+ /* Convert input integer*2 tile array in place to 4 or 8-byte ints for compression, */
+ /* If needed, convert 4 or 8-byte ints and do null value substitution. */
+ /* Note that the calling routine must have allocated the input array big enough */
+ /* to be able to do this. */
+
+ int flagval, *idata;
+ long irow, ii;
+ float floatnull;
+ unsigned char *usbbuff;
+ unsigned long dithersum;
+ int iminval = 0, imaxval = 0; /* min and max quantized integers */
+
+ *intlength = 4;
+ idata = (int *) tiledata;
+
+ /* if the tile-compressed table contains zscale and zzero columns */
+ /* then scale and quantize the input floating point data. */
+
+ if ((outfptr->Fptr)->cn_zscale > 0) {
+ /* quantize the float values into integers */
+
+ if (nullcheck == 1)
+ floatnull = *(float *) (nullflagval);
+ else
+ floatnull = FLOATNULLVALUE; /* NaNs are represented by this, by default */
+
+ if ((outfptr->Fptr)->quantize_dither == SUBTRACTIVE_DITHER_1) {
+
+ /* see if the dithering offset value needs to be initialized */
+ if ((outfptr->Fptr)->request_dither_offset == 0 && (outfptr->Fptr)->dither_offset == 0) {
+
+ /* This means randomly choose the dithering offset based on the system time. */
+ /* The offset will have a value between 1 and 10000, inclusive. */
+ /* The time function returns an integer value that is incremented each second. */
+ /* The clock function returns the elapsed CPU time, in integer CLOCKS_PER_SEC units. */
+ /* The CPU time returned by clock is typically (on linux PC) only good to 0.01 sec */
+ /* Summing the 2 quantities may help avoid cases where 2 executions of the program */
+ /* (perhaps in a multithreaded environoment) end up with exactly the same dither_offset */
+ /* value. The sum is incremented by the current HDU number in the file to provide */
+ /* further randomization. This randomization is desireable if multiple compressed */
+ /* images will be summed (or differenced). In such cases, the benefits of dithering */
+ /* may be lost if all the images use exactly the same sequence of random numbers when */
+ /* calculating the dithering offsets. */
+
+ (outfptr->Fptr)->dither_offset =
+ (( (int)time(NULL) + ( (int) clock() / (int) (CLOCKS_PER_SEC / 100)) + (outfptr->Fptr)->curhdu) % 10000) + 1;
+
+ /* update the header keyword with this new value */
+ fits_update_key(outfptr, TINT, "ZDITHER0", &((outfptr->Fptr)->dither_offset),
+ NULL, status);
+
+ } else if ((outfptr->Fptr)->request_dither_offset < 0 && (outfptr->Fptr)->dither_offset < 0) {
+
+ /* this means randomly choose the dithering offset based on some hash function */
+ /* of the first input tile of data to be quantized and compressed. This ensures that */
+ /* the same offset value is used for a given image every time it is compressed. */
+
+ usbbuff = (unsigned char *) tiledata;
+ dithersum = 0;
+ for (ii = 0; ii < 4 * tilelen; ii++) {
+ dithersum += usbbuff[ii]; /* doesn't matter if there is an integer overflow */
+ }
+ (outfptr->Fptr)->dither_offset = ((int) (dithersum % 10000)) + 1;
+
+ /* update the header keyword with this new value */
+ fits_update_key(outfptr, TINT, "ZDITHER0", &((outfptr->Fptr)->dither_offset),
+ NULL, status);
+ }
+
+ /* subtract 1 to convert from 1-based to 0-based element number */
+ irow = row + (outfptr->Fptr)->dither_offset - 1; /* dither the quantized values */
+
+ } else {
+ irow = 0; /* do not dither the quantized values */
+ }
+
+ *flag = fits_quantize_float (irow, (float *) tiledata, tilenx, tileny,
+ nullcheck, floatnull, (outfptr->Fptr)->quantize_level, idata,
+ bscale, bzero, &iminval, &imaxval);
+
+ if (*flag > 1)
+ return(*status = *flag);
+ }
+ else if ((outfptr->Fptr)->quantize_level != NO_QUANTIZE)
+ {
+ /* if floating point pixels are not being losslessly compressed, then */
+ /* input float data is implicitly converted (truncated) to integers */
+ if ((scale != 1. || zero != 0.)) /* must scale the values */
+ imcomp_nullscalefloats((float *) tiledata, tilelen, idata, scale, zero,
+ nullcheck, *(float *) (nullflagval), nullval, status);
+ else
+ imcomp_nullfloats((float *) tiledata, tilelen, idata,
+ nullcheck, *(float *) (nullflagval), nullval, status);
+ }
+ else if ((outfptr->Fptr)->quantize_level == NO_QUANTIZE)
+ {
+ /* just convert null values to NaNs in place, if necessary, then do lossless gzip compression */
+ if (nullcheck == 1) {
+ imcomp_float2nan((float *) tiledata, tilelen, (int *) tiledata,
+ *(float *) (nullflagval), status);
+ }
+ }
+
+ return(*status);
+}
+ /*--------------------------------------------------------------------------*/
+int imcomp_convert_tile_tdouble(
+ fitsfile *outfptr,
+ long row,
+ void *tiledata,
+ long tilelen,
+ long tilenx,
+ long tileny,
+ int nullcheck,
+ void *nullflagval,
+ int nullval,
+ int zbitpix,
+ double scale,
+ double zero,
+ int *intlength,
+ int *flag,
+ double *bscale,
+ double *bzero,
+ int *status)
+{
+ /* Prepare the input tile array of pixels for compression.
+ /* Convert input integer*2 tile array in place to 4 or 8-byte ints for compression, */
+ /* If needed, convert 4 or 8-byte ints and do null value substitution. */
+ /* Note that the calling routine must have allocated the input array big enough */
+ /* to be able to do this. */
+
+ int flagval, *idata;
+ long irow, ii;
+ double doublenull;
+ unsigned char *usbbuff;
+ unsigned long dithersum;
+ int iminval = 0, imaxval = 0; /* min and max quantized integers */
+
+ *intlength = 4;
+ idata = (int *) tiledata;
+
+ /* if the tile-compressed table contains zscale and zzero columns */
+ /* then scale and quantize the input floating point data. */
+ /* Otherwise, just truncate the floats to integers. */
+
+ if ((outfptr->Fptr)->cn_zscale > 0)
+ {
+ if (nullcheck == 1)
+ doublenull = *(double *) (nullflagval);
+ else
+ doublenull = DOUBLENULLVALUE;
+
+ /* quantize the double values into integers */
+ if ((outfptr->Fptr)->quantize_dither == SUBTRACTIVE_DITHER_1) {
+
+ /* see if the dithering offset value needs to be initialized (see above) */
+ if ((outfptr->Fptr)->request_dither_offset == 0 && (outfptr->Fptr)->dither_offset == 0) {
+
+ (outfptr->Fptr)->dither_offset =
+ (( (int)time(NULL) + ( (int) clock() / (int) (CLOCKS_PER_SEC / 100)) + (outfptr->Fptr)->curhdu) % 10000) + 1;
+
+ /* update the header keyword with this new value */
+ fits_update_key(outfptr, TINT, "ZDITHER0", &((outfptr->Fptr)->dither_offset),
+ NULL, status);
+
+ } else if ((outfptr->Fptr)->request_dither_offset < 0 && (outfptr->Fptr)->dither_offset < 0) {
+
+ usbbuff = (unsigned char *) tiledata;
+ dithersum = 0;
+ for (ii = 0; ii < 8 * tilelen; ii++) {
+ dithersum += usbbuff[ii];
+ }
+ (outfptr->Fptr)->dither_offset = ((int) (dithersum % 10000)) + 1;
+
+ /* update the header keyword with this new value */
+ fits_update_key(outfptr, TINT, "ZDITHER0", &((outfptr->Fptr)->dither_offset),
+ NULL, status);
+ }
+
+ irow = row + (outfptr->Fptr)->dither_offset - 1; /* dither the quantized values */
+
+ } else {
+ irow = 0; /* do not dither the quantized values */
+ }
+
+ *flag = fits_quantize_double (irow, (double *) tiledata, tilenx, tileny,
+ nullcheck, doublenull, (outfptr->Fptr)->quantize_level, idata,
+ bscale, bzero, &iminval, &imaxval);
+
+ if (*flag > 1)
+ return(*status = *flag);
+ }
+ else if ((outfptr->Fptr)->quantize_level != NO_QUANTIZE)
+ {
+ /* if floating point pixels are not being losslessly compressed, then */
+ /* input float data is implicitly converted (truncated) to integers */
+ if ((scale != 1. || zero != 0.)) /* must scale the values */
+ imcomp_nullscaledoubles((double *) tiledata, tilelen, idata, scale, zero,
+ nullcheck, *(double *) (nullflagval), nullval, status);
+ else
+ imcomp_nulldoubles((double *) tiledata, tilelen, idata,
+ nullcheck, *(double *) (nullflagval), nullval, status);
+ }
+ else if ((outfptr->Fptr)->quantize_level == NO_QUANTIZE)
+ {
+ /* just convert null values to NaNs in place, if necessary, then do lossless gzip compression */
+ if (nullcheck == 1) {
+ imcomp_double2nan((double *) tiledata, tilelen, (LONGLONG *) tiledata,
+ *(double *) (nullflagval), status);
+ }
+ }
+
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_nullscale(
+ int *idata,
+ long tilelen,
+ int nullflagval,
+ int nullval,
+ double scale,
+ double zero,
+ int *status)
+/*
+ do null value substitution AND scaling of the integer array.
+ If array value = nullflagval, then set the value to nullval.
+ Otherwise, inverse scale the integer value.
+*/
+{
+ long ii;
+ double dvalue;
+
+ for (ii=0; ii < tilelen; ii++)
+ {
+ if (idata[ii] == nullflagval)
+ idata[ii] = nullval;
+ else
+ {
+ dvalue = (idata[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_nullvalues(
+ int *idata,
+ long tilelen,
+ int nullflagval,
+ int nullval,
+ int *status)
+/*
+ do null value substitution.
+ If array value = nullflagval, then set the value to nullval.
+*/
+{
+ long ii;
+
+ for (ii=0; ii < tilelen; ii++)
+ {
+ if (idata[ii] == nullflagval)
+ idata[ii] = nullval;
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_scalevalues(
+ int *idata,
+ long tilelen,
+ double scale,
+ double zero,
+ int *status)
+/*
+ do inverse scaling the integer values.
+*/
+{
+ long ii;
+ double dvalue;
+
+ for (ii=0; ii < tilelen; ii++)
+ {
+ dvalue = (idata[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_nullscalei2(
+ short *idata,
+ long tilelen,
+ short nullflagval,
+ short nullval,
+ double scale,
+ double zero,
+ int *status)
+/*
+ do null value substitution AND scaling of the integer array.
+ If array value = nullflagval, then set the value to nullval.
+ Otherwise, inverse scale the integer value.
+*/
+{
+ long ii;
+ double dvalue;
+
+ for (ii=0; ii < tilelen; ii++)
+ {
+ if (idata[ii] == nullflagval)
+ idata[ii] = nullval;
+ else
+ {
+ dvalue = (idata[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_nullvaluesi2(
+ short *idata,
+ long tilelen,
+ short nullflagval,
+ short nullval,
+ int *status)
+/*
+ do null value substitution.
+ If array value = nullflagval, then set the value to nullval.
+*/
+{
+ long ii;
+
+ for (ii=0; ii < tilelen; ii++)
+ {
+ if (idata[ii] == nullflagval)
+ idata[ii] = nullval;
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_scalevaluesi2(
+ short *idata,
+ long tilelen,
+ double scale,
+ double zero,
+ int *status)
+/*
+ do inverse scaling the integer values.
+*/
+{
+ long ii;
+ double dvalue;
+
+ for (ii=0; ii < tilelen; ii++)
+ {
+ dvalue = (idata[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_nullfloats(
+ float *fdata,
+ long tilelen,
+ int *idata,
+ int nullcheck,
+ float nullflagval,
+ int nullval,
+ int *status)
+/*
+ do null value substitution of the float array.
+ If array value = nullflagval, then set the output value to FLOATNULLVALUE.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 1) /* must check for null values */
+ {
+ for (ii=0; ii < tilelen; ii++)
+ {
+ if (fdata[ii] == nullflagval)
+ idata[ii] = nullval;
+ else
+ {
+ dvalue = fdata[ii];
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ }
+ else /* don't have to worry about null values */
+ {
+ for (ii=0; ii < tilelen; ii++)
+ {
+ dvalue = fdata[ii];
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_nullscalefloats(
+ float *fdata,
+ long tilelen,
+ int *idata,
+ double scale,
+ double zero,
+ int nullcheck,
+ float nullflagval,
+ int nullval,
+ int *status)
+/*
+ do null value substitution of the float array.
+ If array value = nullflagval, then set the output value to FLOATNULLVALUE.
+ Otherwise, inverse scale the integer value.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 1) /* must check for null values */
+ {
+ for (ii=0; ii < tilelen; ii++)
+ {
+ if (fdata[ii] == nullflagval)
+ idata[ii] = nullval;
+ else
+ {
+ dvalue = (fdata[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0.)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ }
+ else /* don't have to worry about null values */
+ {
+ for (ii=0; ii < tilelen; ii++)
+ {
+ dvalue = (fdata[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0.)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_nulldoubles(
+ double *fdata,
+ long tilelen,
+ int *idata,
+ int nullcheck,
+ double nullflagval,
+ int nullval,
+ int *status)
+/*
+ do null value substitution of the float array.
+ If array value = nullflagval, then set the output value to FLOATNULLVALUE.
+ Otherwise, inverse scale the integer value.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 1) /* must check for null values */
+ {
+ for (ii=0; ii < tilelen; ii++)
+ {
+ if (fdata[ii] == nullflagval)
+ idata[ii] = nullval;
+ else
+ {
+ dvalue = fdata[ii];
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0.)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ }
+ else /* don't have to worry about null values */
+ {
+ for (ii=0; ii < tilelen; ii++)
+ {
+ dvalue = fdata[ii];
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0.)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int imcomp_nullscaledoubles(
+ double *fdata,
+ long tilelen,
+ int *idata,
+ double scale,
+ double zero,
+ int nullcheck,
+ double nullflagval,
+ int nullval,
+ int *status)
+/*
+ do null value substitution of the float array.
+ If array value = nullflagval, then set the output value to FLOATNULLVALUE.
+ Otherwise, inverse scale the integer value.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (nullcheck == 1) /* must check for null values */
+ {
+ for (ii=0; ii < tilelen; ii++)
+ {
+ if (fdata[ii] == nullflagval)
+ idata[ii] = nullval;
+ else
+ {
+ dvalue = (fdata[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0.)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ }
+ else /* don't have to worry about null values */
+ {
+ for (ii=0; ii < tilelen; ii++)
+ {
+ dvalue = (fdata[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ idata[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0.)
+ idata[ii] = (int) (dvalue + .5);
+ else
+ idata[ii] = (int) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int fits_write_compressed_img(fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the array to be written */
+ long *infpixel, /* I - 'bottom left corner' of the subsection */
+ long *inlpixel, /* I - 'top right corner' of the subsection */
+ int nullcheck, /* I - 0 for no null checking */
+ /* 1: pixels that are = nullval will be */
+ /* written with the FITS null pixel value */
+ /* (floating point arrays only) */
+ void *array, /* I - array of values to be written */
+ void *nullval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write a section of a compressed image.
+*/
+{
+ int naxis[MAX_COMPRESS_DIM], tiledim[MAX_COMPRESS_DIM];
+ long tilesize[MAX_COMPRESS_DIM], thistilesize[MAX_COMPRESS_DIM];
+ long ftile[MAX_COMPRESS_DIM], ltile[MAX_COMPRESS_DIM];
+ long tfpixel[MAX_COMPRESS_DIM], tlpixel[MAX_COMPRESS_DIM];
+ long rowdim[MAX_COMPRESS_DIM], offset[MAX_COMPRESS_DIM],ntemp;
+ long fpixel[MAX_COMPRESS_DIM], lpixel[MAX_COMPRESS_DIM];
+ int ii, i5, i4, i3, i2, i1, i0, ndim, irow, pixlen, tilenul;
+ int tstatus, buffpixsiz;
+ void *buffer;
+ char *bnullarray = 0, card[FLEN_CARD];
+
+ if (*status > 0)
+ return(*status);
+
+ if (!fits_is_compressed_image(fptr, status) )
+ {
+ ffpmsg("CHDU is not a compressed image (fits_write_compressed_img)");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ /* 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 (datatype == TSHORT || datatype == TUSHORT)
+ {
+ pixlen = sizeof(short);
+ }
+ else if (datatype == TINT || datatype == TUINT)
+ {
+ pixlen = sizeof(int);
+ }
+ else if (datatype == TBYTE || datatype == TSBYTE)
+ {
+ pixlen = 1;
+ }
+ else if (datatype == TLONG || datatype == TULONG)
+ {
+ pixlen = sizeof(long);
+ }
+ else if (datatype == TFLOAT)
+ {
+ pixlen = sizeof(float);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ pixlen = sizeof(double);
+ }
+ else
+ {
+ ffpmsg("unsupported datatype for compressing image");
+ return(*status = BAD_DATATYPE);
+ }
+
+ /* ===================================================================== */
+
+ /* allocate scratch space for processing one tile of the image */
+ buffpixsiz = pixlen; /* this is the minimum pixel size */
+
+ if ( (fptr->Fptr)->compress_type == HCOMPRESS_1) { /* need 4 or 8 bytes per pixel */
+ if ((fptr->Fptr)->zbitpix == BYTE_IMG ||
+ (fptr->Fptr)->zbitpix == SHORT_IMG )
+ buffpixsiz = maxvalue(buffpixsiz, 4);
+ else
+ buffpixsiz = 8;
+ }
+ else if ( (fptr->Fptr)->compress_type == PLIO_1) { /* need 4 bytes per pixel */
+ buffpixsiz = maxvalue(buffpixsiz, 4);
+ }
+ else if ( (fptr->Fptr)->compress_type == RICE_1 ||
+ (fptr->Fptr)->compress_type == GZIP_1 ||
+ (fptr->Fptr)->compress_type == GZIP_2 ||
+ (fptr->Fptr)->compress_type == BZIP2_1) { /* need 1, 2, or 4 bytes per pixel */
+ if ((fptr->Fptr)->zbitpix == BYTE_IMG)
+ buffpixsiz = maxvalue(buffpixsiz, 1);
+ else if ((fptr->Fptr)->zbitpix == SHORT_IMG)
+ buffpixsiz = maxvalue(buffpixsiz, 2);
+ else
+ buffpixsiz = maxvalue(buffpixsiz, 4);
+ }
+ else
+ {
+ ffpmsg("unsupported image compression algorithm");
+ return(*status = BAD_DATATYPE);
+ }
+
+ /* cast to double to force alignment on 8-byte addresses */
+ buffer = (double *) calloc ((fptr->Fptr)->maxtilelen, buffpixsiz);
+
+ if (buffer == NULL)
+ {
+ ffpmsg("Out of memory (fits_write_compress_img)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* ===================================================================== */
+
+ /* initialize all the arrays */
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ naxis[ii] = 1;
+ tiledim[ii] = 1;
+ tilesize[ii] = 1;
+ ftile[ii] = 1;
+ ltile[ii] = 1;
+ rowdim[ii] = 1;
+ }
+
+ ndim = (fptr->Fptr)->zndim;
+ ntemp = 1;
+ for (ii = 0; ii < ndim; ii++)
+ {
+ fpixel[ii] = infpixel[ii];
+ lpixel[ii] = inlpixel[ii];
+
+ /* calc number of tiles in each dimension, and tile containing */
+ /* the first and last pixel we want to read in each dimension */
+ naxis[ii] = (fptr->Fptr)->znaxis[ii];
+ if (fpixel[ii] < 1)
+ {
+ free(buffer);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ tilesize[ii] = (fptr->Fptr)->tilesize[ii];
+ tiledim[ii] = (naxis[ii] - 1) / tilesize[ii] + 1;
+ ftile[ii] = (fpixel[ii] - 1) / tilesize[ii] + 1;
+ ltile[ii] = minvalue((lpixel[ii] - 1) / tilesize[ii] + 1,
+ tiledim[ii]);
+ rowdim[ii] = ntemp; /* total tiles in each dimension */
+ ntemp *= tiledim[ii];
+ }
+
+ /* support up to 6 dimensions for now */
+ /* tfpixel and tlpixel are the first and last image pixels */
+ /* along each dimension of the compression tile */
+ for (i5 = ftile[5]; i5 <= ltile[5]; i5++)
+ {
+ tfpixel[5] = (i5 - 1) * tilesize[5] + 1;
+ tlpixel[5] = minvalue(tfpixel[5] + tilesize[5] - 1,
+ naxis[5]);
+ thistilesize[5] = tlpixel[5] - tfpixel[5] + 1;
+ offset[5] = (i5 - 1) * rowdim[5];
+ for (i4 = ftile[4]; i4 <= ltile[4]; i4++)
+ {
+ tfpixel[4] = (i4 - 1) * tilesize[4] + 1;
+ tlpixel[4] = minvalue(tfpixel[4] + tilesize[4] - 1,
+ naxis[4]);
+ thistilesize[4] = thistilesize[5] * (tlpixel[4] - tfpixel[4] + 1);
+ offset[4] = (i4 - 1) * rowdim[4] + offset[5];
+ for (i3 = ftile[3]; i3 <= ltile[3]; i3++)
+ {
+ tfpixel[3] = (i3 - 1) * tilesize[3] + 1;
+ tlpixel[3] = minvalue(tfpixel[3] + tilesize[3] - 1,
+ naxis[3]);
+ thistilesize[3] = thistilesize[4] * (tlpixel[3] - tfpixel[3] + 1);
+ offset[3] = (i3 - 1) * rowdim[3] + offset[4];
+ for (i2 = ftile[2]; i2 <= ltile[2]; i2++)
+ {
+ tfpixel[2] = (i2 - 1) * tilesize[2] + 1;
+ tlpixel[2] = minvalue(tfpixel[2] + tilesize[2] - 1,
+ naxis[2]);
+ thistilesize[2] = thistilesize[3] * (tlpixel[2] - tfpixel[2] + 1);
+ offset[2] = (i2 - 1) * rowdim[2] + offset[3];
+ for (i1 = ftile[1]; i1 <= ltile[1]; i1++)
+ {
+ tfpixel[1] = (i1 - 1) * tilesize[1] + 1;
+ tlpixel[1] = minvalue(tfpixel[1] + tilesize[1] - 1,
+ naxis[1]);
+ thistilesize[1] = thistilesize[2] * (tlpixel[1] - tfpixel[1] + 1);
+ offset[1] = (i1 - 1) * rowdim[1] + offset[2];
+ for (i0 = ftile[0]; i0 <= ltile[0]; i0++)
+ {
+ tfpixel[0] = (i0 - 1) * tilesize[0] + 1;
+ tlpixel[0] = minvalue(tfpixel[0] + tilesize[0] - 1,
+ naxis[0]);
+ thistilesize[0] = thistilesize[1] * (tlpixel[0] - tfpixel[0] + 1);
+ /* calculate row of table containing this tile */
+ irow = i0 + offset[1];
+
+ /* read and uncompress this row (tile) of the table */
+ /* also do type conversion and undefined pixel substitution */
+ /* at this point */
+ imcomp_decompress_tile(fptr, irow, thistilesize[0],
+ datatype, nullcheck, nullval, buffer, bnullarray, &tilenul,
+ status);
+
+ if (*status == NO_COMPRESSED_TILE)
+ {
+ /* tile doesn't exist, so initialize to zero */
+ memset(buffer, 0, pixlen * thistilesize[0]);
+ *status = 0;
+ }
+
+ /* copy the intersecting pixels to this tile from the input */
+ imcomp_merge_overlap(buffer, pixlen, ndim, tfpixel, tlpixel,
+ bnullarray, array, fpixel, lpixel, nullcheck, status);
+
+ /* compress the tile again, and write it back to the FITS file */
+ imcomp_compress_tile (fptr, irow, datatype, buffer,
+ thistilesize[0],
+ tlpixel[0] - tfpixel[0] + 1,
+ tlpixel[1] - tfpixel[1] + 1,
+ nullcheck, nullval,
+ status);
+ }
+ }
+ }
+ }
+ }
+ }
+ free(buffer);
+
+
+ if ((fptr->Fptr)->zbitpix < 0 && nullcheck != 0) {
+/*
+ This is a floating point FITS image with possible null values.
+ It is too messy to test if any null values are actually written, so
+ just assume so. We need to make sure that the
+ ZBLANK keyword is present in the compressed image header. If it is not
+ there then we need to insert the keyword.
+*/
+ tstatus = 0;
+ ffgcrd(fptr, "ZBLANK", card, &tstatus);
+
+ if (tstatus) { /* have to insert the ZBLANK keyword */
+ ffgcrd(fptr, "ZCMPTYPE", card, status);
+ ffikyj(fptr, "ZBLANK", COMPRESS_NULL_VALUE,
+ "null value in the compressed integer array", status);
+
+ /* set this value into the internal structure; it is used if */
+ /* the program reads back the values from the array */
+
+ (fptr->Fptr)->zblank = COMPRESS_NULL_VALUE;
+ (fptr->Fptr)->cn_zblank = -1; /* flag for a constant ZBLANK */
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_write_compressed_pixels(fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the array to be written */
+ LONGLONG fpixel, /* I - 'first pixel to write */
+ LONGLONG npixel, /* I - number of pixels to write */
+ int nullcheck, /* I - 0 for no null checking */
+ /* 1: pixels that are = nullval will be */
+ /* written with the FITS null pixel value */
+ /* (floating point arrays only) */
+ void *array, /* I - array of values to write */
+ void *nullval, /* I - value used to represent undefined pixels*/
+ int *status) /* IO - error status */
+/*
+ Write a consecutive set of pixels to a compressed image. This routine
+ interpretes the n-dimensional image as a long one-dimensional array.
+ This is actually a rather inconvenient way to write compressed images in
+ general, and could be rather inefficient if the requested pixels to be
+ written are located in many different image compression tiles.
+
+ The general strategy used here is to write the requested pixels in blocks
+ that correspond to rectangular image sections.
+*/
+{
+ int naxis, ii, bytesperpixel;
+ long naxes[MAX_COMPRESS_DIM], nread;
+ LONGLONG tfirst, tlast, last0, last1, dimsize[MAX_COMPRESS_DIM];
+ long nplane, firstcoord[MAX_COMPRESS_DIM], lastcoord[MAX_COMPRESS_DIM];
+ char *arrayptr;
+
+ if (*status > 0)
+ return(*status);
+
+ arrayptr = (char *) array;
+
+ /* get size of array pixels, in bytes */
+ bytesperpixel = ffpxsz(datatype);
+
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ naxes[ii] = 1;
+ firstcoord[ii] = 0;
+ lastcoord[ii] = 0;
+ }
+
+ /* determine the dimensions of the image to be written */
+ ffgidm(fptr, &naxis, status);
+ ffgisz(fptr, MAX_COMPRESS_DIM, naxes, status);
+
+ /* calc the cumulative number of pixels in each successive dimension */
+ dimsize[0] = 1;
+ for (ii = 1; ii < MAX_COMPRESS_DIM; ii++)
+ dimsize[ii] = dimsize[ii - 1] * naxes[ii - 1];
+
+ /* determine the coordinate of the first and last pixel in the image */
+ /* Use zero based indexes here */
+ tfirst = fpixel - 1;
+ tlast = tfirst + npixel - 1;
+ for (ii = naxis - 1; ii >= 0; ii--)
+ {
+ firstcoord[ii] = (long) (tfirst / dimsize[ii]);
+ lastcoord[ii] = (long) (tlast / dimsize[ii]);
+ tfirst = tfirst - firstcoord[ii] * dimsize[ii];
+ tlast = tlast - lastcoord[ii] * dimsize[ii];
+ }
+
+ /* to simplify things, treat 1-D, 2-D, and 3-D images as separate cases */
+
+ if (naxis == 1)
+ {
+ /* Simple: just write the requested range of pixels */
+
+ firstcoord[0] = firstcoord[0] + 1;
+ lastcoord[0] = lastcoord[0] + 1;
+ fits_write_compressed_img(fptr, datatype, firstcoord, lastcoord,
+ nullcheck, array, nullval, status);
+ return(*status);
+ }
+ else if (naxis == 2)
+ {
+ nplane = 0; /* write 1st (and only) plane of the image */
+ fits_write_compressed_img_plane(fptr, datatype, bytesperpixel,
+ nplane, firstcoord, lastcoord, naxes, nullcheck,
+ array, nullval, &nread, status);
+ }
+ else if (naxis == 3)
+ {
+ /* test for special case: writing an integral number of planes */
+ if (firstcoord[0] == 0 && firstcoord[1] == 0 &&
+ lastcoord[0] == naxes[0] - 1 && lastcoord[1] == naxes[1] - 1)
+ {
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ /* convert from zero base to 1 base */
+ (firstcoord[ii])++;
+ (lastcoord[ii])++;
+ }
+
+ /* we can write the contiguous block of pixels in one go */
+ fits_write_compressed_img(fptr, datatype, firstcoord, lastcoord,
+ nullcheck, array, nullval, status);
+ return(*status);
+ }
+
+ /* save last coordinate in temporary variables */
+ last0 = lastcoord[0];
+ last1 = lastcoord[1];
+
+ if (firstcoord[2] < lastcoord[2])
+ {
+ /* we will write up to the last pixel in all but the last plane */
+ lastcoord[0] = naxes[0] - 1;
+ lastcoord[1] = naxes[1] - 1;
+ }
+
+ /* write one plane of the cube at a time, for simplicity */
+ for (nplane = firstcoord[2]; nplane <= lastcoord[2]; nplane++)
+ {
+ if (nplane == lastcoord[2])
+ {
+ lastcoord[0] = (long) last0;
+ lastcoord[1] = (long) last1;
+ }
+
+ fits_write_compressed_img_plane(fptr, datatype, bytesperpixel,
+ nplane, firstcoord, lastcoord, naxes, nullcheck,
+ arrayptr, nullval, &nread, status);
+
+ /* for all subsequent planes, we start with the first pixel */
+ firstcoord[0] = 0;
+ firstcoord[1] = 0;
+
+ /* increment pointers to next elements to be written */
+ arrayptr = arrayptr + nread * bytesperpixel;
+ }
+ }
+ else
+ {
+ ffpmsg("only 1D, 2D, or 3D images are currently supported");
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_write_compressed_img_plane(fitsfile *fptr, /* I - FITS file */
+ int datatype, /* I - datatype of the array to be written */
+ int bytesperpixel, /* I - number of bytes per pixel in array */
+ long nplane, /* I - which plane of the cube to write */
+ long *firstcoord, /* I coordinate of first pixel to write */
+ long *lastcoord, /* I coordinate of last pixel to write */
+ long *naxes, /* I size of each image dimension */
+ int nullcheck, /* I - 0 for no null checking */
+ /* 1: pixels that are = nullval will be */
+ /* written with the FITS null pixel value */
+ /* (floating point arrays only) */
+ void *array, /* I - array of values that are written */
+ void *nullval, /* I - value for undefined pixels */
+ long *nread, /* O - total number of pixels written */
+ int *status) /* IO - error status */
+
+ /*
+ in general we have to write the first partial row of the image,
+ followed by the middle complete rows, followed by the last
+ partial row of the image. If the first or last rows are complete,
+ then write them at the same time as all the middle rows.
+ */
+{
+ /* bottom left coord. and top right coord. */
+ long blc[MAX_COMPRESS_DIM], trc[MAX_COMPRESS_DIM];
+ char *arrayptr;
+
+ *nread = 0;
+
+ arrayptr = (char *) array;
+
+ blc[2] = nplane + 1;
+ trc[2] = nplane + 1;
+
+ if (firstcoord[0] != 0)
+ {
+ /* have to read a partial first row */
+ blc[0] = firstcoord[0] + 1;
+ blc[1] = firstcoord[1] + 1;
+ trc[1] = blc[1];
+ if (lastcoord[1] == firstcoord[1])
+ trc[0] = lastcoord[0] + 1; /* 1st and last pixels in same row */
+ else
+ trc[0] = naxes[0]; /* read entire rest of the row */
+
+ fits_write_compressed_img(fptr, datatype, blc, trc,
+ nullcheck, arrayptr, nullval, status);
+
+ *nread = *nread + trc[0] - blc[0] + 1;
+
+ if (lastcoord[1] == firstcoord[1])
+ {
+ return(*status); /* finished */
+ }
+
+ /* set starting coord to beginning of next line */
+ firstcoord[0] = 0;
+ firstcoord[1] += 1;
+ arrayptr = arrayptr + (trc[0] - blc[0] + 1) * bytesperpixel;
+ }
+
+ /* write contiguous complete rows of the image, if any */
+ blc[0] = 1;
+ blc[1] = firstcoord[1] + 1;
+ trc[0] = naxes[0];
+
+ if (lastcoord[0] + 1 == naxes[0])
+ {
+ /* can write the last complete row, too */
+ trc[1] = lastcoord[1] + 1;
+ }
+ else
+ {
+ /* last row is incomplete; have to read it separately */
+ trc[1] = lastcoord[1];
+ }
+
+ if (trc[1] >= blc[1]) /* must have at least one whole line to read */
+ {
+ fits_write_compressed_img(fptr, datatype, blc, trc,
+ nullcheck, arrayptr, nullval, status);
+
+ *nread = *nread + (trc[1] - blc[1] + 1) * naxes[0];
+
+ if (lastcoord[1] + 1 == trc[1])
+ return(*status); /* finished */
+
+ /* increment pointers for the last partial row */
+ arrayptr = arrayptr + (trc[1] - blc[1] + 1) * naxes[0] * bytesperpixel;
+
+ }
+
+ if (trc[1] == lastcoord[1] + 1)
+ return(*status); /* all done */
+
+ /* set starting and ending coord to last line */
+
+ trc[0] = lastcoord[0] + 1;
+ trc[1] = lastcoord[1] + 1;
+ blc[1] = trc[1];
+
+ fits_write_compressed_img(fptr, datatype, blc, trc,
+ nullcheck, arrayptr, nullval, status);
+
+ *nread = *nread + trc[0] - blc[0] + 1;
+
+ return(*status);
+}
+
+/* ######################################################################## */
+/* ### Image Decompression Routines ### */
+/* ######################################################################## */
+
+/*--------------------------------------------------------------------------*/
+int fits_img_decompress (fitsfile *infptr, /* image (bintable) to uncompress */
+ fitsfile *outfptr, /* empty HDU for output uncompressed image */
+ int *status) /* IO - error status */
+
+/*
+ This routine decompresses the whole image and writes it to the output file.
+*/
+
+{
+ int ii, datatype = 0;
+ int nullcheck, anynul;
+ LONGLONG fpixel[MAX_COMPRESS_DIM], lpixel[MAX_COMPRESS_DIM];
+ long inc[MAX_COMPRESS_DIM];
+ long imgsize;
+ float *nulladdr, fnulval;
+ double dnulval;
+
+ if (fits_img_decompress_header(infptr, outfptr, status) > 0)
+ {
+ return (*status);
+ }
+
+ /* force a rescan of the output header keywords, then reset the scaling */
+ /* in case the BSCALE and BZERO keywords are present, so that the */
+ /* decompressed values won't be scaled when written to the output image */
+ ffrdef(outfptr, status);
+ ffpscl(outfptr, 1.0, 0.0, status);
+ ffpscl(infptr, 1.0, 0.0, status);
+
+ /* initialize; no null checking is needed for integer images */
+ nullcheck = 0;
+ nulladdr = &fnulval;
+
+ /* determine datatype for image */
+ if ((infptr->Fptr)->zbitpix == BYTE_IMG)
+ {
+ datatype = TBYTE;
+ }
+ else if ((infptr->Fptr)->zbitpix == SHORT_IMG)
+ {
+ datatype = TSHORT;
+ }
+ else if ((infptr->Fptr)->zbitpix == LONG_IMG)
+ {
+ datatype = TINT;
+ }
+ else if ((infptr->Fptr)->zbitpix == FLOAT_IMG)
+ {
+ /* In the case of float images we must check for NaNs */
+ nullcheck = 1;
+ fnulval = FLOATNULLVALUE;
+ nulladdr = &fnulval;
+ datatype = TFLOAT;
+ }
+ else if ((infptr->Fptr)->zbitpix == DOUBLE_IMG)
+ {
+ /* In the case of double images we must check for NaNs */
+ nullcheck = 1;
+ dnulval = DOUBLENULLVALUE;
+ nulladdr = (float *) &dnulval;
+ datatype = TDOUBLE;
+ }
+
+ /* calculate size of the image (in pixels) */
+ imgsize = 1;
+ for (ii = 0; ii < (infptr->Fptr)->zndim; ii++)
+ {
+ imgsize *= (infptr->Fptr)->znaxis[ii];
+ fpixel[ii] = 1; /* Set first and last pixel to */
+ lpixel[ii] = (infptr->Fptr)->znaxis[ii]; /* include the entire image. */
+ inc[ii] = 1;
+ }
+
+ /* uncompress the input image and write to output image, one tile at a time */
+
+ fits_read_write_compressed_img(infptr, datatype, fpixel, lpixel, inc,
+ nullcheck, nulladdr, &anynul, outfptr, status);
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_decompress_img (fitsfile *infptr, /* image (bintable) to uncompress */
+ fitsfile *outfptr, /* empty HDU for output uncompressed image */
+ int *status) /* IO - error status */
+
+/*
+ THIS IS AN OBSOLETE ROUTINE. USE fits_img_decompress instead!!!
+
+ This routine decompresses the whole image and writes it to the output file.
+*/
+
+{
+ double *data;
+ int ii, datatype = 0, byte_per_pix = 0;
+ int nullcheck, anynul;
+ LONGLONG fpixel[MAX_COMPRESS_DIM], lpixel[MAX_COMPRESS_DIM];
+ long inc[MAX_COMPRESS_DIM];
+ long imgsize, memsize;
+ float *nulladdr, fnulval;
+ double dnulval;
+
+ if (*status > 0)
+ return(*status);
+
+ if (!fits_is_compressed_image(infptr, status) )
+ {
+ ffpmsg("CHDU is not a compressed image (fits_decompress_img)");
+ return(*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ /* create an empty output image with the correct dimensions */
+ if (ffcrim(outfptr, (infptr->Fptr)->zbitpix, (infptr->Fptr)->zndim,
+ (infptr->Fptr)->znaxis, status) > 0)
+ {
+ ffpmsg("error creating output decompressed image HDU");
+ return (*status);
+ }
+ /* Copy the table header to the image header. */
+ if (imcomp_copy_imheader(infptr, outfptr, status) > 0)
+ {
+ ffpmsg("error copying header of compressed image");
+ return (*status);
+ }
+
+ /* force a rescan of the output header keywords, then reset the scaling */
+ /* in case the BSCALE and BZERO keywords are present, so that the */
+ /* decompressed values won't be scaled when written to the output image */
+ ffrdef(outfptr, status);
+ ffpscl(outfptr, 1.0, 0.0, status);
+ ffpscl(infptr, 1.0, 0.0, status);
+
+ /* initialize; no null checking is needed for integer images */
+ nullcheck = 0;
+ nulladdr = &fnulval;
+
+ /* determine datatype for image */
+ if ((infptr->Fptr)->zbitpix == BYTE_IMG)
+ {
+ datatype = TBYTE;
+ byte_per_pix = 1;
+ }
+ else if ((infptr->Fptr)->zbitpix == SHORT_IMG)
+ {
+ datatype = TSHORT;
+ byte_per_pix = sizeof(short);
+ }
+ else if ((infptr->Fptr)->zbitpix == LONG_IMG)
+ {
+ datatype = TINT;
+ byte_per_pix = sizeof(int);
+ }
+ else if ((infptr->Fptr)->zbitpix == FLOAT_IMG)
+ {
+ /* In the case of float images we must check for NaNs */
+ nullcheck = 1;
+ fnulval = FLOATNULLVALUE;
+ nulladdr = &fnulval;
+ datatype = TFLOAT;
+ byte_per_pix = sizeof(float);
+ }
+ else if ((infptr->Fptr)->zbitpix == DOUBLE_IMG)
+ {
+ /* In the case of double images we must check for NaNs */
+ nullcheck = 1;
+ dnulval = DOUBLENULLVALUE;
+ nulladdr = (float *) &dnulval;
+ datatype = TDOUBLE;
+ byte_per_pix = sizeof(double);
+ }
+
+ /* calculate size of the image (in pixels) */
+ imgsize = 1;
+ for (ii = 0; ii < (infptr->Fptr)->zndim; ii++)
+ {
+ imgsize *= (infptr->Fptr)->znaxis[ii];
+ fpixel[ii] = 1; /* Set first and last pixel to */
+ lpixel[ii] = (infptr->Fptr)->znaxis[ii]; /* include the entire image. */
+ inc[ii] = 1;
+ }
+ /* Calc equivalent number of double pixels same size as whole the image. */
+ /* We use double datatype to force the memory to be aligned properly */
+ memsize = ((imgsize * byte_per_pix) - 1) / sizeof(double) + 1;
+
+ /* allocate memory for the image */
+ data = (double*) calloc (memsize, sizeof(double));
+ if (!data)
+ {
+ ffpmsg("Couldn't allocate memory for the uncompressed image");
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ /* uncompress the entire image into memory */
+ /* This routine should be enhanced sometime to only need enough */
+ /* memory to uncompress one tile at a time. */
+ fits_read_compressed_img(infptr, datatype, fpixel, lpixel, inc,
+ nullcheck, nulladdr, data, NULL, &anynul, status);
+
+ /* write the image to the output file */
+ if (anynul)
+ fits_write_imgnull(outfptr, datatype, 1, imgsize, data, nulladdr,
+ status);
+ else
+ fits_write_img(outfptr, datatype, 1, imgsize, data, status);
+
+ free(data);
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_img_decompress_header(fitsfile *infptr, /* image (bintable) to uncompress */
+ fitsfile *outfptr, /* empty HDU for output uncompressed image */
+ int *status) /* IO - error status */
+
+/*
+ This routine reads the header of the input tile compressed image and
+ converts it to that of a standard uncompress FITS image.
+*/
+
+{
+ int writeprime = 0;
+ int hdupos, inhdupos, numkeys;
+ int nullprime = 0, copyprime = 0, norec = 0, tstatus;
+ char card[FLEN_CARD];
+ int ii, datatype = 0, naxis, bitpix;
+ long naxes[MAX_COMPRESS_DIM];
+
+ if (*status > 0)
+ return(*status);
+ else if (*status == -1) {
+ *status = 0;
+ writeprime = 1;
+ }
+
+ if (!fits_is_compressed_image(infptr, status) )
+ {
+ ffpmsg("CHDU is not a compressed image (fits_img_decompress)");
+ return(*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ /* get information about the state of the output file; does it already */
+ /* contain any keywords and HDUs? */
+ fits_get_hdu_num(infptr, &inhdupos); /* Get the current output HDU position */
+ fits_get_hdu_num(outfptr, &hdupos); /* Get the current output HDU position */
+ fits_get_hdrspace(outfptr, &numkeys, 0, status);
+
+ /* Was the input compressed HDU originally the primary array image? */
+ tstatus = 0;
+ if (!fits_read_card(infptr, "ZSIMPLE", card, &tstatus)) {
+ /* yes, input HDU was a primary array (not an IMAGE extension) */
+ /* Now determine if we can uncompress it into the primary array of */
+ /* the output file. This is only possible if the output file */
+ /* currently only contains a null primary array, with no addition */
+ /* header keywords and with no following extension in the FITS file. */
+
+ if (hdupos == 1) { /* are we positioned at the primary array? */
+ if (numkeys == 0) { /* primary HDU is completely empty */
+ nullprime = 1;
+ } else {
+ fits_get_img_param(outfptr, MAX_COMPRESS_DIM, &bitpix, &naxis, naxes, status);
+
+ if (naxis == 0) { /* is this a null image? */
+ nullprime = 1;
+
+ if (inhdupos == 2) /* must be at the first extension */
+ copyprime = 1;
+ }
+ }
+ }
+ }
+
+ if (nullprime) {
+ /* We will delete the existing keywords in the null primary array
+ and uncompress the input image into the primary array of the output.
+ Some of these keywords may be added back to the uncompressed image
+ header later.
+ */
+
+ for (ii = numkeys; ii > 0; ii--)
+ fits_delete_record(outfptr, ii, status);
+
+ } else {
+
+ /* if the ZTENSION keyword doesn't exist, then we have to
+ write the required keywords manually */
+ tstatus = 0;
+ if (fits_read_card(infptr, "ZTENSION", card, &tstatus)) {
+
+ /* create an empty output image with the correct dimensions */
+ if (ffcrim(outfptr, (infptr->Fptr)->zbitpix, (infptr->Fptr)->zndim,
+ (infptr->Fptr)->znaxis, status) > 0)
+ {
+ ffpmsg("error creating output decompressed image HDU");
+ return (*status);
+ }
+
+ norec = 1; /* the required keywords have already been written */
+
+ } else { /* the input compressed image does have ZTENSION keyword */
+
+ if (writeprime) { /* convert the image extension to a primary array */
+ /* have to write the required keywords manually */
+
+ /* create an empty output image with the correct dimensions */
+ if (ffcrim(outfptr, (infptr->Fptr)->zbitpix, (infptr->Fptr)->zndim,
+ (infptr->Fptr)->znaxis, status) > 0)
+ {
+ ffpmsg("error creating output decompressed image HDU");
+ return (*status);
+ }
+
+ norec = 1; /* the required keywords have already been written */
+
+ } else { /* write the input compressed image to an image extension */
+
+ if (numkeys == 0) { /* the output file is currently completely empty */
+
+ /* In this case, the input is a compressed IMAGE extension. */
+ /* Since the uncompressed output file is currently completely empty, */
+ /* we need to write a null primary array before uncompressing the */
+ /* image extension */
+
+ ffcrim(outfptr, 8, 0, naxes, status); /* naxes is not used */
+
+ /* now create the empty extension to uncompress into */
+ if (fits_create_hdu(outfptr, status) > 0)
+ {
+ ffpmsg("error creating output decompressed image HDU");
+ return (*status);
+ }
+
+ } else {
+ /* just create a new empty extension, then copy all the required */
+ /* keywords into it. */
+ fits_create_hdu(outfptr, status);
+ }
+ }
+ }
+
+ }
+
+ if (*status > 0) {
+ ffpmsg("error creating output decompressed image HDU");
+ return (*status);
+ }
+
+ /* Copy the table header to the image header. */
+
+ if (imcomp_copy_comp2img(infptr, outfptr, norec, status) > 0)
+ {
+ ffpmsg("error copying header keywords from compressed image");
+ }
+
+ if (copyprime) {
+ /* append any unexpected keywords from the primary array.
+ This includes any keywords except SIMPLE, BITPIX, NAXIS,
+ EXTEND, COMMENT, HISTORY, CHECKSUM, and DATASUM.
+ */
+
+ fits_movabs_hdu(infptr, 1, NULL, status); /* move to primary array */
+
+ /* do this so that any new keywords get written before any blank
+ keywords that may have been appended by imcomp_copy_comp2img */
+ fits_set_hdustruc(outfptr, status);
+
+ if (imcomp_copy_prime2img(infptr, outfptr, status) > 0)
+ {
+ ffpmsg("error copying primary keywords from compressed file");
+ }
+
+ fits_movabs_hdu(infptr, 2, NULL, status); /* move back to where we were */
+ }
+
+ return (*status);
+}
+/*---------------------------------------------------------------------------*/
+int fits_read_compressed_img(fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the array to be returned */
+ LONGLONG *infpixel, /* I - 'bottom left corner' of the subsection */
+ LONGLONG *inlpixel, /* I - 'top right corner' of the subsection */
+ long *ininc, /* I - increment to be applied in each dimension */
+ int nullcheck, /* I - 0 for no null checking */
+ /* 1: set undefined pixels = nullval */
+ /* 2: set nullarray=1 for undefined pixels */
+ void *nullval, /* I - value for undefined pixels */
+ void *array, /* O - array of values that are returned */
+ char *nullarray, /* O - array of flags = 1 if nullcheck = 2 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a section of a compressed image; Note: lpixel may be larger than the
+ size of the uncompressed image. Only the pixels within the image will be
+ returned.
+*/
+{
+ int naxis[MAX_COMPRESS_DIM], tiledim[MAX_COMPRESS_DIM];
+ long tilesize[MAX_COMPRESS_DIM], thistilesize[MAX_COMPRESS_DIM];
+ long ftile[MAX_COMPRESS_DIM], ltile[MAX_COMPRESS_DIM];
+ long tfpixel[MAX_COMPRESS_DIM], tlpixel[MAX_COMPRESS_DIM];
+ long rowdim[MAX_COMPRESS_DIM], offset[MAX_COMPRESS_DIM],ntemp;
+ long fpixel[MAX_COMPRESS_DIM], lpixel[MAX_COMPRESS_DIM];
+ long inc[MAX_COMPRESS_DIM];
+ int ii, i5, i4, i3, i2, i1, i0, ndim, irow, pixlen, tilenul;
+ void *buffer;
+ char *bnullarray = 0;
+ double testnullval = 0.;
+
+ if (*status > 0)
+ return(*status);
+
+ if (!fits_is_compressed_image(fptr, status) )
+ {
+ ffpmsg("CHDU is not a compressed image (fits_read_compressed_img)");
+ return(*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ /* get temporary space for uncompressing one image tile */
+ if (datatype == TSHORT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (short));
+ pixlen = sizeof(short);
+ if (nullval)
+ testnullval = *(short *) nullval;
+ }
+ else if (datatype == TINT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (int));
+ pixlen = sizeof(int);
+ if (nullval)
+ testnullval = *(int *) nullval;
+ }
+ else if (datatype == TLONG)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (long));
+ pixlen = sizeof(long);
+ if (nullval)
+ testnullval = *(long *) nullval;
+ }
+ else if (datatype == TFLOAT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (float));
+ pixlen = sizeof(float);
+ if (nullval)
+ testnullval = *(float *) nullval;
+ }
+ else if (datatype == TDOUBLE)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (double));
+ pixlen = sizeof(double);
+ if (nullval)
+ testnullval = *(double *) nullval;
+ }
+ else if (datatype == TUSHORT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (unsigned short));
+ pixlen = sizeof(short);
+ if (nullval)
+ testnullval = *(unsigned short *) nullval;
+ }
+ else if (datatype == TUINT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (unsigned int));
+ pixlen = sizeof(int);
+ if (nullval)
+ testnullval = *(unsigned int *) nullval;
+ }
+ else if (datatype == TULONG)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (unsigned long));
+ pixlen = sizeof(long);
+ if (nullval)
+ testnullval = *(unsigned long *) nullval;
+ }
+ else if (datatype == TBYTE || datatype == TSBYTE)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (char));
+ pixlen = 1;
+ if (nullval)
+ testnullval = *(unsigned char *) nullval;
+ }
+ else
+ {
+ ffpmsg("unsupported datatype for uncompressing image");
+ return(*status = BAD_DATATYPE);
+ }
+
+ /* If nullcheck ==1 and nullval == 0, then this means that the */
+ /* calling routine does not want to check for null pixels in the array */
+ if (nullcheck == 1 && testnullval == 0.)
+ nullcheck = 0;
+
+ if (buffer == NULL)
+ {
+ ffpmsg("Out of memory (fits_read_compress_img)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* allocate memory for a null flag array, if needed */
+ if (nullcheck == 2)
+ {
+ bnullarray = calloc ((fptr->Fptr)->maxtilelen, sizeof (char));
+
+ if (bnullarray == NULL)
+ {
+ ffpmsg("Out of memory (fits_read_compress_img)");
+ free(buffer);
+ return (*status = MEMORY_ALLOCATION);
+ }
+ }
+
+ /* initialize all the arrays */
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ naxis[ii] = 1;
+ tiledim[ii] = 1;
+ tilesize[ii] = 1;
+ ftile[ii] = 1;
+ ltile[ii] = 1;
+ rowdim[ii] = 1;
+ }
+
+ ndim = (fptr->Fptr)->zndim;
+ ntemp = 1;
+ for (ii = 0; ii < ndim; ii++)
+ {
+ /* support for mirror-reversed image sections */
+ if (infpixel[ii] <= inlpixel[ii])
+ {
+ fpixel[ii] = (long) infpixel[ii];
+ lpixel[ii] = (long) inlpixel[ii];
+ inc[ii] = ininc[ii];
+ }
+ else
+ {
+ fpixel[ii] = (long) inlpixel[ii];
+ lpixel[ii] = (long) infpixel[ii];
+ inc[ii] = -ininc[ii];
+ }
+
+ /* calc number of tiles in each dimension, and tile containing */
+ /* the first and last pixel we want to read in each dimension */
+ naxis[ii] = (fptr->Fptr)->znaxis[ii];
+ if (fpixel[ii] < 1)
+ {
+ if (nullcheck == 2)
+ {
+ free(bnullarray);
+ }
+ free(buffer);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ tilesize[ii] = (fptr->Fptr)->tilesize[ii];
+ tiledim[ii] = (naxis[ii] - 1) / tilesize[ii] + 1;
+ ftile[ii] = (fpixel[ii] - 1) / tilesize[ii] + 1;
+ ltile[ii] = minvalue((lpixel[ii] - 1) / tilesize[ii] + 1,
+ tiledim[ii]);
+ rowdim[ii] = ntemp; /* total tiles in each dimension */
+ ntemp *= tiledim[ii];
+ }
+
+ if (anynul)
+ *anynul = 0; /* initialize */
+
+ /* support up to 6 dimensions for now */
+ /* tfpixel and tlpixel are the first and last image pixels */
+ /* along each dimension of the compression tile */
+ for (i5 = ftile[5]; i5 <= ltile[5]; i5++)
+ {
+ tfpixel[5] = (i5 - 1) * tilesize[5] + 1;
+ tlpixel[5] = minvalue(tfpixel[5] + tilesize[5] - 1,
+ naxis[5]);
+ thistilesize[5] = tlpixel[5] - tfpixel[5] + 1;
+ offset[5] = (i5 - 1) * rowdim[5];
+ for (i4 = ftile[4]; i4 <= ltile[4]; i4++)
+ {
+ tfpixel[4] = (i4 - 1) * tilesize[4] + 1;
+ tlpixel[4] = minvalue(tfpixel[4] + tilesize[4] - 1,
+ naxis[4]);
+ thistilesize[4] = thistilesize[5] * (tlpixel[4] - tfpixel[4] + 1);
+ offset[4] = (i4 - 1) * rowdim[4] + offset[5];
+ for (i3 = ftile[3]; i3 <= ltile[3]; i3++)
+ {
+ tfpixel[3] = (i3 - 1) * tilesize[3] + 1;
+ tlpixel[3] = minvalue(tfpixel[3] + tilesize[3] - 1,
+ naxis[3]);
+ thistilesize[3] = thistilesize[4] * (tlpixel[3] - tfpixel[3] + 1);
+ offset[3] = (i3 - 1) * rowdim[3] + offset[4];
+ for (i2 = ftile[2]; i2 <= ltile[2]; i2++)
+ {
+ tfpixel[2] = (i2 - 1) * tilesize[2] + 1;
+ tlpixel[2] = minvalue(tfpixel[2] + tilesize[2] - 1,
+ naxis[2]);
+ thistilesize[2] = thistilesize[3] * (tlpixel[2] - tfpixel[2] + 1);
+ offset[2] = (i2 - 1) * rowdim[2] + offset[3];
+ for (i1 = ftile[1]; i1 <= ltile[1]; i1++)
+ {
+ tfpixel[1] = (i1 - 1) * tilesize[1] + 1;
+ tlpixel[1] = minvalue(tfpixel[1] + tilesize[1] - 1,
+ naxis[1]);
+ thistilesize[1] = thistilesize[2] * (tlpixel[1] - tfpixel[1] + 1);
+ offset[1] = (i1 - 1) * rowdim[1] + offset[2];
+ for (i0 = ftile[0]; i0 <= ltile[0]; i0++)
+ {
+ tfpixel[0] = (i0 - 1) * tilesize[0] + 1;
+ tlpixel[0] = minvalue(tfpixel[0] + tilesize[0] - 1,
+ naxis[0]);
+ thistilesize[0] = thistilesize[1] * (tlpixel[0] - tfpixel[0] + 1);
+ /* calculate row of table containing this tile */
+ irow = i0 + offset[1];
+
+/*
+printf("row %d, %d %d, %d %d, %d %d; %d\n",
+ irow, tfpixel[0],tlpixel[0],tfpixel[1],tlpixel[1],tfpixel[2],tlpixel[2],
+ thistilesize[0]);
+*/
+ /* read and uncompress this row (tile) of the table */
+ /* also do type conversion and undefined pixel substitution */
+ /* at this point */
+
+ imcomp_decompress_tile(fptr, irow, thistilesize[0],
+ datatype, nullcheck, nullval, buffer, bnullarray, &tilenul,
+ status);
+
+ if (tilenul && anynul)
+ *anynul = 1; /* there are null pixels */
+/*
+printf(" pixlen=%d, ndim=%d, %d %d %d, %d %d %d, %d %d %d\n",
+ pixlen, ndim, fpixel[0],lpixel[0],inc[0],fpixel[1],lpixel[1],inc[1],
+ fpixel[2],lpixel[2],inc[2]);
+*/
+ /* copy the intersecting pixels from this tile to the output */
+ imcomp_copy_overlap(buffer, pixlen, ndim, tfpixel, tlpixel,
+ bnullarray, array, fpixel, lpixel, inc, nullcheck,
+ nullarray, status);
+ }
+ }
+ }
+ }
+ }
+ }
+ if (nullcheck == 2)
+ {
+ free(bnullarray);
+ }
+ free(buffer);
+
+ return(*status);
+}
+/*---------------------------------------------------------------------------*/
+int fits_read_write_compressed_img(fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the array to be returned */
+ LONGLONG *infpixel, /* I - 'bottom left corner' of the subsection */
+ LONGLONG *inlpixel, /* I - 'top right corner' of the subsection */
+ long *ininc, /* I - increment to be applied in each dimension */
+ int nullcheck, /* I - 0 for no null checking */
+ /* 1: set undefined pixels = nullval */
+ void *nullval, /* I - value for undefined pixels */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ fitsfile *outfptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ This is similar to fits_read_compressed_img, except that it writes
+ the pixels to the output image, on a tile by tile basis instead of returning
+ the array.
+*/
+{
+ int naxis[MAX_COMPRESS_DIM], tiledim[MAX_COMPRESS_DIM];
+ long tilesize[MAX_COMPRESS_DIM], thistilesize[MAX_COMPRESS_DIM];
+ long ftile[MAX_COMPRESS_DIM], ltile[MAX_COMPRESS_DIM];
+ long tfpixel[MAX_COMPRESS_DIM], tlpixel[MAX_COMPRESS_DIM];
+ long rowdim[MAX_COMPRESS_DIM], offset[MAX_COMPRESS_DIM],ntemp;
+ long fpixel[MAX_COMPRESS_DIM], lpixel[MAX_COMPRESS_DIM];
+ long inc[MAX_COMPRESS_DIM];
+ int ii, i5, i4, i3, i2, i1, i0, ndim, irow, pixlen, tilenul;
+ void *buffer;
+ char *bnullarray = 0;
+ double testnullval = 0.;
+ LONGLONG firstelem;
+
+ if (*status > 0)
+ return(*status);
+
+ if (!fits_is_compressed_image(fptr, status) )
+ {
+ ffpmsg("CHDU is not a compressed image (fits_read_compressed_img)");
+ return(*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ /* get temporary space for uncompressing one image tile */
+ if (datatype == TSHORT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (short));
+ pixlen = sizeof(short);
+ if (nullval)
+ testnullval = *(short *) nullval;
+ }
+ else if (datatype == TINT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (int));
+ pixlen = sizeof(int);
+ if (nullval)
+ testnullval = *(int *) nullval;
+ }
+ else if (datatype == TLONG)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (long));
+ pixlen = sizeof(long);
+ if (nullval)
+ testnullval = *(long *) nullval;
+ }
+ else if (datatype == TFLOAT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (float));
+ pixlen = sizeof(float);
+ if (nullval)
+ testnullval = *(float *) nullval;
+ }
+ else if (datatype == TDOUBLE)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (double));
+ pixlen = sizeof(double);
+ if (nullval)
+ testnullval = *(double *) nullval;
+ }
+ else if (datatype == TUSHORT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (unsigned short));
+ pixlen = sizeof(short);
+ if (nullval)
+ testnullval = *(unsigned short *) nullval;
+ }
+ else if (datatype == TUINT)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (unsigned int));
+ pixlen = sizeof(int);
+ if (nullval)
+ testnullval = *(unsigned int *) nullval;
+ }
+ else if (datatype == TULONG)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (unsigned long));
+ pixlen = sizeof(long);
+ if (nullval)
+ testnullval = *(unsigned long *) nullval;
+ }
+ else if (datatype == TBYTE || datatype == TSBYTE)
+ {
+ buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (char));
+ pixlen = 1;
+ if (nullval)
+ testnullval = *(unsigned char *) nullval;
+ }
+ else
+ {
+ ffpmsg("unsupported datatype for uncompressing image");
+ return(*status = BAD_DATATYPE);
+ }
+
+ /* If nullcheck ==1 and nullval == 0, then this means that the */
+ /* calling routine does not want to check for null pixels in the array */
+ if (nullcheck == 1 && testnullval == 0.)
+ nullcheck = 0;
+
+ if (buffer == NULL)
+ {
+ ffpmsg("Out of memory (fits_read_compress_img)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* initialize all the arrays */
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ naxis[ii] = 1;
+ tiledim[ii] = 1;
+ tilesize[ii] = 1;
+ ftile[ii] = 1;
+ ltile[ii] = 1;
+ rowdim[ii] = 1;
+ }
+
+ ndim = (fptr->Fptr)->zndim;
+ ntemp = 1;
+ for (ii = 0; ii < ndim; ii++)
+ {
+ /* support for mirror-reversed image sections */
+ if (infpixel[ii] <= inlpixel[ii])
+ {
+ fpixel[ii] = (long) infpixel[ii];
+ lpixel[ii] = (long) inlpixel[ii];
+ inc[ii] = ininc[ii];
+ }
+ else
+ {
+ fpixel[ii] = (long) inlpixel[ii];
+ lpixel[ii] = (long) infpixel[ii];
+ inc[ii] = -ininc[ii];
+ }
+
+ /* calc number of tiles in each dimension, and tile containing */
+ /* the first and last pixel we want to read in each dimension */
+ naxis[ii] = (fptr->Fptr)->znaxis[ii];
+ if (fpixel[ii] < 1)
+ {
+ free(buffer);
+ return(*status = BAD_PIX_NUM);
+ }
+
+ tilesize[ii] = (fptr->Fptr)->tilesize[ii];
+ tiledim[ii] = (naxis[ii] - 1) / tilesize[ii] + 1;
+ ftile[ii] = (fpixel[ii] - 1) / tilesize[ii] + 1;
+ ltile[ii] = minvalue((lpixel[ii] - 1) / tilesize[ii] + 1,
+ tiledim[ii]);
+ rowdim[ii] = ntemp; /* total tiles in each dimension */
+ ntemp *= tiledim[ii];
+ }
+
+ if (anynul)
+ *anynul = 0; /* initialize */
+
+ firstelem = 1;
+
+ /* support up to 6 dimensions for now */
+ /* tfpixel and tlpixel are the first and last image pixels */
+ /* along each dimension of the compression tile */
+ for (i5 = ftile[5]; i5 <= ltile[5]; i5++)
+ {
+ tfpixel[5] = (i5 - 1) * tilesize[5] + 1;
+ tlpixel[5] = minvalue(tfpixel[5] + tilesize[5] - 1,
+ naxis[5]);
+ thistilesize[5] = tlpixel[5] - tfpixel[5] + 1;
+ offset[5] = (i5 - 1) * rowdim[5];
+ for (i4 = ftile[4]; i4 <= ltile[4]; i4++)
+ {
+ tfpixel[4] = (i4 - 1) * tilesize[4] + 1;
+ tlpixel[4] = minvalue(tfpixel[4] + tilesize[4] - 1,
+ naxis[4]);
+ thistilesize[4] = thistilesize[5] * (tlpixel[4] - tfpixel[4] + 1);
+ offset[4] = (i4 - 1) * rowdim[4] + offset[5];
+ for (i3 = ftile[3]; i3 <= ltile[3]; i3++)
+ {
+ tfpixel[3] = (i3 - 1) * tilesize[3] + 1;
+ tlpixel[3] = minvalue(tfpixel[3] + tilesize[3] - 1,
+ naxis[3]);
+ thistilesize[3] = thistilesize[4] * (tlpixel[3] - tfpixel[3] + 1);
+ offset[3] = (i3 - 1) * rowdim[3] + offset[4];
+ for (i2 = ftile[2]; i2 <= ltile[2]; i2++)
+ {
+ tfpixel[2] = (i2 - 1) * tilesize[2] + 1;
+ tlpixel[2] = minvalue(tfpixel[2] + tilesize[2] - 1,
+ naxis[2]);
+ thistilesize[2] = thistilesize[3] * (tlpixel[2] - tfpixel[2] + 1);
+ offset[2] = (i2 - 1) * rowdim[2] + offset[3];
+ for (i1 = ftile[1]; i1 <= ltile[1]; i1++)
+ {
+ tfpixel[1] = (i1 - 1) * tilesize[1] + 1;
+ tlpixel[1] = minvalue(tfpixel[1] + tilesize[1] - 1,
+ naxis[1]);
+ thistilesize[1] = thistilesize[2] * (tlpixel[1] - tfpixel[1] + 1);
+ offset[1] = (i1 - 1) * rowdim[1] + offset[2];
+ for (i0 = ftile[0]; i0 <= ltile[0]; i0++)
+ {
+ tfpixel[0] = (i0 - 1) * tilesize[0] + 1;
+ tlpixel[0] = minvalue(tfpixel[0] + tilesize[0] - 1,
+ naxis[0]);
+ thistilesize[0] = thistilesize[1] * (tlpixel[0] - tfpixel[0] + 1);
+ /* calculate row of table containing this tile */
+ irow = i0 + offset[1];
+
+ /* read and uncompress this row (tile) of the table */
+ /* also do type conversion and undefined pixel substitution */
+ /* at this point */
+
+ imcomp_decompress_tile(fptr, irow, thistilesize[0],
+ datatype, nullcheck, nullval, buffer, bnullarray, &tilenul,
+ status);
+
+ /* write the image to the output file */
+
+ if (tilenul && anynul) {
+ /* this assumes that the tiled pixels are in the same order
+ as in the uncompressed FITS image. This is not necessarily
+ the case, but it almost alway is in practice.
+ Note that null checking is not performed for integer images,
+ so this could only be a problem for tile compressed floating
+ point images that use an unconventional tiling pattern.
+ */
+ fits_write_imgnull(outfptr, datatype, firstelem, thistilesize[0],
+ buffer, nullval, status);
+ } else {
+ fits_write_subset(outfptr, datatype, tfpixel, tlpixel,
+ buffer, status);
+ }
+
+ firstelem += thistilesize[0];
+
+ }
+ }
+ }
+ }
+ }
+ }
+
+ free(buffer);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_read_compressed_pixels(fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the array to be returned */
+ LONGLONG fpixel, /* I - 'first pixel to read */
+ LONGLONG npixel, /* I - number of pixels to read */
+ int nullcheck, /* I - 0 for no null checking */
+ /* 1: set undefined pixels = nullval */
+ /* 2: set nullarray=1 for undefined pixels */
+ void *nullval, /* I - value for undefined pixels */
+ void *array, /* O - array of values that are returned */
+ char *nullarray, /* O - array of flags = 1 if nullcheck = 2 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ int *status) /* IO - error status */
+/*
+ Read a consecutive set of pixels from a compressed image. This routine
+ interpretes the n-dimensional image as a long one-dimensional array.
+ This is actually a rather inconvenient way to read compressed images in
+ general, and could be rather inefficient if the requested pixels to be
+ read are located in many different image compression tiles.
+
+ The general strategy used here is to read the requested pixels in blocks
+ that correspond to rectangular image sections.
+*/
+{
+ int naxis, ii, bytesperpixel, planenul;
+ long naxes[MAX_COMPRESS_DIM], nread;
+ long nplane, inc[MAX_COMPRESS_DIM];
+ LONGLONG tfirst, tlast, last0, last1, dimsize[MAX_COMPRESS_DIM];
+ LONGLONG firstcoord[MAX_COMPRESS_DIM], lastcoord[MAX_COMPRESS_DIM];
+ char *arrayptr, *nullarrayptr;
+
+ if (*status > 0)
+ return(*status);
+
+ arrayptr = (char *) array;
+ nullarrayptr = nullarray;
+
+ /* get size of array pixels, in bytes */
+ bytesperpixel = ffpxsz(datatype);
+
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ naxes[ii] = 1;
+ firstcoord[ii] = 0;
+ lastcoord[ii] = 0;
+ inc[ii] = 1;
+ }
+
+ /* determine the dimensions of the image to be read */
+ ffgidm(fptr, &naxis, status);
+ ffgisz(fptr, MAX_COMPRESS_DIM, naxes, status);
+
+ /* calc the cumulative number of pixels in each successive dimension */
+ dimsize[0] = 1;
+ for (ii = 1; ii < MAX_COMPRESS_DIM; ii++)
+ dimsize[ii] = dimsize[ii - 1] * naxes[ii - 1];
+
+ /* determine the coordinate of the first and last pixel in the image */
+ /* Use zero based indexes here */
+ tfirst = fpixel - 1;
+ tlast = tfirst + npixel - 1;
+ for (ii = naxis - 1; ii >= 0; ii--)
+ {
+ firstcoord[ii] = tfirst / dimsize[ii];
+ lastcoord[ii] = tlast / dimsize[ii];
+ tfirst = tfirst - firstcoord[ii] * dimsize[ii];
+ tlast = tlast - lastcoord[ii] * dimsize[ii];
+ }
+
+ /* to simplify things, treat 1-D, 2-D, and 3-D images as separate cases */
+
+ if (naxis == 1)
+ {
+ /* Simple: just read the requested range of pixels */
+
+ firstcoord[0] = firstcoord[0] + 1;
+ lastcoord[0] = lastcoord[0] + 1;
+ fits_read_compressed_img(fptr, datatype, firstcoord, lastcoord, inc,
+ nullcheck, nullval, array, nullarray, anynul, status);
+ return(*status);
+ }
+ else if (naxis == 2)
+ {
+ nplane = 0; /* read 1st (and only) plane of the image */
+
+ fits_read_compressed_img_plane(fptr, datatype, bytesperpixel,
+ nplane, firstcoord, lastcoord, inc, naxes, nullcheck, nullval,
+ array, nullarray, anynul, &nread, status);
+ }
+ else if (naxis == 3)
+ {
+ /* test for special case: reading an integral number of planes */
+ if (firstcoord[0] == 0 && firstcoord[1] == 0 &&
+ lastcoord[0] == naxes[0] - 1 && lastcoord[1] == naxes[1] - 1)
+ {
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ /* convert from zero base to 1 base */
+ (firstcoord[ii])++;
+ (lastcoord[ii])++;
+ }
+
+ /* we can read the contiguous block of pixels in one go */
+ fits_read_compressed_img(fptr, datatype, firstcoord, lastcoord, inc,
+ nullcheck, nullval, array, nullarray, anynul, status);
+
+ return(*status);
+ }
+
+ if (anynul)
+ *anynul = 0; /* initialize */
+
+ /* save last coordinate in temporary variables */
+ last0 = lastcoord[0];
+ last1 = lastcoord[1];
+
+ if (firstcoord[2] < lastcoord[2])
+ {
+ /* we will read up to the last pixel in all but the last plane */
+ lastcoord[0] = naxes[0] - 1;
+ lastcoord[1] = naxes[1] - 1;
+ }
+
+ /* read one plane of the cube at a time, for simplicity */
+ for (nplane = (long) firstcoord[2]; nplane <= lastcoord[2]; nplane++)
+ {
+ if (nplane == lastcoord[2])
+ {
+ lastcoord[0] = last0;
+ lastcoord[1] = last1;
+ }
+
+ fits_read_compressed_img_plane(fptr, datatype, bytesperpixel,
+ nplane, firstcoord, lastcoord, inc, naxes, nullcheck, nullval,
+ arrayptr, nullarrayptr, &planenul, &nread, status);
+
+ if (planenul && anynul)
+ *anynul = 1; /* there are null pixels */
+
+ /* for all subsequent planes, we start with the first pixel */
+ firstcoord[0] = 0;
+ firstcoord[1] = 0;
+
+ /* increment pointers to next elements to be read */
+ arrayptr = arrayptr + nread * bytesperpixel;
+ if (nullarrayptr && (nullcheck == 2) )
+ nullarrayptr = nullarrayptr + nread;
+ }
+ }
+ else
+ {
+ ffpmsg("only 1D, 2D, or 3D images are currently supported");
+ return(*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_read_compressed_img_plane(fitsfile *fptr, /* I - FITS file */
+ int datatype, /* I - datatype of the array to be returned */
+ int bytesperpixel, /* I - number of bytes per pixel in array */
+ long nplane, /* I - which plane of the cube to read */
+ LONGLONG *firstcoord, /* coordinate of first pixel to read */
+ LONGLONG *lastcoord, /* coordinate of last pixel to read */
+ long *inc, /* increment of pixels to read */
+ long *naxes, /* size of each image dimension */
+ int nullcheck, /* I - 0 for no null checking */
+ /* 1: set undefined pixels = nullval */
+ /* 2: set nullarray=1 for undefined pixels */
+ void *nullval, /* I - value for undefined pixels */
+ void *array, /* O - array of values that are returned */
+ char *nullarray, /* O - array of flags = 1 if nullcheck = 2 */
+ int *anynul, /* O - set to 1 if any values are null; else 0 */
+ long *nread, /* O - total number of pixels read and returned*/
+ int *status) /* IO - error status */
+
+ /*
+ in general we have to read the first partial row of the image,
+ followed by the middle complete rows, followed by the last
+ partial row of the image. If the first or last rows are complete,
+ then read them at the same time as all the middle rows.
+ */
+{
+ /* bottom left coord. and top right coord. */
+ LONGLONG blc[MAX_COMPRESS_DIM], trc[MAX_COMPRESS_DIM];
+ char *arrayptr, *nullarrayptr;
+ int tnull;
+
+ if (anynul)
+ *anynul = 0;
+
+ *nread = 0;
+
+ arrayptr = (char *) array;
+ nullarrayptr = nullarray;
+
+ blc[2] = nplane + 1;
+ trc[2] = nplane + 1;
+
+ if (firstcoord[0] != 0)
+ {
+ /* have to read a partial first row */
+ blc[0] = firstcoord[0] + 1;
+ blc[1] = firstcoord[1] + 1;
+ trc[1] = blc[1];
+ if (lastcoord[1] == firstcoord[1])
+ trc[0] = lastcoord[0] + 1; /* 1st and last pixels in same row */
+ else
+ trc[0] = naxes[0]; /* read entire rest of the row */
+
+ fits_read_compressed_img(fptr, datatype, blc, trc, inc,
+ nullcheck, nullval, arrayptr, nullarrayptr, &tnull, status);
+
+ *nread = *nread + (long) (trc[0] - blc[0] + 1);
+
+ if (tnull && anynul)
+ *anynul = 1; /* there are null pixels */
+
+ if (lastcoord[1] == firstcoord[1])
+ {
+ return(*status); /* finished */
+ }
+
+ /* set starting coord to beginning of next line */
+ firstcoord[0] = 0;
+ firstcoord[1] += 1;
+ arrayptr = arrayptr + (trc[0] - blc[0] + 1) * bytesperpixel;
+ if (nullarrayptr && (nullcheck == 2) )
+ nullarrayptr = nullarrayptr + (trc[0] - blc[0] + 1);
+
+ }
+
+ /* read contiguous complete rows of the image, if any */
+ blc[0] = 1;
+ blc[1] = firstcoord[1] + 1;
+ trc[0] = naxes[0];
+
+ if (lastcoord[0] + 1 == naxes[0])
+ {
+ /* can read the last complete row, too */
+ trc[1] = lastcoord[1] + 1;
+ }
+ else
+ {
+ /* last row is incomplete; have to read it separately */
+ trc[1] = lastcoord[1];
+ }
+
+ if (trc[1] >= blc[1]) /* must have at least one whole line to read */
+ {
+ fits_read_compressed_img(fptr, datatype, blc, trc, inc,
+ nullcheck, nullval, arrayptr, nullarrayptr, &tnull, status);
+
+ *nread = *nread + (long) ((trc[1] - blc[1] + 1) * naxes[0]);
+
+ if (tnull && anynul)
+ *anynul = 1;
+
+ if (lastcoord[1] + 1 == trc[1])
+ return(*status); /* finished */
+
+ /* increment pointers for the last partial row */
+ arrayptr = arrayptr + (trc[1] - blc[1] + 1) * naxes[0] * bytesperpixel;
+ if (nullarrayptr && (nullcheck == 2) )
+ nullarrayptr = nullarrayptr + (trc[1] - blc[1] + 1) * naxes[0];
+ }
+
+ if (trc[1] == lastcoord[1] + 1)
+ return(*status); /* all done */
+
+ /* set starting and ending coord to last line */
+
+ trc[0] = lastcoord[0] + 1;
+ trc[1] = lastcoord[1] + 1;
+ blc[1] = trc[1];
+
+ fits_read_compressed_img(fptr, datatype, blc, trc, inc,
+ nullcheck, nullval, arrayptr, nullarrayptr, &tnull, status);
+
+ if (tnull && anynul)
+ *anynul = 1;
+
+ *nread = *nread + (long) (trc[0] - blc[0] + 1);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_get_compressed_image_par(fitsfile *infptr, int *status)
+
+/*
+ This routine reads keywords from a BINTABLE extension containing a
+ compressed image.
+*/
+{
+ char keyword[FLEN_KEYWORD];
+ char value[FLEN_VALUE];
+ int ii, tstatus, doffset;
+ long expect_nrows, maxtilelen;
+
+ if (*status > 0)
+ return(*status);
+
+ /* Copy relevant header keyword values to structure */
+ if (ffgky (infptr, TSTRING, "ZCMPTYPE", value, NULL, status) > 0)
+ {
+ ffpmsg("required ZCMPTYPE compression keyword not found in");
+ ffpmsg(" imcomp_get_compressed_image_par");
+ return(*status);
+ }
+
+ (infptr->Fptr)->zcmptype[0] = '\0';
+ strncat((infptr->Fptr)->zcmptype, value, 11);
+
+ if (!FSTRCMP(value, "RICE_1") )
+ (infptr->Fptr)->compress_type = RICE_1;
+ else if (!FSTRCMP(value, "HCOMPRESS_1") )
+ (infptr->Fptr)->compress_type = HCOMPRESS_1;
+ else if (!FSTRCMP(value, "GZIP_1") )
+ (infptr->Fptr)->compress_type = GZIP_1;
+ else if (!FSTRCMP(value, "GZIP_2") )
+ (infptr->Fptr)->compress_type = GZIP_2;
+ else if (!FSTRCMP(value, "BZIP2_1") )
+ (infptr->Fptr)->compress_type = BZIP2_1;
+ else if (!FSTRCMP(value, "PLIO_1") )
+ (infptr->Fptr)->compress_type = PLIO_1;
+ else if (!FSTRCMP(value, "NOCOMPRESS") )
+ (infptr->Fptr)->compress_type = NOCOMPRESS;
+ else
+ {
+ ffpmsg("Unknown image compression type:");
+ ffpmsg(value);
+ return (*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ /* get the floating point to integer quantization type, if present. */
+ /* FITS files produced before 2009 will not have this keyword */
+ tstatus = 0;
+ if (ffgky(infptr, TSTRING, "ZQUANTIZ", value, NULL, &tstatus) > 0)
+ {
+ (infptr->Fptr)->quantize_dither = 0;
+ } else {
+ if (!FSTRCMP(value, "NONE") )
+ (infptr->Fptr)->quantize_level = NO_QUANTIZE;
+ else if (!FSTRCMP(value, "SUBTRACTIVE_DITHER_1") )
+ (infptr->Fptr)->quantize_dither = SUBTRACTIVE_DITHER_1;
+ else
+ (infptr->Fptr)->quantize_dither = 0;
+ }
+
+ /* get the floating point quantization dithering offset, if present. */
+ /* FITS files produced before October 2009 will not have this keyword */
+ tstatus = 0;
+ if (ffgky(infptr, TINT, "ZDITHER0", &doffset, NULL, &tstatus) > 0)
+ {
+ /* by default start with 1st element of random sequence */
+ (infptr->Fptr)->dither_offset = 1;
+ } else {
+ (infptr->Fptr)->dither_offset = doffset;
+ }
+
+ if (ffgky (infptr, TINT, "ZBITPIX", &(infptr->Fptr)->zbitpix,
+ NULL, status) > 0)
+ {
+ ffpmsg("required ZBITPIX compression keyword not found");
+ return(*status);
+ }
+
+ if (ffgky (infptr,TINT, "ZNAXIS", &(infptr->Fptr)->zndim, NULL, status) > 0)
+ {
+ ffpmsg("required ZNAXIS compression keyword not found");
+ return(*status);
+ }
+
+ if ((infptr->Fptr)->zndim < 1)
+ {
+ ffpmsg("Compressed image has no data (ZNAXIS < 1)");
+ return (*status = BAD_NAXIS);
+ }
+
+ if ((infptr->Fptr)->zndim > MAX_COMPRESS_DIM)
+ {
+ ffpmsg("Compressed image has too many dimensions");
+ return(*status = BAD_NAXIS);
+ }
+
+ expect_nrows = 1;
+ maxtilelen = 1;
+ for (ii = 0; ii < (infptr->Fptr)->zndim; ii++)
+ {
+ /* get image size */
+ sprintf (keyword, "ZNAXIS%d", ii+1);
+ ffgky (infptr, TLONG,keyword, &(infptr->Fptr)->znaxis[ii],NULL,status);
+
+ if (*status > 0)
+ {
+ ffpmsg("required ZNAXISn compression keyword not found");
+ return(*status);
+ }
+
+ /* get compression tile size */
+ sprintf (keyword, "ZTILE%d", ii+1);
+
+ /* set default tile size in case keywords are not present */
+ if (ii == 0)
+ (infptr->Fptr)->tilesize[0] = (infptr->Fptr)->znaxis[0];
+ else
+ (infptr->Fptr)->tilesize[ii] = 1;
+
+ tstatus = 0;
+ ffgky (infptr, TLONG, keyword, &(infptr->Fptr)->tilesize[ii], NULL,
+ &tstatus);
+
+ expect_nrows *= (((infptr->Fptr)->znaxis[ii] - 1) /
+ (infptr->Fptr)->tilesize[ii]+ 1);
+ maxtilelen *= (infptr->Fptr)->tilesize[ii];
+ }
+
+ /* check number of rows */
+ if (expect_nrows != (infptr->Fptr)->numrows)
+ {
+ ffpmsg(
+ "number of table rows != the number of tiles in compressed image");
+ return (*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ /* read any algorithm specific parameters */
+ if ((infptr->Fptr)->compress_type == RICE_1 )
+ {
+ if (ffgky(infptr, TINT,"ZVAL1", &(infptr->Fptr)->rice_blocksize,
+ NULL, status) > 0)
+ {
+ ffpmsg("required ZVAL1 compression keyword not found");
+ return(*status);
+ }
+
+ tstatus = 0;
+ if (ffgky(infptr, TINT,"ZVAL2", &(infptr->Fptr)->rice_bytepix,
+ NULL, &tstatus) > 0)
+ {
+ (infptr->Fptr)->rice_bytepix = 4; /* default value */
+ }
+
+ if ((infptr->Fptr)->rice_blocksize < 16 &&
+ (infptr->Fptr)->rice_bytepix > 8) {
+ /* values are reversed */
+ tstatus = (infptr->Fptr)->rice_bytepix;
+ (infptr->Fptr)->rice_bytepix = (infptr->Fptr)->rice_blocksize;
+ (infptr->Fptr)->rice_blocksize = tstatus;
+ }
+ } else if ((infptr->Fptr)->compress_type == HCOMPRESS_1 ) {
+
+ if (ffgky(infptr, TFLOAT,"ZVAL1", &(infptr->Fptr)->hcomp_scale,
+ NULL, status) > 0)
+ {
+ ffpmsg("required ZVAL1 compression keyword not found");
+ return(*status);
+ }
+
+ tstatus = 0;
+ ffgky(infptr, TINT,"ZVAL2", &(infptr->Fptr)->hcomp_smooth,
+ NULL, &tstatus);
+ }
+
+ /* store number of pixels in each compression tile, */
+ /* and max size of the compressed tile buffer */
+ (infptr->Fptr)->maxtilelen = maxtilelen;
+
+ (infptr->Fptr)->maxelem =
+ imcomp_calc_max_elem ((infptr->Fptr)->compress_type, maxtilelen,
+ (infptr->Fptr)->zbitpix, (infptr->Fptr)->rice_blocksize);
+
+ /* Get Column numbers. */
+ if (ffgcno(infptr, CASEINSEN, "COMPRESSED_DATA",
+ &(infptr->Fptr)->cn_compressed, status) > 0)
+ {
+ ffpmsg("couldn't find COMPRESSED_DATA column (fits_get_compressed_img_par)");
+ return(*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ ffpmrk(); /* put mark on message stack; erase any messages after this */
+
+ tstatus = 0;
+ ffgcno(infptr,CASEINSEN, "UNCOMPRESSED_DATA",
+ &(infptr->Fptr)->cn_uncompressed, &tstatus);
+
+ tstatus = 0;
+ ffgcno(infptr,CASEINSEN, "GZIP_COMPRESSED_DATA",
+ &(infptr->Fptr)->cn_gzip_data, &tstatus);
+
+ tstatus = 0;
+ if (ffgcno(infptr, CASEINSEN, "ZSCALE", &(infptr->Fptr)->cn_zscale,
+ &tstatus) > 0)
+ {
+ /* CMPSCALE column doesn't exist; see if there is a keyword */
+ tstatus = 0;
+ if (ffgky(infptr, TDOUBLE, "ZSCALE", &(infptr->Fptr)->zscale, NULL,
+ &tstatus) <= 0)
+ (infptr->Fptr)->cn_zscale = -1; /* flag for a constant ZSCALE */
+ }
+
+ tstatus = 0;
+ if (ffgcno(infptr, CASEINSEN, "ZZERO", &(infptr->Fptr)->cn_zzero,
+ &tstatus) > 0)
+ {
+ /* CMPZERO column doesn't exist; see if there is a keyword */
+ tstatus = 0;
+ if (ffgky(infptr, TDOUBLE, "ZZERO", &(infptr->Fptr)->zzero, NULL,
+ &tstatus) <= 0)
+ (infptr->Fptr)->cn_zzero = -1; /* flag for a constant ZZERO */
+ }
+
+ tstatus = 0;
+ if (ffgcno(infptr, CASEINSEN, "ZBLANK", &(infptr->Fptr)->cn_zblank,
+ &tstatus) > 0)
+ {
+ /* ZBLANK column doesn't exist; see if there is a keyword */
+ tstatus = 0;
+ if (ffgky(infptr, TINT, "ZBLANK", &(infptr->Fptr)->zblank, NULL,
+ &tstatus) <= 0) {
+ (infptr->Fptr)->cn_zblank = -1; /* flag for a constant ZBLANK */
+
+ } else {
+ /* ZBLANK keyword doesn't exist; see if there is a BLANK keyword */
+ tstatus = 0;
+ if (ffgky(infptr, TINT, "BLANK", &(infptr->Fptr)->zblank, NULL,
+ &tstatus) <= 0)
+ (infptr->Fptr)->cn_zblank = -1; /* flag for a constant ZBLANK */
+ }
+ }
+
+ /* read the conventional BSCALE and BZERO scaling keywords, if present */
+ tstatus = 0;
+ if (ffgky (infptr, TDOUBLE, "BSCALE", &(infptr->Fptr)->cn_bscale,
+ NULL, &tstatus) > 0)
+ {
+ (infptr->Fptr)->cn_bscale = 1.0;
+ }
+
+ tstatus = 0;
+ if (ffgky (infptr, TDOUBLE, "BZERO", &(infptr->Fptr)->cn_bzero,
+ NULL, &tstatus) > 0)
+ {
+ (infptr->Fptr)->cn_bzero = 0.0;
+ (infptr->Fptr)->cn_actual_bzero = 0.0;
+ } else {
+ (infptr->Fptr)->cn_actual_bzero = (infptr->Fptr)->cn_bzero;
+ }
+
+ ffcmrk(); /* clear any spurious error messages, back to the mark */
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_copy_imheader(fitsfile *infptr, fitsfile *outfptr, int *status)
+/*
+ This routine reads the header keywords from the input image and
+ copies them to the output image; the manditory structural keywords
+ and the checksum keywords are not copied. If the DATE keyword is copied,
+ then it is updated with the current date and time.
+*/
+{
+ int nkeys, ii, keyclass;
+ char card[FLEN_CARD]; /* a header record */
+
+ if (*status > 0)
+ return(*status);
+
+ ffghsp(infptr, &nkeys, NULL, status); /* get number of keywords in image */
+
+ for (ii = 5; ii <= nkeys; ii++) /* skip the first 4 keywords */
+ {
+ ffgrec(infptr, ii, card, status);
+
+ keyclass = ffgkcl(card); /* Get the type/class of keyword */
+
+ /* don't copy structural keywords or checksum keywords */
+ if ((keyclass <= TYP_CMPRS_KEY) || (keyclass == TYP_CKSUM_KEY))
+ continue;
+
+ if (FSTRNCMP(card, "DATE ", 5) == 0) /* write current date */
+ {
+ ffpdat(outfptr, status);
+ }
+ else if (FSTRNCMP(card, "EXTNAME ", 8) == 0)
+ {
+ /* don't copy default EXTNAME keyword from a compressed image */
+ if (FSTRNCMP(card, "EXTNAME = 'COMPRESSED_IMAGE'", 28))
+ {
+ /* if EXTNAME keyword already exists, overwrite it */
+ /* otherwise append a new EXTNAME keyword */
+ ffucrd(outfptr, "EXTNAME", card, status);
+ }
+ }
+ else
+ {
+ /* just copy the keyword to the output header */
+ ffprec (outfptr, card, status);
+ }
+
+ if (*status > 0)
+ return (*status);
+ }
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_copy_img2comp(fitsfile *infptr, fitsfile *outfptr, int *status)
+/*
+ This routine copies the header keywords from the uncompressed input image
+ and to the compressed image (in a binary table)
+*/
+{
+ char card[FLEN_CARD], card2[FLEN_CARD]; /* a header record */
+ int nkeys, nmore, ii, jj, tstatus, bitpix;
+
+ /* tile compressed image keyword translation table */
+ /* INPUT OUTPUT */
+ /* 01234567 01234567 */
+ char *patterns[][2] = {{"SIMPLE", "ZSIMPLE" },
+ {"XTENSION", "ZTENSION" },
+ {"BITPIX", "ZBITPIX" },
+ {"NAXIS", "ZNAXIS" },
+ {"NAXISm", "ZNAXISm" },
+ {"EXTEND", "ZEXTEND" },
+ {"BLOCKED", "ZBLOCKED"},
+ {"PCOUNT", "ZPCOUNT" },
+ {"GCOUNT", "ZGCOUNT" },
+
+ {"CHECKSUM","ZHECKSUM"}, /* save original checksums */
+ {"DATASUM", "ZDATASUM"},
+
+ {"*", "+" }}; /* copy all other keywords */
+ int npat;
+
+ if (*status > 0)
+ return(*status);
+
+ /* write a default EXTNAME keyword if it doesn't exist in input file*/
+ fits_read_card(infptr, "EXTNAME", card, status);
+
+ if (*status) {
+ *status = 0;
+ strcpy(card, "EXTNAME = 'COMPRESSED_IMAGE'");
+ fits_write_record(outfptr, card, status);
+ }
+
+ /* copy all the keywords from the input file to the output */
+ npat = sizeof(patterns)/sizeof(patterns[0][0])/2;
+ fits_translate_keywords(infptr, outfptr, 1, patterns, npat,
+ 0, 0, 0, status);
+
+
+ if ( (outfptr->Fptr)->request_lossy_int_compress != 0) {
+
+ /* request was made to compress integer images as if they had float pixels. */
+ /* If input image has positive bitpix value, then reset the output ZBITPIX */
+ /* value to -32. */
+
+ fits_read_key(infptr, TINT, "BITPIX", &bitpix, NULL, status);
+
+ if (*status <= 0 && bitpix > 0) {
+ fits_modify_key_lng(outfptr, "ZBITPIX", -32, NULL, status);
+
+ /* also delete the BSCALE, BZERO, and BLANK keywords */
+ tstatus = 0;
+ fits_delete_key(outfptr, "BSCALE", &tstatus);
+ tstatus = 0;
+ fits_delete_key(outfptr, "BZERO", &tstatus);
+ tstatus = 0;
+ fits_delete_key(outfptr, "BLANK", &tstatus);
+ }
+ }
+
+ /*
+ For compatibility with software that uses an older version of CFITSIO,
+ we must make certain that the new ZQUANTIZ keyword, if it exists, must
+ occur after the other peudo-required keywords (e.g., ZSIMPLE, ZBITPIX,
+ etc.). Do this by trying to delete the keyword. If that succeeds (and
+ thus the keyword did exist) then rewrite the keyword at the end of header.
+ In principle this should not be necessary once all software has upgraded
+ to a newer version of CFITSIO (version number greater than 3.181, newer
+ than August 2009).
+
+ Do the same for the new ZDITHER0 keyword.
+ */
+
+ tstatus = 0;
+ if (fits_read_card(outfptr, "ZQUANTIZ", card, &tstatus) == 0)
+ {
+ fits_delete_key(outfptr, "ZQUANTIZ", status);
+
+ /* rewrite the deleted keyword at the end of the header */
+ fits_write_record(outfptr, card, status);
+
+ fits_write_history(outfptr,
+ "Image was compressed by CFITSIO using scaled integer quantization:", status);
+ sprintf(card2, " q = %f / quantized level scaling parameter",
+ (outfptr->Fptr)->quantize_level);
+ fits_write_history(outfptr, card2, status);
+ fits_write_history(outfptr, card+10, status);
+ }
+
+ tstatus = 0;
+ if (fits_read_card(outfptr, "ZDITHER0", card, &tstatus) == 0)
+ {
+ fits_delete_key(outfptr, "ZDITHER0", status);
+
+ /* rewrite the deleted keyword at the end of the header */
+ fits_write_record(outfptr, card, status);
+ }
+
+
+ ffghsp(infptr, &nkeys, &nmore, status); /* get number of keywords in image */
+
+ nmore = nmore / 36; /* how many completely empty header blocks are there? */
+
+ /* preserve the same number of spare header blocks in the output header */
+
+ for (jj = 0; jj < nmore; jj++)
+ for (ii = 0; ii < 36; ii++)
+ fits_write_record(outfptr, " ", status);
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_copy_comp2img(fitsfile *infptr, fitsfile *outfptr,
+ int norec, int *status)
+/*
+ This routine copies the header keywords from the compressed input image
+ and to the uncompressed image (in a binary table)
+*/
+{
+ char card[FLEN_CARD]; /* a header record */
+ char *patterns[40][2];
+ char negative[] = "-";
+ int ii,jj, npat, nreq, nsp, tstatus = 0;
+ int nkeys, nmore;
+
+ /* tile compressed image keyword translation table */
+ /* INPUT OUTPUT */
+ /* 01234567 01234567 */
+
+ /* only translate these if required keywords not already written */
+ char *reqkeys[][2] = {
+ {"ZSIMPLE", "SIMPLE" },
+ {"ZTENSION", "XTENSION"},
+ {"ZBITPIX", "BITPIX" },
+ {"ZNAXIS", "NAXIS" },
+ {"ZNAXISm", "NAXISm" },
+ {"ZEXTEND", "EXTEND" },
+ {"ZBLOCKED", "BLOCKED"},
+ {"ZPCOUNT", "PCOUNT" },
+ {"ZGCOUNT", "GCOUNT" },
+ {"ZHECKSUM", "CHECKSUM"}, /* restore original checksums */
+ {"ZDATASUM", "DATASUM"}};
+
+ /* other special keywords */
+ char *spkeys[][2] = {
+ {"XTENSION", "-" },
+ {"BITPIX", "-" },
+ {"NAXIS", "-" },
+ {"NAXISm", "-" },
+ {"PCOUNT", "-" },
+ {"GCOUNT", "-" },
+ {"TFIELDS", "-" },
+ {"TTYPEm", "-" },
+ {"TFORMm", "-" },
+ {"ZIMAGE", "-" },
+ {"ZQUANTIZ", "-" },
+ {"ZDITHER0", "-" },
+ {"ZTILEm", "-" },
+ {"ZCMPTYPE", "-" },
+ {"ZBLANK", "-" },
+ {"ZNAMEm", "-" },
+ {"ZVALm", "-" },
+
+ {"CHECKSUM","-" }, /* delete checksums */
+ {"DATASUM", "-" },
+ {"EXTNAME", "+" }, /* we may change this, below */
+ {"*", "+" }};
+
+
+ if (*status > 0)
+ return(*status);
+
+ nreq = sizeof(reqkeys)/sizeof(reqkeys[0][0])/2;
+ nsp = sizeof(spkeys)/sizeof(spkeys[0][0])/2;
+
+ /* construct translation patterns */
+
+ for (ii = 0; ii < nreq; ii++) {
+ patterns[ii][0] = reqkeys[ii][0];
+
+ if (norec)
+ patterns[ii][1] = negative;
+ else
+ patterns[ii][1] = reqkeys[ii][1];
+ }
+
+ for (ii = 0; ii < nsp; ii++) {
+ patterns[ii+nreq][0] = spkeys[ii][0];
+ patterns[ii+nreq][1] = spkeys[ii][1];
+ }
+
+ npat = nreq + nsp;
+
+ /* see if the EXTNAME keyword should be copied or not */
+ fits_read_card(infptr, "EXTNAME", card, &tstatus);
+
+ if (tstatus == 0) {
+ if (!strncmp(card, "EXTNAME = 'COMPRESSED_IMAGE'", 28))
+ patterns[npat-2][1] = negative;
+ }
+
+ /* translate and copy the keywords from the input file to the output */
+ fits_translate_keywords(infptr, outfptr, 1, patterns, npat,
+ 0, 0, 0, status);
+
+ ffghsp(infptr, &nkeys, &nmore, status); /* get number of keywords in image */
+
+ nmore = nmore / 36; /* how many completely empty header blocks are there? */
+
+ /* preserve the same number of spare header blocks in the output header */
+
+ for (jj = 0; jj < nmore; jj++)
+ for (ii = 0; ii < 36; ii++)
+ fits_write_record(outfptr, " ", status);
+
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_copy_prime2img(fitsfile *infptr, fitsfile *outfptr, int *status)
+/*
+ This routine copies any unexpected keywords from the primary array
+ of the compressed input image into the header of the uncompressed image
+ (which is the primary array of the output file).
+*/
+{
+ int nsp;
+
+ /* keywords that will not be copied */
+ char *spkeys[][2] = {
+ {"SIMPLE", "-" },
+ {"BITPIX", "-" },
+ {"NAXIS", "-" },
+ {"NAXISm", "-" },
+ {"PCOUNT", "-" },
+ {"EXTEND", "-" },
+ {"GCOUNT", "-" },
+ {"CHECKSUM","-" },
+ {"DATASUM", "-" },
+ {"EXTNAME", "-" },
+ {"HISTORY", "-" },
+ {"COMMENT", "-" },
+ {"*", "+" }};
+
+ if (*status > 0)
+ return(*status);
+
+ nsp = sizeof(spkeys)/sizeof(spkeys[0][0])/2;
+
+ /* translate and copy the keywords from the input file to the output */
+ fits_translate_keywords(infptr, outfptr, 1, spkeys, nsp,
+ 0, 0, 0, status);
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_decompress_tile (fitsfile *infptr,
+ int nrow, /* I - row of table to read and uncompress */
+ int tilelen, /* I - number of pixels in the tile */
+ int datatype, /* I - datatype to be returned in 'buffer' */
+ int nullcheck, /* I - 0 for no null checking */
+ void *nulval, /* I - value to be used for undefined pixels */
+ void *buffer, /* O - buffer for returned decompressed values */
+ char *bnullarray, /* O - buffer for returned null flags */
+ int *anynul, /* O - any null values returned? */
+ int *status)
+
+/* This routine decompresses one tile of the image */
+{
+ int *idata = 0;
+ int tiledatatype, pixlen; /* uncompressed integer data */
+ size_t idatalen, tilebytesize;
+ int ii, tnull; /* value in the data which represents nulls */
+ unsigned char *cbuf; /* compressed data */
+ unsigned char charnull = 0;
+ short snull = 0;
+ int blocksize;
+ float fnulval=0;
+ float *tempfloat = 0;
+ double dnulval=0;
+ double bscale, bzero, actual_bzero, dummy = 0; /* scaling parameters */
+ long nelem = 0, offset = 0, tilesize; /* number of bytes */
+ int smooth, nx, ny, scale; /* hcompress parameters */
+
+ if (*status > 0)
+ return(*status);
+
+ /* **************************************************************** */
+ /* check if this tile was cached; if so, just copy it out */
+ if (nrow == (infptr->Fptr)->tilerow && datatype == (infptr->Fptr)->tiletype ) {
+
+ memcpy(buffer, (infptr->Fptr)->tiledata, (infptr->Fptr)->tiledatasize);
+
+ if (nullcheck == 2)
+ memcpy(bnullarray, (infptr->Fptr)->tilenullarray, tilelen);
+
+ *anynul = (infptr->Fptr)->tileanynull;
+ return(*status);
+ }
+
+ /* **************************************************************** */
+ /* get length of the compressed byte stream */
+ ffgdes (infptr, (infptr->Fptr)->cn_compressed, nrow, &nelem, &offset,
+ status);
+
+ /* EOF error here indicates that this tile has not yet been written */
+ if (*status == END_OF_FILE)
+ return(*status = NO_COMPRESSED_TILE);
+
+ /* **************************************************************** */
+ if (nelem == 0) /* special case: tile was not compressed normally */
+ {
+ if ((infptr->Fptr)->cn_uncompressed >= 1 ) {
+
+ /* This option of writing the uncompressed floating point data */
+ /* to the tile compressed file was used until about May 2011. */
+ /* This was replaced by the more efficient option of gzipping the */
+ /* floating point data before writing it to the tile-compressed file */
+
+ /* no compressed data, so simply read the uncompressed data */
+ /* directly from the UNCOMPRESSED_DATA column */
+ ffgdes (infptr, (infptr->Fptr)->cn_uncompressed, nrow, &nelem,
+ &offset, status);
+
+ if (nelem == 0 && offset == 0) /* this should never happen */
+ return (*status = NO_COMPRESSED_TILE);
+
+ if (nullcheck <= 1) { /* set any null values in the array = nulval */
+ fits_read_col(infptr, datatype, (infptr->Fptr)->cn_uncompressed,
+ nrow, 1, nelem, nulval, buffer, anynul, status);
+ } else { /* set the bnullarray = 1 for any null values in the array */
+ fits_read_colnull(infptr, datatype, (infptr->Fptr)->cn_uncompressed,
+ nrow, 1, nelem, buffer, bnullarray, anynul, status);
+ }
+ } else if ((infptr->Fptr)->cn_gzip_data >= 1) {
+
+ /* This is the newer option, that was introduced in May 2011 */
+ /* floating point data was not quantized, so read the losslessly */
+ /* compressed data from the GZIP_COMPRESSED_DATA column */
+
+ ffgdes (infptr, (infptr->Fptr)->cn_gzip_data, nrow, &nelem,
+ &offset, status);
+
+ if (nelem == 0 && offset == 0) /* this should never happen */
+ return (*status = NO_COMPRESSED_TILE);
+
+ /* allocate memory for the compressed tile of data */
+ cbuf = (unsigned char *) malloc (nelem);
+ if (cbuf == NULL) {
+ ffpmsg("error allocating memory for gzipped tile (imcomp_decompress_tile)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* read array of compressed bytes */
+ if (fits_read_col(infptr, TBYTE, (infptr->Fptr)->cn_gzip_data, nrow,
+ 1, nelem, &charnull, cbuf, NULL, status) > 0) {
+ ffpmsg("error reading compressed byte stream from binary table");
+ free (cbuf);
+ return (*status);
+ }
+
+ /* size of the returned (uncompressed) data buffer, in bytes */
+ if ((infptr->Fptr)->zbitpix == FLOAT_IMG) {
+ idatalen = tilelen * sizeof(float);
+ } else if ((infptr->Fptr)->zbitpix == DOUBLE_IMG) {
+ idatalen = tilelen * sizeof(double);
+ } else {
+ /* this should never happen! */
+ ffpmsg("incompatible data type in gzipped floating-point tile-compressed image");
+ free (cbuf);
+ return (*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ if (datatype == TDOUBLE && (infptr->Fptr)->zbitpix == FLOAT_IMG) {
+ /* have to allocat a temporary buffer for the uncompressed data in the */
+ /* case where a gzipped "float" tile is returned as a "double" array */
+ tempfloat = (float*) malloc (idatalen);
+
+ if (tempfloat == NULL) {
+ ffpmsg("Memory allocation failure for tempfloat. (imcomp_decompress_tile)");
+ free (cbuf);
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* uncompress the data into temp buffer */
+ if (uncompress2mem_from_mem ((char *)cbuf, nelem,
+ (char **) &tempfloat, &idatalen, NULL, &tilebytesize, status)) {
+ ffpmsg("failed to gunzip the image tile");
+ free (tempfloat);
+ free (cbuf);
+ return (*status);
+ }
+ } else {
+
+ /* uncompress the data directly into the output buffer in all other cases */
+ if (uncompress2mem_from_mem ((char *)cbuf, nelem,
+ (char **) &buffer, &idatalen, NULL, &tilebytesize, status)) {
+ ffpmsg("failed to gunzip the image tile");
+ free (cbuf);
+ return (*status);
+ }
+ }
+
+ free(cbuf);
+
+ /* do byte swapping and null value substitution for the tile of pixels */
+ if (tilebytesize == 4 * tilelen) { /* float pixels */
+
+#if BYTESWAPPED
+ if (tempfloat)
+ ffswap4((int *) tempfloat, tilelen);
+ else
+ ffswap4((int *) buffer, tilelen);
+#endif
+ if (datatype == TFLOAT) {
+ if (nulval) {
+ fnulval = *(float *) nulval;
+ }
+
+ fffr4r4((float *) buffer, (long) tilelen, 1., 0., nullcheck,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+ } else if (datatype == TDOUBLE) {
+ if (nulval) {
+ dnulval = *(double *) nulval;
+ }
+
+ /* note that the R*4 data are in the tempfloat array in this case */
+ fffr4r8((float *) tempfloat, (long) tilelen, 1., 0., nullcheck,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+ free(tempfloat);
+
+ } else {
+ ffpmsg("implicit data type conversion is not supported for gzipped image tiles");
+ return (*status = DATA_DECOMPRESSION_ERR);
+ }
+ } else if (tilebytesize == 8 * tilelen) { /* double pixels */
+
+#if BYTESWAPPED
+ ffswap8((double *) buffer, tilelen);
+#endif
+ if (datatype == TFLOAT) {
+ if (nulval) {
+ fnulval = *(float *) nulval;
+ }
+
+ fffr8r4((double *) buffer, (long) tilelen, 1., 0., nullcheck,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+ } else if (datatype == TDOUBLE) {
+ if (nulval) {
+ dnulval = *(double *) nulval;
+ }
+
+ fffr8r8((double *) buffer, (long) tilelen, 1., 0., nullcheck,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+ } else {
+ ffpmsg("implicit data type conversion is not supported in tile-compressed images");
+ return (*status = DATA_DECOMPRESSION_ERR);
+ }
+ } else {
+ ffpmsg("error: uncompressed tile has wrong size");
+ return (*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ /* end of special case of losslessly gzipping a floating-point image tile */
+ } else { /* this should never happen */
+ *status = NO_COMPRESSED_TILE;
+ }
+
+ return(*status);
+ }
+
+ /* **************************************************************** */
+ /* deal with the normal case of a compressed tile of pixels */
+ if (nullcheck == 2) {
+ for (ii = 0; ii < tilelen; ii++) /* initialize the null flage array */
+ bnullarray[ii] = 0;
+ }
+
+ if (anynul)
+ *anynul = 0;
+
+ /* get linear scaling and offset values, if they exist */
+ actual_bzero = (infptr->Fptr)->cn_actual_bzero;
+ if ((infptr->Fptr)->cn_zscale == 0) {
+ /* set default scaling, if scaling is not defined */
+ bscale = 1.;
+ bzero = 0.;
+ } else if ((infptr->Fptr)->cn_zscale == -1) {
+ bscale = (infptr->Fptr)->zscale;
+ bzero = (infptr->Fptr)->zzero;
+ } else {
+ /* read the linear scale and offset values for this row */
+ ffgcvd (infptr, (infptr->Fptr)->cn_zscale, nrow, 1, 1, 0.,
+ &bscale, NULL, status);
+ ffgcvd (infptr, (infptr->Fptr)->cn_zzero, nrow, 1, 1, 0.,
+ &bzero, NULL, status);
+ if (*status > 0)
+ {
+ ffpmsg("error reading scaling factor and offset for compressed tile");
+ return (*status);
+ }
+
+ /* test if floating-point FITS image also has non-default BSCALE and */
+ /* BZERO keywords. If so, we have to combine the 2 linear scaling factors. */
+
+ if ( ((infptr->Fptr)->zbitpix == FLOAT_IMG ||
+ (infptr->Fptr)->zbitpix == DOUBLE_IMG )
+ &&
+ ((infptr->Fptr)->cn_bscale != 1.0 ||
+ (infptr->Fptr)->cn_bzero != 0.0 ) )
+ {
+ bscale = bscale * (infptr->Fptr)->cn_bscale;
+ bzero = bzero * (infptr->Fptr)->cn_bscale + (infptr->Fptr)->cn_bzero;
+ }
+ }
+
+ if (bscale == 1.0 && bzero == 0.0 ) {
+ /* if no other scaling has been specified, try using the values
+ given by the BSCALE and BZERO keywords, if any */
+
+ bscale = (infptr->Fptr)->cn_bscale;
+ bzero = (infptr->Fptr)->cn_bzero;
+ }
+
+ /* ************************************************************* */
+ /* get the value used to represent nulls in the int array */
+ if ((infptr->Fptr)->cn_zblank == 0) {
+ nullcheck = 0; /* no null value; don't check for nulls */
+ } else if ((infptr->Fptr)->cn_zblank == -1) {
+ tnull = (infptr->Fptr)->zblank; /* use the the ZBLANK keyword */
+ } else {
+ /* read the null value for this row */
+ ffgcvk (infptr, (infptr->Fptr)->cn_zblank, nrow, 1, 1, 0,
+ &tnull, NULL, status);
+ if (*status > 0) {
+ ffpmsg("error reading null value for compressed tile");
+ return (*status);
+ }
+ }
+
+ /* ************************************************************* */
+ /* allocate memory for the uncompressed array of tile integers */
+ /* The size depends on the datatype and the compression type. */
+
+ if ((infptr->Fptr)->compress_type == HCOMPRESS_1 &&
+ ((infptr->Fptr)->zbitpix != BYTE_IMG &&
+ (infptr->Fptr)->zbitpix != SHORT_IMG) ) {
+
+ idatalen = tilelen * sizeof(LONGLONG); /* 8 bytes per pixel */
+
+ } else if ( (infptr->Fptr)->compress_type == RICE_1 &&
+ (infptr->Fptr)->zbitpix == BYTE_IMG &&
+ (infptr->Fptr)->rice_bytepix == 1) {
+
+ idatalen = tilelen * sizeof(char); /* 1 byte per pixel */
+ } else if ( ( (infptr->Fptr)->compress_type == GZIP_1 ||
+ (infptr->Fptr)->compress_type == GZIP_2 ||
+ (infptr->Fptr)->compress_type == BZIP2_1 ) &&
+ (infptr->Fptr)->zbitpix == BYTE_IMG ) {
+
+ idatalen = tilelen * sizeof(char); /* 1 byte per pixel */
+ } else if ( (infptr->Fptr)->compress_type == RICE_1 &&
+ (infptr->Fptr)->zbitpix == SHORT_IMG &&
+ (infptr->Fptr)->rice_bytepix == 2) {
+
+ idatalen = tilelen * sizeof(short); /* 2 bytes per pixel */
+ } else if ( ( (infptr->Fptr)->compress_type == GZIP_1 ||
+ (infptr->Fptr)->compress_type == GZIP_2 ||
+ (infptr->Fptr)->compress_type == BZIP2_1 ) &&
+ (infptr->Fptr)->zbitpix == SHORT_IMG ) {
+
+ idatalen = tilelen * sizeof(short); /* 2 bytes per pixel */
+ } else if ( ( (infptr->Fptr)->compress_type == GZIP_1 ||
+ (infptr->Fptr)->compress_type == GZIP_2 ||
+ (infptr->Fptr)->compress_type == BZIP2_1 ) &&
+ (infptr->Fptr)->zbitpix == DOUBLE_IMG ) {
+
+ idatalen = tilelen * sizeof(double); /* 8 bytes per pixel */
+ } else {
+ idatalen = tilelen * sizeof(int); /* all other cases have int pixels */
+ }
+
+ idata = (int*) malloc (idatalen);
+ if (idata == NULL) {
+ ffpmsg("Memory allocation failure for idata. (imcomp_decompress_tile)");
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* ************************************************************* */
+ /* allocate memory for the compressed bytes */
+
+ if ((infptr->Fptr)->compress_type == PLIO_1) {
+ cbuf = (unsigned char *) malloc (nelem * sizeof (short));
+ } else {
+ cbuf = (unsigned char *) malloc (nelem);
+ }
+ if (cbuf == NULL) {
+ ffpmsg("Out of memory for cbuf. (imcomp_decompress_tile)");
+ free(idata);
+ return (*status = MEMORY_ALLOCATION);
+ }
+
+ /* ************************************************************* */
+ /* read the compressed bytes from the FITS file */
+
+ if ((infptr->Fptr)->compress_type == PLIO_1) {
+ fits_read_col(infptr, TSHORT, (infptr->Fptr)->cn_compressed, nrow,
+ 1, nelem, &snull, (short *) cbuf, NULL, status);
+ } else {
+ fits_read_col(infptr, TBYTE, (infptr->Fptr)->cn_compressed, nrow,
+ 1, nelem, &charnull, cbuf, NULL, status);
+ }
+
+ if (*status > 0) {
+ ffpmsg("error reading compressed byte stream from binary table");
+ free (cbuf);
+ free(idata);
+ return (*status);
+ }
+
+ /* ************************************************************* */
+ /* call the algorithm-specific code to uncompress the tile */
+
+ if ((infptr->Fptr)->compress_type == RICE_1) {
+
+ blocksize = (infptr->Fptr)->rice_blocksize;
+
+ if ((infptr->Fptr)->rice_bytepix == 1 ) {
+ *status = fits_rdecomp_byte (cbuf, nelem, (unsigned char *)idata,
+ tilelen, blocksize);
+ tiledatatype = TBYTE;
+ } else if ((infptr->Fptr)->rice_bytepix == 2 ) {
+ *status = fits_rdecomp_short (cbuf, nelem, (unsigned short *)idata,
+ tilelen, blocksize);
+ tiledatatype = TSHORT;
+ } else {
+ *status = fits_rdecomp (cbuf, nelem, (unsigned int *)idata,
+ tilelen, blocksize);
+ tiledatatype = TINT;
+ }
+
+ /* ************************************************************* */
+ } else if ((infptr->Fptr)->compress_type == HCOMPRESS_1) {
+
+ smooth = (infptr->Fptr)->hcomp_smooth;
+
+ if ( ((infptr->Fptr)->zbitpix == BYTE_IMG || (infptr->Fptr)->zbitpix == SHORT_IMG)) {
+ *status = fits_hdecompress(cbuf, smooth, idata, &nx, &ny,
+ &scale, status);
+ } else { /* zbitpix = LONG_IMG (32) */
+ /* idata must have been allocated twice as large for this to work */
+ *status = fits_hdecompress64(cbuf, smooth, (LONGLONG *) idata, &nx, &ny,
+ &scale, status);
+ }
+
+ tiledatatype = TINT;
+
+ /* ************************************************************* */
+ } else if ((infptr->Fptr)->compress_type == PLIO_1) {
+
+ pl_l2pi ((short *) cbuf, 1, idata, tilelen); /* uncompress the data */
+ tiledatatype = TINT;
+
+ /* ************************************************************* */
+ } else if ( ((infptr->Fptr)->compress_type == GZIP_1) ||
+ ((infptr->Fptr)->compress_type == GZIP_2) ) {
+
+ uncompress2mem_from_mem ((char *)cbuf, nelem,
+ (char **) &idata, &idatalen, realloc, &tilebytesize, status);
+
+ /* determine the data type of the uncompressed array, and */
+ /* do byte unshuffling and unswapping if needed */
+ if (tilebytesize == (size_t) (tilelen * 2)) {
+ /* this is a short I*2 array */
+ tiledatatype = TSHORT;
+
+ if ( (infptr->Fptr)->compress_type == GZIP_2 )
+ fits_unshuffle_2bytes((char *) idata, tilelen, status);
+
+#if BYTESWAPPED
+ ffswap2((short *) idata, tilelen);
+#endif
+
+ } else if (tilebytesize == (size_t) (tilelen * 4)) {
+ /* this is a int I*4 array (or maybe R*4) */
+ tiledatatype = TINT;
+
+ if ( (infptr->Fptr)->compress_type == GZIP_2 )
+ fits_unshuffle_4bytes((char *) idata, tilelen, status);
+
+#if BYTESWAPPED
+ ffswap4(idata, tilelen);
+#endif
+
+ } else if (tilebytesize == (size_t) (tilelen * 8)) {
+ /* this is a R*8 double array */
+ tiledatatype = TDOUBLE;
+
+ if ( (infptr->Fptr)->compress_type == GZIP_2 )
+ fits_unshuffle_8bytes((char *) idata, tilelen, status);
+#if BYTESWAPPED
+ ffswap8((double *) idata, tilelen);
+#endif
+
+ } else if (tilebytesize == (size_t) tilelen) {
+
+ /* this is an unsigned char I*1 array */
+ tiledatatype = TBYTE;
+
+ } else {
+ ffpmsg("error: uncompressed tile has wrong size");
+ free(idata);
+ return (*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ /* ************************************************************* */
+ } else if ((infptr->Fptr)->compress_type == BZIP2_1) {
+
+/* BZIP2 is not supported in the public release; this is only for test purposes
+
+ if (BZ2_bzBuffToBuffDecompress ((char *) idata, &idatalen,
+ (char *)cbuf, (unsigned int) nelem, 0, 0) )
+*/
+ {
+ ffpmsg("bzip2 decompression error");
+ free(idata);
+ free (cbuf);
+ return (*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ if ((infptr->Fptr)->zbitpix == BYTE_IMG) {
+ tiledatatype = TBYTE;
+ } else if ((infptr->Fptr)->zbitpix == SHORT_IMG) {
+ tiledatatype = TSHORT;
+#if BYTESWAPPED
+ ffswap2((short *) idata, tilelen);
+#endif
+ } else {
+ tiledatatype = TINT;
+#if BYTESWAPPED
+ ffswap4(idata, tilelen);
+#endif
+ }
+
+ /* ************************************************************* */
+ } else {
+ ffpmsg("unknown compression algorithm");
+ free(idata);
+ return (*status = DATA_DECOMPRESSION_ERR);
+ }
+
+ free(cbuf);
+ if (*status) { /* error uncompressing the tile */
+ free(idata);
+ return (*status);
+ }
+
+ /* ************************************************************* */
+ /* copy the uncompressed tile data to the output buffer, doing */
+ /* null checking, datatype conversion and linear scaling, if necessary */
+
+ if (nulval == 0)
+ nulval = &dummy; /* set address to dummy value */
+
+ if (datatype == TSHORT)
+ {
+ pixlen = sizeof(short);
+
+ if ((infptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ /* the floating point pixels were losselessly compressed with GZIP */
+ /* Just have to copy the values to the output array */
+
+ if (tiledatatype == TINT) {
+ fffr4i2((float *) idata, tilelen, bscale, bzero, nullcheck,
+ *(short *) nulval, bnullarray, anynul,
+ (short *) buffer, status);
+ } else {
+ fffr8i2((double *) idata, tilelen, bscale, bzero, nullcheck,
+ *(short *) nulval, bnullarray, anynul,
+ (short *) buffer, status);
+ }
+ } else if (tiledatatype == TINT)
+ if ((infptr->Fptr)->compress_type == PLIO_1 &&
+ bzero == 0. && actual_bzero == 32768.) {
+ /* special case where unsigned 16-bit integers have been */
+ /* offset by +32768 when using PLIO */
+ fffi4i2(idata, tilelen, bscale, -32768., nullcheck, tnull,
+ *(short *) nulval, bnullarray, anynul,
+ (short *) buffer, status);
+ } else {
+ fffi4i2(idata, tilelen, bscale, bzero, nullcheck, tnull,
+ *(short *) nulval, bnullarray, anynul,
+ (short *) buffer, status);
+ }
+ else if (tiledatatype == TSHORT)
+ fffi2i2((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ *(short *) nulval, bnullarray, anynul,
+ (short *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1i2((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ *(short *) nulval, bnullarray, anynul,
+ (short *) buffer, status);
+ }
+ else if (datatype == TINT)
+ {
+ pixlen = sizeof(int);
+
+ if ((infptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ /* the floating point pixels were losselessly compressed with GZIP */
+ /* Just have to copy the values to the output array */
+
+ if (tiledatatype == TINT) {
+ fffr4int((float *) idata, tilelen, bscale, bzero, nullcheck,
+ *(int *) nulval, bnullarray, anynul,
+ (int *) buffer, status);
+ } else {
+ fffr8int((double *) idata, tilelen, bscale, bzero, nullcheck,
+ *(int *) nulval, bnullarray, anynul,
+ (int *) buffer, status);
+ }
+ } else if (tiledatatype == TINT)
+ fffi4int(idata, (long) tilelen, bscale, bzero, nullcheck, tnull,
+ *(int *) nulval, bnullarray, anynul,
+ (int *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ fffi2int((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ *(int *) nulval, bnullarray, anynul,
+ (int *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1int((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ *(int *) nulval, bnullarray, anynul,
+ (int *) buffer, status);
+ }
+ else if (datatype == TLONG)
+ {
+ pixlen = sizeof(long);
+
+ if ((infptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ /* the floating point pixels were losselessly compressed with GZIP */
+ /* Just have to copy the values to the output array */
+
+ if (tiledatatype == TINT) {
+ fffr4i4((float *) idata, tilelen, bscale, bzero, nullcheck,
+ *(long *) nulval, bnullarray, anynul,
+ (long *) buffer, status);
+ } else {
+ fffr8i4((double *) idata, tilelen, bscale, bzero, nullcheck,
+ *(long *) nulval, bnullarray, anynul,
+ (long *) buffer, status);
+ }
+ } else if (tiledatatype == TINT)
+ fffi4i4(idata, tilelen, bscale, bzero, nullcheck, tnull,
+ *(long *) nulval, bnullarray, anynul,
+ (long *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ fffi2i4((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ *(long *) nulval, bnullarray, anynul,
+ (long *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1i4((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ *(long *) nulval, bnullarray, anynul,
+ (long *) buffer, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ pixlen = sizeof(float);
+ if (nulval) {
+ fnulval = *(float *) nulval;
+ }
+
+ if ((infptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ /* the floating point pixels were losselessly compressed with GZIP */
+ /* Just have to copy the values to the output array */
+
+ if (tiledatatype == TINT) {
+ fffr4r4((float *) idata, tilelen, bscale, bzero, nullcheck,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+ } else {
+ fffr8r4((double *) idata, tilelen, bscale, bzero, nullcheck,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+ }
+
+ } else if ((infptr->Fptr)->quantize_dither == SUBTRACTIVE_DITHER_1) {
+
+ /* use the new dithering algorithm (introduced in July 2009) */
+
+ if (tiledatatype == TINT)
+ unquantize_i4r4(nrow + (infptr->Fptr)->dither_offset - 1, idata,
+ tilelen, bscale, bzero, nullcheck, tnull,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ unquantize_i2r4(nrow + (infptr->Fptr)->dither_offset - 1, (short *)idata,
+ tilelen, bscale, bzero, nullcheck, (short) tnull,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ unquantize_i1r4(nrow + (infptr->Fptr)->dither_offset - 1, (unsigned char *)idata,
+ tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+
+ } else { /* use the old "round to nearest level" quantization algorithm */
+
+ if (tiledatatype == TINT)
+ fffi4r4(idata, tilelen, bscale, bzero, nullcheck, tnull,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ fffi2r4((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1r4((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ fnulval, bnullarray, anynul,
+ (float *) buffer, status);
+ }
+ }
+ else if (datatype == TDOUBLE)
+ {
+ pixlen = sizeof(double);
+ if (nulval) {
+ dnulval = *(double *) nulval;
+ }
+
+ if ((infptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ /* the floating point pixels were losselessly compressed with GZIP */
+ /* Just have to copy the values to the output array */
+
+ if (tiledatatype == TINT) {
+ fffr4r8((float *) idata, tilelen, bscale, bzero, nullcheck,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+ } else {
+ fffr8r8((double *) idata, tilelen, bscale, bzero, nullcheck,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+ }
+
+ } else if ((infptr->Fptr)->quantize_dither == SUBTRACTIVE_DITHER_1) {
+
+ /* use the new dithering algorithm (introduced in July 2009) */
+ if (tiledatatype == TINT)
+ unquantize_i4r8(nrow + (infptr->Fptr)->dither_offset - 1, idata,
+ tilelen, bscale, bzero, nullcheck, tnull,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ unquantize_i2r8(nrow + (infptr->Fptr)->dither_offset - 1, (short *)idata,
+ tilelen, bscale, bzero, nullcheck, (short) tnull,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ unquantize_i1r8(nrow + (infptr->Fptr)->dither_offset - 1, (unsigned char *)idata,
+ tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+
+ } else { /* use the old "round to nearest level" quantization algorithm */
+
+ if (tiledatatype == TINT)
+ fffi4r8(idata, tilelen, bscale, bzero, nullcheck, tnull,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ fffi2r8((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1r8((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ dnulval, bnullarray, anynul,
+ (double *) buffer, status);
+ }
+ }
+ else if (datatype == TBYTE)
+ {
+ pixlen = sizeof(char);
+ if (tiledatatype == TINT)
+ fffi4i1(idata, tilelen, bscale, bzero, nullcheck, tnull,
+ *(unsigned char *) nulval, bnullarray, anynul,
+ (unsigned char *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ fffi2i1((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ *(unsigned char *) nulval, bnullarray, anynul,
+ (unsigned char *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1i1((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ *(unsigned char *) nulval, bnullarray, anynul,
+ (unsigned char *) buffer, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ pixlen = sizeof(char);
+ if (tiledatatype == TINT)
+ fffi4s1(idata, tilelen, bscale, bzero, nullcheck, tnull,
+ *(signed char *) nulval, bnullarray, anynul,
+ (signed char *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ fffi2s1((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ *(signed char *) nulval, bnullarray, anynul,
+ (signed char *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1s1((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ *(signed char *) nulval, bnullarray, anynul,
+ (signed char *) buffer, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ pixlen = sizeof(short);
+
+ if ((infptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ /* the floating point pixels were losselessly compressed with GZIP */
+ /* Just have to copy the values to the output array */
+
+ if (tiledatatype == TINT) {
+ fffr4u2((float *) idata, tilelen, bscale, bzero, nullcheck,
+ *(unsigned short *) nulval, bnullarray, anynul,
+ (unsigned short *) buffer, status);
+ } else {
+ fffr8u2((double *) idata, tilelen, bscale, bzero, nullcheck,
+ *(unsigned short *) nulval, bnullarray, anynul,
+ (unsigned short *) buffer, status);
+ }
+ } else if (tiledatatype == TINT)
+ fffi4u2(idata, tilelen, bscale, bzero, nullcheck, tnull,
+ *(unsigned short *) nulval, bnullarray, anynul,
+ (unsigned short *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ fffi2u2((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ *(unsigned short *) nulval, bnullarray, anynul,
+ (unsigned short *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1u2((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ *(unsigned short *) nulval, bnullarray, anynul,
+ (unsigned short *) buffer, status);
+ }
+ else if (datatype == TUINT)
+ {
+ pixlen = sizeof(int);
+
+ if ((infptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ /* the floating point pixels were losselessly compressed with GZIP */
+ /* Just have to copy the values to the output array */
+
+ if (tiledatatype == TINT) {
+ fffr4uint((float *) idata, tilelen, bscale, bzero, nullcheck,
+ *(unsigned int *) nulval, bnullarray, anynul,
+ (unsigned int *) buffer, status);
+ } else {
+ fffr8uint((double *) idata, tilelen, bscale, bzero, nullcheck,
+ *(unsigned int *) nulval, bnullarray, anynul,
+ (unsigned int *) buffer, status);
+ }
+ } else if (tiledatatype == TINT)
+ fffi4uint(idata, tilelen, bscale, bzero, nullcheck, tnull,
+ *(unsigned int *) nulval, bnullarray, anynul,
+ (unsigned int *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ fffi2uint((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ *(unsigned int *) nulval, bnullarray, anynul,
+ (unsigned int *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1uint((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ *(unsigned int *) nulval, bnullarray, anynul,
+ (unsigned int *) buffer, status);
+ }
+ else if (datatype == TULONG)
+ {
+ pixlen = sizeof(long);
+
+ if ((infptr->Fptr)->quantize_level == NO_QUANTIZE) {
+ /* the floating point pixels were losselessly compressed with GZIP */
+ /* Just have to copy the values to the output array */
+
+ if (tiledatatype == TINT) {
+ fffr4u4((float *) idata, tilelen, bscale, bzero, nullcheck,
+ *(unsigned long *) nulval, bnullarray, anynul,
+ (unsigned long *) buffer, status);
+ } else {
+ fffr8u4((double *) idata, tilelen, bscale, bzero, nullcheck,
+ *(unsigned long *) nulval, bnullarray, anynul,
+ (unsigned long *) buffer, status);
+ }
+ } else if (tiledatatype == TINT)
+ fffi4u4(idata, tilelen, bscale, bzero, nullcheck, tnull,
+ *(unsigned long *) nulval, bnullarray, anynul,
+ (unsigned long *) buffer, status);
+ else if (tiledatatype == TSHORT)
+ fffi2u4((short *)idata, tilelen, bscale, bzero, nullcheck, (short) tnull,
+ *(unsigned long *) nulval, bnullarray, anynul,
+ (unsigned long *) buffer, status);
+ else if (tiledatatype == TBYTE)
+ fffi1u4((unsigned char *)idata, tilelen, bscale, bzero, nullcheck, (unsigned char) tnull,
+ *(unsigned long *) nulval, bnullarray, anynul,
+ (unsigned long *) buffer, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ free(idata); /* don't need the uncompressed tile any more */
+
+ /* **************************************************************** */
+ /* cache the tile, in case the application wants it again */
+
+ /* Don't cache the tile if tile is a single row of the image;
+ it is less likely that the cache will be used in this cases,
+ so it is not worth the time and the memory overheads.
+ */
+ if ((infptr->Fptr)->znaxis[0] != (infptr->Fptr)->tilesize[0] ||
+ (infptr->Fptr)->tilesize[1] != 1 )
+ {
+ tilesize = pixlen * tilelen;
+
+ /* check that tile size/type has not changed */
+ if (tilesize != (infptr->Fptr)->tiledatasize ||
+ datatype != (infptr->Fptr)->tiletype ) {
+
+ if ((infptr->Fptr)->tiledata) {
+ free((infptr->Fptr)->tiledata);
+ }
+
+ (infptr->Fptr)->tiledata = 0;
+
+ if ((infptr->Fptr)->tilenullarray) {
+ free((infptr->Fptr)->tilenullarray);
+ }
+
+ (infptr->Fptr)->tilenullarray = 0;
+ (infptr->Fptr)->tilerow = 0;
+ (infptr->Fptr)->tiledatasize = 0;
+ (infptr->Fptr)->tiletype = 0;
+
+ /* allocate new array(s) */
+ (infptr->Fptr)->tiledata = malloc(tilesize);
+ if ((infptr->Fptr)->tiledata == 0)
+ return (*status);
+
+ if (nullcheck == 2) { /* also need array of null pixel flags */
+ (infptr->Fptr)->tilenullarray = malloc(tilelen);
+ if ((infptr->Fptr)->tilenullarray == 0)
+ return (*status);
+ }
+
+ (infptr->Fptr)->tiledatasize = tilesize;
+ (infptr->Fptr)->tiletype = datatype;
+ }
+
+ /* copy the tile array(s) into cache buffer */
+ memcpy((infptr->Fptr)->tiledata, buffer, tilesize);
+
+ if (nullcheck == 2) {
+ if ((infptr->Fptr)->tilenullarray == 0) {
+ (infptr->Fptr)->tilenullarray = malloc(tilelen);
+ }
+ memcpy((infptr->Fptr)->tilenullarray, bnullarray, tilelen);
+ }
+
+ (infptr->Fptr)->tilerow = nrow;
+ (infptr->Fptr)->tileanynull = *anynul;
+ }
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_copy_overlap (
+ char *tile, /* I - multi dimensional array of tile pixels */
+ int pixlen, /* I - number of bytes in each tile or image pixel */
+ int ndim, /* I - number of dimension in the tile and image */
+ long *tfpixel, /* I - first pixel number in each dim. of the tile */
+ long *tlpixel, /* I - last pixel number in each dim. of the tile */
+ char *bnullarray, /* I - array of null flags; used if nullcheck = 2 */
+ char *image, /* O - multi dimensional output image */
+ long *fpixel, /* I - first pixel number in each dim. of the image */
+ long *lpixel, /* I - last pixel number in each dim. of the image */
+ long *ininc, /* I - increment to be applied in each image dimen. */
+ int nullcheck, /* I - 0, 1: do nothing; 2: set nullarray for nulls */
+ char *nullarray,
+ int *status)
+
+/*
+ copy the intersecting pixels from a decompressed tile to the output image.
+ Both the tile and the image must have the same number of dimensions.
+*/
+{
+ long imgdim[MAX_COMPRESS_DIM]; /* product of preceding dimensions in the */
+ /* output image, allowing for inc factor */
+ long tiledim[MAX_COMPRESS_DIM]; /* product of preceding dimensions in the */
+ /* tile, array; inc factor is not relevant */
+ long imgfpix[MAX_COMPRESS_DIM]; /* 1st img pix overlapping tile: 0 base, */
+ /* allowing for inc factor */
+ long imglpix[MAX_COMPRESS_DIM]; /* last img pix overlapping tile 0 base, */
+ /* allowing for inc factor */
+ long tilefpix[MAX_COMPRESS_DIM]; /* 1st tile pix overlapping img 0 base, */
+ /* allowing for inc factor */
+ long inc[MAX_COMPRESS_DIM]; /* local copy of input ininc */
+ long i1, i2, i3, i4; /* offset along each axis of the image */
+ long it1, it2, it3, it4;
+ long im1, im2, im3, im4; /* offset to image pixel, allowing for inc */
+ long ipos, tf, tl;
+ long t2, t3, t4; /* offset along each axis of the tile */
+ long tilepix, imgpix, tilepixbyte, imgpixbyte;
+ int ii, overlap_bytes, overlap_flags;
+
+ if (*status > 0)
+ return(*status);
+
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ /* set default values for higher dimensions */
+ inc[ii] = 1;
+ imgdim[ii] = 1;
+ tiledim[ii] = 1;
+ imgfpix[ii] = 0;
+ imglpix[ii] = 0;
+ tilefpix[ii] = 0;
+ }
+
+ /* ------------------------------------------------------------ */
+ /* calc amount of overlap in each dimension; if there is zero */
+ /* overlap in any dimension then just return */
+ /* ------------------------------------------------------------ */
+
+ for (ii = 0; ii < ndim; ii++)
+ {
+ if (tlpixel[ii] < fpixel[ii] || tfpixel[ii] > lpixel[ii])
+ return(*status); /* there are no overlapping pixels */
+
+ inc[ii] = ininc[ii];
+
+ /* calc dimensions of the output image section */
+ imgdim[ii] = (lpixel[ii] - fpixel[ii]) / labs(inc[ii]) + 1;
+ if (imgdim[ii] < 1)
+ return(*status = NEG_AXIS);
+
+ /* calc dimensions of the tile */
+ tiledim[ii] = tlpixel[ii] - tfpixel[ii] + 1;
+ if (tiledim[ii] < 1)
+ return(*status = NEG_AXIS);
+
+ if (ii > 0)
+ tiledim[ii] *= tiledim[ii - 1]; /* product of dimensions */
+
+ /* first and last pixels in image that overlap with the tile, 0 base */
+ tf = tfpixel[ii] - 1;
+ tl = tlpixel[ii] - 1;
+
+ /* skip this plane if it falls in the cracks of the subsampled image */
+ while ((tf-(fpixel[ii] - 1)) % labs(inc[ii]))
+ {
+ tf++;
+ if (tf > tl)
+ return(*status); /* no overlapping pixels */
+ }
+
+ while ((tl-(fpixel[ii] - 1)) % labs(inc[ii]))
+ {
+ tl--;
+ if (tf > tl)
+ return(*status); /* no overlapping pixels */
+ }
+ imgfpix[ii] = maxvalue((tf - fpixel[ii] +1) / labs(inc[ii]) , 0);
+ imglpix[ii] = minvalue((tl - fpixel[ii] +1) / labs(inc[ii]) ,
+ imgdim[ii] - 1);
+
+ /* first pixel in the tile that overlaps with the image (0 base) */
+ tilefpix[ii] = maxvalue(fpixel[ii] - tfpixel[ii], 0);
+
+ while ((tfpixel[ii] + tilefpix[ii] - fpixel[ii]) % labs(inc[ii]))
+ {
+ (tilefpix[ii])++;
+ if (tilefpix[ii] >= tiledim[ii])
+ return(*status); /* no overlapping pixels */
+ }
+/*
+printf("ii tfpixel, tlpixel %d %d %d \n",ii, tfpixel[ii], tlpixel[ii]);
+printf("ii, tf, tl, imgfpix,imglpix, tilefpix %d %d %d %d %d %d\n",ii,
+ tf,tl,imgfpix[ii], imglpix[ii],tilefpix[ii]);
+*/
+ if (ii > 0)
+ imgdim[ii] *= imgdim[ii - 1]; /* product of dimensions */
+ }
+
+ /* ---------------------------------------------------------------- */
+ /* calc number of pixels in each row (first dimension) that overlap */
+ /* multiply by pixlen to get number of bytes to copy in each loop */
+ /* ---------------------------------------------------------------- */
+
+ if (inc[0] != 1)
+ overlap_flags = 1; /* can only copy 1 pixel at a time */
+ else
+ overlap_flags = imglpix[0] - imgfpix[0] + 1; /* can copy whole row */
+
+ overlap_bytes = overlap_flags * pixlen;
+
+ /* support up to 5 dimensions for now */
+ for (i4 = 0, it4=0; i4 <= imglpix[4] - imgfpix[4]; i4++, it4++)
+ {
+ /* increment plane if it falls in the cracks of the subsampled image */
+ while (ndim > 4 && (tfpixel[4] + tilefpix[4] - fpixel[4] + it4)
+ % labs(inc[4]) != 0)
+ it4++;
+
+ /* offset to start of hypercube */
+ if (inc[4] > 0)
+ im4 = (i4 + imgfpix[4]) * imgdim[3];
+ else
+ im4 = imgdim[4] - (i4 + 1 + imgfpix[4]) * imgdim[3];
+
+ t4 = (tilefpix[4] + it4) * tiledim[3];
+ for (i3 = 0, it3=0; i3 <= imglpix[3] - imgfpix[3]; i3++, it3++)
+ {
+ /* increment plane if it falls in the cracks of the subsampled image */
+ while (ndim > 3 && (tfpixel[3] + tilefpix[3] - fpixel[3] + it3)
+ % labs(inc[3]) != 0)
+ it3++;
+
+ /* offset to start of cube */
+ if (inc[3] > 0)
+ im3 = (i3 + imgfpix[3]) * imgdim[2] + im4;
+ else
+ im3 = imgdim[3] - (i3 + 1 + imgfpix[3]) * imgdim[2] + im4;
+
+ t3 = (tilefpix[3] + it3) * tiledim[2] + t4;
+
+ /* loop through planes of the image */
+ for (i2 = 0, it2=0; i2 <= imglpix[2] - imgfpix[2]; i2++, it2++)
+ {
+ /* incre plane if it falls in the cracks of the subsampled image */
+ while (ndim > 2 && (tfpixel[2] + tilefpix[2] - fpixel[2] + it2)
+ % labs(inc[2]) != 0)
+ it2++;
+
+ /* offset to start of plane */
+ if (inc[2] > 0)
+ im2 = (i2 + imgfpix[2]) * imgdim[1] + im3;
+ else
+ im2 = imgdim[2] - (i2 + 1 + imgfpix[2]) * imgdim[1] + im3;
+
+ t2 = (tilefpix[2] + it2) * tiledim[1] + t3;
+
+ /* loop through rows of the image */
+ for (i1 = 0, it1=0; i1 <= imglpix[1] - imgfpix[1]; i1++, it1++)
+ {
+ /* incre row if it falls in the cracks of the subsampled image */
+ while (ndim > 1 && (tfpixel[1] + tilefpix[1] - fpixel[1] + it1)
+ % labs(inc[1]) != 0)
+ it1++;
+
+ /* calc position of first pixel in tile to be copied */
+ tilepix = tilefpix[0] + (tilefpix[1] + it1) * tiledim[0] + t2;
+
+ /* offset to start of row */
+ if (inc[1] > 0)
+ im1 = (i1 + imgfpix[1]) * imgdim[0] + im2;
+ else
+ im1 = imgdim[1] - (i1 + 1 + imgfpix[1]) * imgdim[0] + im2;
+/*
+printf("inc = %d %d %d %d\n",inc[0],inc[1],inc[2],inc[3]);
+printf("im1,im2,im3,im4 = %d %d %d %d\n",im1,im2,im3,im4);
+*/
+ /* offset to byte within the row */
+ if (inc[0] > 0)
+ imgpix = imgfpix[0] + im1;
+ else
+ imgpix = imgdim[0] - 1 - imgfpix[0] + im1;
+/*
+printf("tilefpix0,1, imgfpix1, it1, inc1, t2= %d %d %d %d %d %d\n",
+ tilefpix[0],tilefpix[1],imgfpix[1],it1,inc[1], t2);
+printf("i1, it1, tilepix, imgpix %d %d %d %d \n", i1, it1, tilepix, imgpix);
+*/
+ /* loop over pixels along one row of the image */
+ for (ipos = imgfpix[0]; ipos <= imglpix[0]; ipos += overlap_flags)
+ {
+ if (nullcheck == 2)
+ {
+ /* copy overlapping null flags from tile to image */
+ memcpy(nullarray + imgpix, bnullarray + tilepix,
+ overlap_flags);
+ }
+
+ /* convert from image pixel to byte offset */
+ tilepixbyte = tilepix * pixlen;
+ imgpixbyte = imgpix * pixlen;
+/*
+printf(" tilepix, tilepixbyte, imgpix, imgpixbyte= %d %d %d %d\n",
+ tilepix, tilepixbyte, imgpix, imgpixbyte);
+*/
+ /* copy overlapping row of pixels from tile to image */
+ memcpy(image + imgpixbyte, tile + tilepixbyte, overlap_bytes);
+
+ tilepix += (overlap_flags * labs(inc[0]));
+ if (inc[0] > 0)
+ imgpix += overlap_flags;
+ else
+ imgpix -= overlap_flags;
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int imcomp_merge_overlap (
+ char *tile, /* O - multi dimensional array of tile pixels */
+ int pixlen, /* I - number of bytes in each tile or image pixel */
+ int ndim, /* I - number of dimension in the tile and image */
+ long *tfpixel, /* I - first pixel number in each dim. of the tile */
+ long *tlpixel, /* I - last pixel number in each dim. of the tile */
+ char *bnullarray, /* I - array of null flags; used if nullcheck = 2 */
+ char *image, /* I - multi dimensional output image */
+ long *fpixel, /* I - first pixel number in each dim. of the image */
+ long *lpixel, /* I - last pixel number in each dim. of the image */
+ int nullcheck, /* I - 0, 1: do nothing; 2: set nullarray for nulls */
+ int *status)
+
+/*
+ Similar to imcomp_copy_overlap, except it copies the overlapping pixels from
+ the 'image' to the 'tile'.
+*/
+{
+ long imgdim[MAX_COMPRESS_DIM]; /* product of preceding dimensions in the */
+ /* output image, allowing for inc factor */
+ long tiledim[MAX_COMPRESS_DIM]; /* product of preceding dimensions in the */
+ /* tile, array; inc factor is not relevant */
+ long imgfpix[MAX_COMPRESS_DIM]; /* 1st img pix overlapping tile: 0 base, */
+ /* allowing for inc factor */
+ long imglpix[MAX_COMPRESS_DIM]; /* last img pix overlapping tile 0 base, */
+ /* allowing for inc factor */
+ long tilefpix[MAX_COMPRESS_DIM]; /* 1st tile pix overlapping img 0 base, */
+ /* allowing for inc factor */
+ long inc[MAX_COMPRESS_DIM]; /* local copy of input ininc */
+ long i1, i2, i3, i4; /* offset along each axis of the image */
+ long it1, it2, it3, it4;
+ long im1, im2, im3, im4; /* offset to image pixel, allowing for inc */
+ long ipos, tf, tl;
+ long t2, t3, t4; /* offset along each axis of the tile */
+ long tilepix, imgpix, tilepixbyte, imgpixbyte;
+ int ii, overlap_bytes, overlap_flags;
+
+ if (*status > 0)
+ return(*status);
+
+ for (ii = 0; ii < MAX_COMPRESS_DIM; ii++)
+ {
+ /* set default values for higher dimensions */
+ inc[ii] = 1;
+ imgdim[ii] = 1;
+ tiledim[ii] = 1;
+ imgfpix[ii] = 0;
+ imglpix[ii] = 0;
+ tilefpix[ii] = 0;
+ }
+
+ /* ------------------------------------------------------------ */
+ /* calc amount of overlap in each dimension; if there is zero */
+ /* overlap in any dimension then just return */
+ /* ------------------------------------------------------------ */
+
+ for (ii = 0; ii < ndim; ii++)
+ {
+ if (tlpixel[ii] < fpixel[ii] || tfpixel[ii] > lpixel[ii])
+ return(*status); /* there are no overlapping pixels */
+
+ /* calc dimensions of the output image section */
+ imgdim[ii] = (lpixel[ii] - fpixel[ii]) / labs(inc[ii]) + 1;
+ if (imgdim[ii] < 1)
+ return(*status = NEG_AXIS);
+
+ /* calc dimensions of the tile */
+ tiledim[ii] = tlpixel[ii] - tfpixel[ii] + 1;
+ if (tiledim[ii] < 1)
+ return(*status = NEG_AXIS);
+
+ if (ii > 0)
+ tiledim[ii] *= tiledim[ii - 1]; /* product of dimensions */
+
+ /* first and last pixels in image that overlap with the tile, 0 base */
+ tf = tfpixel[ii] - 1;
+ tl = tlpixel[ii] - 1;
+
+ /* skip this plane if it falls in the cracks of the subsampled image */
+ while ((tf-(fpixel[ii] - 1)) % labs(inc[ii]))
+ {
+ tf++;
+ if (tf > tl)
+ return(*status); /* no overlapping pixels */
+ }
+
+ while ((tl-(fpixel[ii] - 1)) % labs(inc[ii]))
+ {
+ tl--;
+ if (tf > tl)
+ return(*status); /* no overlapping pixels */
+ }
+ imgfpix[ii] = maxvalue((tf - fpixel[ii] +1) / labs(inc[ii]) , 0);
+ imglpix[ii] = minvalue((tl - fpixel[ii] +1) / labs(inc[ii]) ,
+ imgdim[ii] - 1);
+
+ /* first pixel in the tile that overlaps with the image (0 base) */
+ tilefpix[ii] = maxvalue(fpixel[ii] - tfpixel[ii], 0);
+
+ while ((tfpixel[ii] + tilefpix[ii] - fpixel[ii]) % labs(inc[ii]))
+ {
+ (tilefpix[ii])++;
+ if (tilefpix[ii] >= tiledim[ii])
+ return(*status); /* no overlapping pixels */
+ }
+/*
+printf("ii tfpixel, tlpixel %d %d %d \n",ii, tfpixel[ii], tlpixel[ii]);
+printf("ii, tf, tl, imgfpix,imglpix, tilefpix %d %d %d %d %d %d\n",ii,
+ tf,tl,imgfpix[ii], imglpix[ii],tilefpix[ii]);
+*/
+ if (ii > 0)
+ imgdim[ii] *= imgdim[ii - 1]; /* product of dimensions */
+ }
+
+ /* ---------------------------------------------------------------- */
+ /* calc number of pixels in each row (first dimension) that overlap */
+ /* multiply by pixlen to get number of bytes to copy in each loop */
+ /* ---------------------------------------------------------------- */
+
+ if (inc[0] != 1)
+ overlap_flags = 1; /* can only copy 1 pixel at a time */
+ else
+ overlap_flags = imglpix[0] - imgfpix[0] + 1; /* can copy whole row */
+
+ overlap_bytes = overlap_flags * pixlen;
+
+ /* support up to 5 dimensions for now */
+ for (i4 = 0, it4=0; i4 <= imglpix[4] - imgfpix[4]; i4++, it4++)
+ {
+ /* increment plane if it falls in the cracks of the subsampled image */
+ while (ndim > 4 && (tfpixel[4] + tilefpix[4] - fpixel[4] + it4)
+ % labs(inc[4]) != 0)
+ it4++;
+
+ /* offset to start of hypercube */
+ if (inc[4] > 0)
+ im4 = (i4 + imgfpix[4]) * imgdim[3];
+ else
+ im4 = imgdim[4] - (i4 + 1 + imgfpix[4]) * imgdim[3];
+
+ t4 = (tilefpix[4] + it4) * tiledim[3];
+ for (i3 = 0, it3=0; i3 <= imglpix[3] - imgfpix[3]; i3++, it3++)
+ {
+ /* increment plane if it falls in the cracks of the subsampled image */
+ while (ndim > 3 && (tfpixel[3] + tilefpix[3] - fpixel[3] + it3)
+ % labs(inc[3]) != 0)
+ it3++;
+
+ /* offset to start of cube */
+ if (inc[3] > 0)
+ im3 = (i3 + imgfpix[3]) * imgdim[2] + im4;
+ else
+ im3 = imgdim[3] - (i3 + 1 + imgfpix[3]) * imgdim[2] + im4;
+
+ t3 = (tilefpix[3] + it3) * tiledim[2] + t4;
+
+ /* loop through planes of the image */
+ for (i2 = 0, it2=0; i2 <= imglpix[2] - imgfpix[2]; i2++, it2++)
+ {
+ /* incre plane if it falls in the cracks of the subsampled image */
+ while (ndim > 2 && (tfpixel[2] + tilefpix[2] - fpixel[2] + it2)
+ % labs(inc[2]) != 0)
+ it2++;
+
+ /* offset to start of plane */
+ if (inc[2] > 0)
+ im2 = (i2 + imgfpix[2]) * imgdim[1] + im3;
+ else
+ im2 = imgdim[2] - (i2 + 1 + imgfpix[2]) * imgdim[1] + im3;
+
+ t2 = (tilefpix[2] + it2) * tiledim[1] + t3;
+
+ /* loop through rows of the image */
+ for (i1 = 0, it1=0; i1 <= imglpix[1] - imgfpix[1]; i1++, it1++)
+ {
+ /* incre row if it falls in the cracks of the subsampled image */
+ while (ndim > 1 && (tfpixel[1] + tilefpix[1] - fpixel[1] + it1)
+ % labs(inc[1]) != 0)
+ it1++;
+
+ /* calc position of first pixel in tile to be copied */
+ tilepix = tilefpix[0] + (tilefpix[1] + it1) * tiledim[0] + t2;
+
+ /* offset to start of row */
+ if (inc[1] > 0)
+ im1 = (i1 + imgfpix[1]) * imgdim[0] + im2;
+ else
+ im1 = imgdim[1] - (i1 + 1 + imgfpix[1]) * imgdim[0] + im2;
+/*
+printf("inc = %d %d %d %d\n",inc[0],inc[1],inc[2],inc[3]);
+printf("im1,im2,im3,im4 = %d %d %d %d\n",im1,im2,im3,im4);
+*/
+ /* offset to byte within the row */
+ if (inc[0] > 0)
+ imgpix = imgfpix[0] + im1;
+ else
+ imgpix = imgdim[0] - 1 - imgfpix[0] + im1;
+/*
+printf("tilefpix0,1, imgfpix1, it1, inc1, t2= %d %d %d %d %d %d\n",
+ tilefpix[0],tilefpix[1],imgfpix[1],it1,inc[1], t2);
+printf("i1, it1, tilepix, imgpix %d %d %d %d \n", i1, it1, tilepix, imgpix);
+*/
+ /* loop over pixels along one row of the image */
+ for (ipos = imgfpix[0]; ipos <= imglpix[0]; ipos += overlap_flags)
+ {
+ /* convert from image pixel to byte offset */
+ tilepixbyte = tilepix * pixlen;
+ imgpixbyte = imgpix * pixlen;
+/*
+printf(" tilepix, tilepixbyte, imgpix, imgpixbyte= %d %d %d %d\n",
+ tilepix, tilepixbyte, imgpix, imgpixbyte);
+*/
+ /* copy overlapping row of pixels from image to tile */
+ memcpy(tile + tilepixbyte, image + imgpixbyte, overlap_bytes);
+
+ tilepix += (overlap_flags * labs(inc[0]));
+ if (inc[0] > 0)
+ imgpix += overlap_flags;
+ else
+ imgpix -= overlap_flags;
+ }
+ }
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int unquantize_i1r4(long row, /* tile number = row number in table */
+ unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Unquantize byte values into the scaled floating point values
+*/
+{
+ long ii;
+ int nextrand, iseed;
+
+ if (!fits_rand_value)
+ if (fits_init_randoms()) return(MEMORY_ALLOCATION);
+
+ /* initialize the index to the next random number in the list */
+ iseed = (int) ((row - 1) % N_RANDOM);
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (float) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (float) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ }
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int unquantize_i2r4(long row, /* seed for random values */
+ short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Unquantize short integer values into the scaled floating point values
+*/
+{
+ long ii;
+ int nextrand, iseed;
+
+ if (!fits_rand_value)
+ if (fits_init_randoms()) return(MEMORY_ALLOCATION);
+
+ /* initialize the index to the next random number in the list */
+ iseed = (int) ((row - 1) % N_RANDOM);
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (float) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (float) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ }
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int unquantize_i4r4(long row, /* tile number = row number in table */
+ INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ float nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ float *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Unquantize int integer values into the scaled floating point values
+*/
+{
+ long ii;
+ int nextrand, iseed;
+
+ if (fits_rand_value == 0)
+ if (fits_init_randoms()) return(MEMORY_ALLOCATION);
+
+ /* initialize the index to the next random number in the list */
+ iseed = (int) ((row - 1) % N_RANDOM);
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (float) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (float) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ }
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int unquantize_i1r8(long row, /* tile number = row number in table */
+ unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ unsigned char tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Unquantize byte values into the scaled floating point values
+*/
+{
+ long ii;
+ int nextrand, iseed;
+
+ if (!fits_rand_value)
+ if (fits_init_randoms()) return(MEMORY_ALLOCATION);
+
+ /* initialize the index to the next random number in the list */
+ iseed = (int) ((row - 1) % N_RANDOM);
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (double) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (double) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ }
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int unquantize_i2r8(long row, /* tile number = row number in table */
+ short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ short tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Unquantize short integer values into the scaled floating point values
+*/
+{
+ long ii;
+ int nextrand, iseed;
+
+ if (!fits_rand_value)
+ if (fits_init_randoms()) return(MEMORY_ALLOCATION);
+
+ /* initialize the index to the next random number in the list */
+ iseed = (int) ((row - 1) % N_RANDOM);
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (double) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (double) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ }
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int unquantize_i4r8(long row, /* tile number = row number in table */
+ INT32BIT *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ int nullcheck, /* I - null checking code; 0 = don't check */
+ /* 1:set null pixels = nullval */
+ /* 2: if null pixel, set nullarray = 1 */
+ INT32BIT tnull, /* I - value of FITS TNULLn keyword if any */
+ double nullval, /* I - set null pixels, if nullcheck = 1 */
+ char *nullarray, /* I - bad pixel array, if nullcheck = 2 */
+ int *anynull, /* O - set to 1 if any pixels are null */
+ double *output, /* O - array of converted pixels */
+ int *status) /* IO - error status */
+/*
+ Unquantize int integer values into the scaled floating point values
+*/
+{
+ long ii;
+ int nextrand, iseed;
+
+ if (fits_rand_value == 0)
+ if (fits_init_randoms()) return(MEMORY_ALLOCATION);
+
+ /* initialize the index to the next random number in the list */
+ iseed = (int) ((row - 1) % N_RANDOM);
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+
+ if (nullcheck == 0) /* no null checking required */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ output[ii] = (double) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ }
+ else /* must check for null values */
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] == tnull)
+ {
+ *anynull = 1;
+ if (nullcheck == 1)
+ output[ii] = nullval;
+ else
+ nullarray[ii] = 1;
+ }
+ else
+ {
+ output[ii] = (double) (((double) input[ii] - fits_rand_value[nextrand] + 0.5) * scale + zero);
+ }
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int imcomp_float2nan(float *indata,
+ long tilelen,
+ int *outdata,
+ float nullflagval,
+ int *status)
+/*
+ convert pixels that are equal to nullflag to NaNs.
+ Note that indata and outdata point to the same location.
+*/
+{
+ int ii;
+
+ for (ii = 0; ii < tilelen; ii++) {
+
+ if (indata[ii] == nullflagval)
+ outdata[ii] = -1; /* integer -1 has the same bit pattern as a real*4 NaN */
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int imcomp_double2nan(double *indata,
+ long tilelen,
+ LONGLONG *outdata,
+ double nullflagval,
+ int *status)
+/*
+ convert pixels that are equal to nullflag to NaNs.
+ Note that indata and outdata point to the same location.
+*/
+{
+ int ii;
+
+ for (ii = 0; ii < tilelen; ii++) {
+
+ if (indata[ii] == nullflagval)
+ outdata[ii] = -1; /* integer -1 has the same bit pattern as a real*8 NaN */
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_transpose_table(fitsfile *infptr, fitsfile *outfptr, int *status)
+
+/*
+ Transpose the elements in the input table columns from row-major order into
+ column-major order, and write to the output table (which may be the same as
+ the input table). For example, a table with 10000 rows and 2 '1I' columns
+ will be transformed into a 1 row table with 2 '10000I' columns.
+
+ In addition, compress each column of data and write as a 1-row variable length
+ array column.
+*/
+{
+ LONGLONG nrows, incolwidth[999], inrepeat[999], outcolstart[1000], outbytespan[999];
+ LONGLONG headstart, datastart, dataend, startbyte, jj, kk, naxis1;
+ long repeat, width, pcount;
+ int ii, ncols, coltype, hdutype, ltrue = 1;
+ char *buffer, *cptr, keyname[9], tform[40], colcode[999], colname[999][50];
+ char comm[FLEN_COMMENT], *compressed_data;
+ size_t dlen, datasize;
+ float cratio[999];
+
+ if (*status > 0)
+ return(*status);
+
+ fits_get_hdu_type(infptr, &hdutype, status);
+ if (hdutype != BINARY_TBL) {
+ *status = NOT_BTABLE;
+ return(*status);
+ }
+
+ fits_get_num_rowsll(infptr, &nrows, status);
+ fits_get_num_cols(infptr, &ncols, status);
+ fits_read_key(infptr, TLONGLONG, "NAXIS1", &naxis1, NULL, status);
+ if (*status > 0)
+ return(*status);
+
+ if (nrows < 1 || ncols < 1) {
+ /* just copy the HDU if the table has 0 columns or rows */
+ if (infptr != outfptr) { /* copy input header to the output */
+ fits_copy_hdu (infptr, outfptr, 0, status);
+ }
+ return(*status);
+ }
+
+ /* allocate space for the transposed table */
+ buffer = calloc((size_t) naxis1, (size_t) nrows);
+ if (!buffer) {
+ ffpmsg("Could not allocate buffer for transformed table");
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ if (infptr != outfptr) { /* copy input header to the output */
+ fits_copy_header(infptr, outfptr, status);
+ }
+
+ outcolstart[0] = 0;
+
+ /* do initial setup for each column */
+ for (ii = 0; ii < ncols; ii++) {
+
+ /* get the column name */
+ fits_make_keyn("TTYPE", ii+1, keyname, status);
+ fits_read_key(outfptr, TSTRING, keyname, colname[ii], comm, status);
+
+ /* get the column type, repeat count, and unit width */
+ fits_make_keyn("TFORM", ii+1, keyname, status);
+ fits_read_key(outfptr, TSTRING, keyname, tform, comm, status);
+
+ /* preserve the original TFORM value and comment string */
+ keyname[0] = 'Z';
+ fits_write_key(outfptr, TSTRING, keyname, tform, comm, status);
+ keyname[0] = 'T';
+
+ fits_binary_tform(tform, &coltype, &repeat, &width, status);
+
+ /* BIT columns are a difficult case */
+ /* round up to a multiple of 8 bits */
+/*
+ if (coltype == TBIT) {
+ repeat = (repeat + 7) / 8 * 8;
+ }
+*/
+
+ cptr = tform;
+ while(isdigit(*cptr)) cptr++;
+ colcode[ii] = *cptr; /* save the column type code */
+
+ /* all columns are now VLAs */
+ fits_modify_key_str(outfptr, keyname, "1PB", "&", status);
+
+ if (coltype == TBIT) {
+ repeat = (repeat + 7) / 8; /* convert from bits to bytes */
+ } else if (coltype == TSTRING) {
+ width = 1; /* ignore the optional 'w' in 'rAw' format */
+ } else if (coltype < 0) { /* pointer to variable length array */
+ width = 8;
+ if (colcode[ii] == 'Q') width = 16; /* this is a 'Q' not a 'P' column */
+ repeat = 1;
+ }
+
+ inrepeat[ii] = repeat;
+
+ /* width (in bytes) of each element and field in the INPUT row-major table */
+ incolwidth[ii] = repeat * width;
+
+ /* starting offset of each field in the OUTPUT column-major table */
+ outcolstart[ii + 1] = outcolstart[ii] + incolwidth[ii] * nrows;
+
+ /* length of each sequence of bytes, after sorting them in signicant order */
+ outbytespan[ii] = (incolwidth[ii] * nrows) / width;
+ }
+
+ /* the transformed table has only 1 row */
+ /* output table width 8 bytes per column */
+ fits_modify_key_lng(outfptr, "NAXIS2", 1, "&", status);
+ fits_modify_key_lng(outfptr, "NAXIS1", ncols * 8, "&", status);
+
+ /* move to the start of the input table */
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ ffmbyt(infptr, datastart, 0, status);
+
+ /* now transpose the table into an array in memory */
+ for (jj = 0; jj < nrows; jj++) { /* loop over rows */
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+
+ kk = 0;
+
+ cptr = buffer + (outcolstart[ii] + (jj * incolwidth[ii])); /* addr to copy to */
+
+ startbyte = (infptr->Fptr)->bytepos; /* save the starting byte location */
+
+ ffgbyt(infptr, incolwidth[ii], cptr, status); /* copy all the bytes */
+
+ if (incolwidth[ii] >= MINDIRECT) { /* have to explicitly move to next byte */
+ ffmbyt(infptr, startbyte + incolwidth[ii], 0, status);
+ }
+ }
+ }
+
+ fits_set_hdustruc(outfptr, status);
+
+ /* now compress each column with GZIP and write out to output table */
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+
+ datasize = (size_t) (outcolstart[ii + 1] - outcolstart[ii]);
+
+ /* allocate memory for the compressed data */
+ compressed_data = malloc(datasize);
+ if (!compressed_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+
+ /* gzip compress the data */
+ compress2mem_from_mem(buffer + outcolstart[ii], datasize,
+ &compressed_data, &datasize, realloc,
+ &dlen, status);
+
+ /* write the compressed data to the output column */
+ fits_set_tscale(outfptr, ii + 1, 1.0, 0.0, status); /* turn off any data scaling, first */
+ fits_write_col(outfptr, TBYTE, ii + 1, 1, 1, dlen, compressed_data, status);
+
+ cratio[ii] = (float) datasize / (float) dlen;
+ free(compressed_data); /* don't need the compressed data any more */
+
+ sprintf(results[ii]," %3d %10.10s %4d %c %5.2f", ii+1, colname[ii], (int) inrepeat[ii],colcode[ii],cratio[ii]);
+ trans_ratio[ii] = cratio[ii];
+ }
+
+ /* save the original PCOUNT value */
+ fits_read_key(infptr, TLONG, "PCOUNT", &pcount, comm, status);
+ fits_write_key(outfptr, TLONG, "ZPCOUNT", &pcount, comm, status);
+
+ fits_write_key(outfptr, TLONGLONG, "ZNAXIS1", &naxis1, "original rows width",
+ status);
+ fits_write_key(outfptr, TLONGLONG, "ZNAXIS2", &nrows, "original number of rows",
+ status);
+
+ fits_write_key(outfptr, TLOGICAL, "TVIRTUAL", <rue,
+ "this is a virtual table", status);
+ fits_write_key(outfptr, TSTRING, "ZMETHOD", "TRANSPOSED_SHUFFLED_GZIP",
+ "table compression method", status);
+
+ fits_set_hdustruc(outfptr, status);
+
+ /* copy the heap from input to output file */
+ fits_gzip_heap(infptr, outfptr, status);
+
+ free(buffer);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_compress_table_rice(fitsfile *infptr, fitsfile *outfptr, int *status)
+
+/*
+ Transpose the elements in the input table columns from row-major order into
+ column-major order, and write to the output table (which may be the same as
+ the input table). For example, a table with 10000 rows and 2 '1I' columns
+ will be transformed into a 1 row table with 2 '10000I' columns.
+
+ Integer columns are then compressed with Rice; all other columns compressed
+ with GZIP. In addition, the bytes in the floating point numeric data values
+ (columns with TFORM = E, and D) are shuffled so that the most significant
+ byte of every element occurs first in the array, followed by the next most
+ significant byte, and so on to the least significant byte. Thus, if you
+ have 3 4-byte numeric values, the bytes 012301230123 get shuffled to
+ 000111222333
+*/
+{
+ LONGLONG nrows, incolwidth[999], inrepeat[999], outcolstart[1000], outbytespan[999];
+ LONGLONG headstart, datastart, dataend, startbyte, jj, kk, naxis1;
+ long repeat, width, pcount;
+ int ii, ncols, coltype, hdutype, ltrue = 1;
+ char *buffer, *cptr, keyname[9], tform[40], colcode[999], tempstring[20];
+ char comm[FLEN_COMMENT], *compressed_data;
+ float cratio[999];
+
+ size_t dlen, datasize;
+
+ if (*status > 0)
+ return(*status);
+
+ fits_get_hdu_type(infptr, &hdutype, status);
+ if (hdutype != BINARY_TBL) {
+ *status = NOT_BTABLE;
+ return(*status);
+ }
+
+ fits_get_num_rowsll(infptr, &nrows, status);
+ fits_get_num_cols(infptr, &ncols, status);
+ fits_read_key(infptr, TLONGLONG, "NAXIS1", &naxis1, NULL, status);
+ if (*status > 0)
+ return(*status);
+
+ if (nrows < 1 || ncols < 1) {
+ /* just copy the HDU if the table has 0 columns or rows */
+ if (infptr != outfptr) { /* copy input header to the output */
+ fits_copy_hdu (infptr, outfptr, 0, status);
+ }
+ return(*status);
+ }
+
+ /* allocate space for the transposed table */
+ buffer = calloc((size_t) naxis1, (size_t) nrows);
+ if (!buffer) {
+ ffpmsg("Could not allocate buffer for transformed table");
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ if (infptr != outfptr) { /* copy input header to the output */
+ fits_copy_header(infptr, outfptr, status);
+ }
+
+ outcolstart[0] = 0;
+ for (ii = 0; ii < ncols; ii++) {
+
+ /* get the column type, repeat count, and unit width */
+ fits_make_keyn("TFORM", ii+1, keyname, status);
+ fits_read_key(outfptr, TSTRING, keyname, tform, comm, status);
+
+ /* preserve the original TFORM value and comment string */
+ keyname[0] = 'Z';
+ fits_write_key(outfptr, TSTRING, keyname, tform, comm, status);
+ keyname[0] = 'T';
+
+ fits_binary_tform(tform, &coltype, &repeat, &width, status);
+
+ /* BIT columns are a difficult case */
+ /* round up to a multiple of 8 bits */
+/*
+ if (coltype == TBIT) {
+ repeat = (repeat + 7) / 8 * 8;
+ }
+*/
+ cptr = tform;
+ while(isdigit(*cptr)) cptr++;
+ colcode[ii] = *cptr; /* save the column type code */
+
+/* all columns are now VLAs */
+ fits_modify_key_str(outfptr, keyname, "1PB", "&", status);
+
+ if (coltype == TBIT) {
+ repeat = (repeat + 7) / 8; /* convert from bits to bytes */
+ } else if (coltype == TSTRING) {
+ width = 1; /* ignore the optional 'w' in 'rAw' format */
+ } else if (coltype < 0) { /* pointer to variable length array */
+ width = 8;
+ if (colcode[ii] == 'Q') width = 16; /* this is a 'Q' not a 'P' column */
+ repeat = 1;
+ }
+
+ inrepeat[ii] = repeat;
+
+ /* width (in bytes) of each element and field in the INPUT row-major table */
+ incolwidth[ii] = repeat * width;
+
+ /* starting offset of each field in the OUTPUT column-major table */
+ outcolstart[ii + 1] = outcolstart[ii] + incolwidth[ii] * nrows;
+
+ /* length of each sequence of bytes, after sorting them in signicant order */
+ outbytespan[ii] = (incolwidth[ii] * nrows) / width;
+ }
+
+ /* the transformed table has only 1 row */
+ /* output table width 8 bytes per column */
+
+ fits_modify_key_lng(outfptr, "NAXIS2", 1, "&", status);
+ fits_modify_key_lng(outfptr, "NAXIS1", ncols * 8, "&", status);
+
+ /* move to the start of the input table */
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ ffmbyt(infptr, datastart, 0, status);
+
+ for (jj = 0; jj < nrows; jj++) { /* loop over rows */
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+
+ kk = 0;
+
+ switch (colcode[ii]) {
+ /* separate the byte planes for the 2-byte, 4-byte, and 8-byte numeric columns */
+
+ case 'E':
+ while(kk < incolwidth[ii]) {
+ cptr = buffer + (outcolstart[ii] + (jj * inrepeat[ii]) + kk/4);
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ kk += 4;
+ }
+ break;
+
+ case 'D':
+ case 'K':
+ while(kk < incolwidth[ii]) {
+ cptr = buffer + (outcolstart[ii] + (jj * inrepeat[ii]) + kk/8);
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ kk += 8;
+ }
+ break;
+
+ default: /* don't bother separating the bytes for other column types */
+ cptr = buffer + (outcolstart[ii] + (jj * incolwidth[ii])); /* addr to copy to */
+ startbyte = (infptr->Fptr)->bytepos; /* save the starting byte location */
+
+ ffgbyt(infptr, incolwidth[ii], cptr, status); /* copy all the bytes */
+
+ if (incolwidth[ii] >= MINDIRECT) { /* have to explicitly move to next byte */
+ ffmbyt(infptr, startbyte + incolwidth[ii], 0, status);
+ }
+ }
+ }
+ }
+
+ fits_set_hdustruc(outfptr, status);
+
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+
+ datasize = (size_t) (outcolstart[ii + 1] - outcolstart[ii]);
+ /* allocate memory for the compressed data */
+ compressed_data = malloc(datasize*2);
+ if (!compressed_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+
+
+ switch (colcode[ii]) {
+
+
+ case 'I':
+#if BYTESWAPPED
+ ffswap2((short *) (buffer + outcolstart[ii]), datasize / 2);
+#endif
+ dlen = fits_rcomp_short ((short *)(buffer + outcolstart[ii]), datasize / 2, (unsigned char *) compressed_data,
+ datasize * 2, 32);
+
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "RICE_1",
+ "compression algorithm for column", status);
+
+ break;
+
+ case 'J':
+
+#if BYTESWAPPED
+ ffswap4((int *) (buffer + outcolstart[ii]), datasize / 4);
+#endif
+ dlen = fits_rcomp ((int *)(buffer + outcolstart[ii]), datasize / 4, (unsigned char *) compressed_data,
+ datasize * 2, 32);
+
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "RICE_1",
+ "compression algorithm for column", status);
+ break;
+
+ case 'B':
+ dlen = fits_rcomp_byte ((signed char *)(buffer + outcolstart[ii]), datasize, (unsigned char *) compressed_data,
+ datasize * 2, 32);
+
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "RICE_1",
+ "compression algorithm for column", status);
+ break;
+
+ default:
+ /* gzip compress the data */
+ compress2mem_from_mem(buffer + outcolstart[ii], datasize,
+ &compressed_data, &datasize, realloc, &dlen, status);
+
+
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "GZIP_2",
+ "compression algorithm for column", status);
+
+ } /* end of switch block */
+
+ if (dlen != 0)
+ cratio[ii] = (float) datasize / (float) dlen; /* compression ratio of the column */
+
+ /* write the compressed data to the output column */
+ fits_set_tscale(outfptr, ii + 1, 1.0, 0.0, status); /* turn off any data scaling, first */
+ fits_write_col(outfptr, TBYTE, ii + 1, 1, 1, dlen, compressed_data, status);
+
+ free(compressed_data); /* don't need the compressed data any more */
+/* printf(" %c %5.2f\n",colcode[ii],cratio[ii]); */
+
+ sprintf(tempstring," %5.2f\n",cratio[ii]);
+/*
+ if (colcode[ii] == 'I' || colcode[ii] == 'J' || colcode[ii] == 'B')
+ sprintf(tempstring," %5.2f\n",cratio[ii]);
+ else
+ sprintf(tempstring," \n");
+*/
+ strcat(results[ii],tempstring);
+ } /* end of loop over ncols */
+
+ printf(" Trans Shuf Rice\n");
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+ printf("%s", results[ii]);
+ }
+
+ /* save the original PCOUNT value */
+ fits_read_key(infptr, TLONG, "PCOUNT", &pcount, comm, status);
+ fits_write_key(outfptr, TLONG, "ZPCOUNT", &pcount, comm, status);
+
+
+ fits_write_key(outfptr, TLONGLONG, "ZNAXIS1", &naxis1, "original rows width",
+ status);
+ fits_write_key(outfptr, TLONGLONG, "ZNAXIS2", &nrows, "original number of rows",
+ status);
+
+ fits_write_key(outfptr, TLOGICAL, "ZTABLE", <rue,
+ "this is a compressed table", status);
+
+ free(buffer);
+
+ fits_gzip_heap(infptr, outfptr, status);
+ fits_set_hdustruc(outfptr, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_compress_table_fast(fitsfile *infptr, fitsfile *outfptr, int *status)
+
+/*
+ Compress the input FITS binary table using the 'fast' method, which consists
+ of (a) transposing the rows and columns, and (b) shuffling the bytes for
+ the I, J, K, E, and D columns so that the most significant byte of every
+ element occurs first in the array, followed by the next most significant byte,
+ and so on to the least significant byte. Thus, if you have 3 4-byte numeric
+ values, the bytes 012301230123 get shuffled to 000111222333
+
+ Finally, (c) compress each column of bytes with gzip and copy to the output table.
+
+*/
+{
+ LONGLONG nrows, incolwidth[999], inrepeat[999], outcolstart[1000], outbytespan[999];
+ LONGLONG headstart, datastart, dataend, startbyte, jj, kk, naxis1;
+ long repeat, width, pcount;
+ int ii, ncols, coltype, hdutype, ltrue = 1;
+ char *buffer, *cptr, keyname[9], tform[40], colcode[999];
+ char comm[FLEN_COMMENT], *compressed_data, tempstring[20];
+ size_t dlen, datasize;
+ float cratio[999];
+
+ if (*status > 0)
+ return(*status);
+
+ fits_get_hdu_type(infptr, &hdutype, status);
+ if (hdutype != BINARY_TBL) {
+ *status = NOT_BTABLE;
+ return(*status);
+ }
+
+ fits_get_num_rowsll(infptr, &nrows, status);
+ fits_get_num_cols(infptr, &ncols, status);
+ fits_read_key(infptr, TLONGLONG, "NAXIS1", &naxis1, NULL, status);
+ if (*status > 0)
+ return(*status);
+
+ if (nrows < 1 || ncols < 1) {
+ /* just copy the HDU if the table has 0 columns or rows */
+ if (infptr != outfptr) { /* copy input header to the output */
+ fits_copy_hdu (infptr, outfptr, 0, status);
+ }
+ return(*status);
+ }
+
+ /* allocate space for the transposed table */
+ buffer = calloc((size_t) naxis1, (size_t) nrows);
+ if (!buffer) {
+ ffpmsg("Could not allocate buffer for transformed table");
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ if (infptr != outfptr) { /* copy input header to the output */
+ fits_copy_header(infptr, outfptr, status);
+ }
+
+ fits_write_key_log(outfptr, "ZTABLE", 1,
+ "extension contains compressed binary table", status);
+
+ fits_write_key(outfptr, TLONGLONG, "ZTILELEN", &nrows,
+ "number of rows in each tile", status);
+
+ fits_write_key(outfptr, TLONGLONG, "ZNAXIS1", &naxis1, "original rows width",
+ status);
+ fits_write_key(outfptr, TLONGLONG, "ZNAXIS2", &nrows, "original number of rows",
+ status);
+
+ /* save the original PCOUNT value */
+ fits_read_key(infptr, TLONG, "PCOUNT", &pcount, comm, status);
+ fits_write_key(outfptr, TLONG, "ZPCOUNT", &pcount, comm, status);
+
+ /* reset the PCOUNT keyword to zero */
+ pcount = 0;
+ fits_modify_key_lng(outfptr, "PCOUNT", pcount, NULL, status);
+
+ outcolstart[0] = 0;
+ for (ii = 0; ii < ncols; ii++) {
+
+ /* get the column type, repeat count, and unit width */
+ fits_make_keyn("TFORM", ii+1, keyname, status);
+ fits_read_key(outfptr, TSTRING, keyname, tform, comm, status);
+
+ /* preserve the original TFORM value and comment string */
+ keyname[0] = 'Z';
+ fits_write_key(outfptr, TSTRING, keyname, tform, comm, status);
+ keyname[0] = 'T';
+
+ /* all columns are now VLAs */
+ fits_modify_key_str(outfptr, keyname, "1PB", "&", status);
+
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "GZIP_2",
+ "compression algorithm for column", status);
+
+ fits_binary_tform(tform, &coltype, &repeat, &width, status);
+
+ cptr = tform;
+ while(isdigit(*cptr)) cptr++;
+ colcode[ii] = *cptr; /* save the column type code */
+
+ if (coltype == TBIT) {
+ repeat = (repeat + 7) / 8; /* convert from bits to bytes */
+ } else if (coltype == TSTRING) {
+ width = 1; /* ignore the optional 'w' in 'rAw' format */
+ } else if (coltype < 0) { /* pointer to variable length array */
+ width = 8;
+ if (colcode[ii] == 'Q') width = 16; /* this is a 'Q' not a 'P' column */
+ repeat = 1;
+ }
+
+ inrepeat[ii] = repeat;
+
+ /* width (in bytes) of each element and field in the INPUT row-major table */
+ incolwidth[ii] = repeat * width;
+
+ /* starting offset of each field in the OUTPUT column-major table */
+ outcolstart[ii + 1] = outcolstart[ii] + incolwidth[ii] * nrows;
+
+ /* length of each sequence of bytes, after sorting them in signicant order */
+ outbytespan[ii] = (incolwidth[ii] * nrows) / width;
+
+ }
+
+ /* the transformed table has only 1 row */
+ /* output table width 8 bytes per column */
+
+ fits_modify_key_lng(outfptr, "NAXIS2", 1, "&", status);
+ fits_modify_key_lng(outfptr, "NAXIS1", ncols * 8, "&", status);
+
+ /* move to the start of the input table */
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ ffmbyt(infptr, datastart, 0, status);
+
+ for (jj = 0; jj < nrows; jj++) { /* loop over rows */
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+
+ kk = 0;
+
+ switch (colcode[ii]) {
+ /* separate the byte planes for the 2-byte, 4-byte, and 8-byte numeric columns */
+ case 'I':
+ while(kk < incolwidth[ii]) {
+
+ cptr = buffer + (outcolstart[ii] + (jj * inrepeat[ii]) + kk/2);
+ ffgbyt(infptr, 1, cptr, status); /* copy 1st byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 2nd byte */
+ kk += 2;
+ }
+
+ break;
+
+ case 'J':
+ case 'E':
+ while(kk < incolwidth[ii]) {
+ cptr = buffer + (outcolstart[ii] + (jj * inrepeat[ii]) + kk/4);
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ kk += 4;
+ }
+ break;
+
+ case 'D':
+ case 'K':
+ while(kk < incolwidth[ii]) {
+ cptr = buffer + (outcolstart[ii] + (jj * inrepeat[ii]) + kk/8);
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ cptr += outbytespan[ii];
+ ffgbyt(infptr, 1, cptr, status); /* copy 1 byte */
+ kk += 8;
+ }
+ break;
+
+ default: /* don't bother separating the bytes for other column types */
+ cptr = buffer + (outcolstart[ii] + (jj * incolwidth[ii])); /* addr to copy to */
+
+ startbyte = (infptr->Fptr)->bytepos; /* save the starting byte location */
+
+ ffgbyt(infptr, incolwidth[ii], cptr, status); /* copy all the bytes */
+
+ if (incolwidth[ii] >= MINDIRECT) { /* have to explicitly move to next byte */
+ ffmbyt(infptr, startbyte + incolwidth[ii], 0, status);
+ }
+ }
+ }
+ }
+
+ fits_set_hdustruc(outfptr, status);
+
+ /* now compress each column */
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+
+ /* write the compression type code for this column */
+ switch (colcode[ii]) {
+ case 'I':
+ case 'J':
+ case 'K':
+ case 'E':
+ case 'D':
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "GZIP_2",
+ "compression algorithm for column", status);
+ break;
+ default:
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "GZIP_1",
+ "compression algorithm for column", status);
+ }
+
+ datasize = (size_t) (outcolstart[ii + 1] - outcolstart[ii]);
+
+ /* allocate memory for the compressed data */
+ compressed_data = malloc(datasize);
+ if (!compressed_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+
+ /* gzip compress the data */
+ compress2mem_from_mem(buffer + outcolstart[ii], datasize,
+ &compressed_data, &datasize, realloc,
+ &dlen, status);
+
+ /* write the compressed data to the output column */
+ fits_set_tscale(outfptr, ii + 1, 1.0, 0.0, status); /* turn off any data scaling, first */
+ fits_write_col(outfptr, TBYTE, ii + 1, 1, 1, dlen, compressed_data, status);
+
+ cratio[ii] = (float) datasize / (float) dlen;
+ free(compressed_data); /* don't need the compressed data any more */
+
+ sprintf(tempstring," %5.2f",cratio[ii]);
+
+ strcat(results[ii],tempstring);
+ }
+
+ free(buffer);
+
+ /* shuffle and compress the input heap and append to the output file */
+
+ fits_gzip_heap(infptr, outfptr, status);
+ fits_set_hdustruc(outfptr, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_compress_table_best(fitsfile *infptr, fitsfile *outfptr, int *status)
+
+/*
+ Compress the input FITS binary table using the 'best' compression method, i.e,
+ whichever method produces the highest compression for each column.
+
+ First, transpose the rows and columns in the table, then, depending on the
+ data type of the column, try the different compression methods to see
+ which one produces the highest amount of compression.
+
+*/
+{
+ LONGLONG nrows, incolwidth[999], inrepeat[999], outcolstart[1000], outbytespan[999];
+ LONGLONG headstart, datastart, dataend, startbyte, jj, naxis1;
+ long repeat, width, pcount;
+ int ii, ncols, coltype, hdutype, ltrue = 1;
+ char *buffer, *cptr, keyname[9], tform[40], colcode[999];
+ char comm[FLEN_COMMENT];
+ char *gzip1_data = 0, *gzip2_data = 0, *rice_data = 0;
+ size_t gzip1_len, gzip2_len, rice_len, datasize, buffsize;
+
+ if (*status > 0)
+ return(*status);
+
+ fits_get_hdu_type(infptr, &hdutype, status);
+ if (hdutype != BINARY_TBL) {
+ *status = NOT_BTABLE;
+ return(*status);
+ }
+
+ fits_get_num_rowsll(infptr, &nrows, status);
+ fits_get_num_cols(infptr, &ncols, status);
+ fits_read_key(infptr, TLONGLONG, "NAXIS1", &naxis1, NULL, status);
+ if (*status > 0)
+ return(*status);
+
+ if (nrows < 1 || ncols < 1) {
+ /* just copy the HDU if the table has 0 columns or rows */
+ if (infptr != outfptr) { /* copy input header to the output */
+ fits_copy_hdu (infptr, outfptr, 0, status);
+ }
+ return(*status);
+ }
+
+ /* allocate space for the transposed table */
+ buffer = calloc((size_t) naxis1, (size_t) nrows);
+ if (!buffer) {
+ ffpmsg("Could not allocate buffer for transformed table");
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ if (infptr != outfptr) { /* copy input header to the output */
+ fits_copy_header(infptr, outfptr, status);
+ }
+
+ fits_write_key_log(outfptr, "ZTABLE", 1,
+ "extension contains compressed binary table", status);
+
+ fits_write_key(outfptr, TLONGLONG, "ZTILELEN", &nrows,
+ "number of rows in each tile", status);
+
+ fits_write_key(outfptr, TLONGLONG, "ZNAXIS1", &naxis1, "original rows width",
+ status);
+ fits_write_key(outfptr, TLONGLONG, "ZNAXIS2", &nrows, "original number of rows",
+ status);
+
+ /* save the original PCOUNT value */
+ fits_read_key(infptr, TLONG, "PCOUNT", &pcount, comm, status);
+ fits_write_key(outfptr, TLONG, "ZPCOUNT", &pcount, comm, status);
+ /* reset the PCOUNT keyword to zero */
+ pcount = 0;
+ fits_modify_key_lng(outfptr, "PCOUNT", pcount, NULL, status);
+
+ /* Modify the TFORMn keywords; all columns become variable-length arrays. */
+ /* Save the original TFORMn values in the corresponding ZFORMn keyword. */
+ outcolstart[0] = 0;
+ for (ii = 0; ii < ncols; ii++) {
+
+ /* get the column type, repeat count, and unit width */
+ fits_make_keyn("TFORM", ii+1, keyname, status);
+ fits_read_key(outfptr, TSTRING, keyname, tform, comm, status);
+
+ /* preserve the original TFORM value and comment string */
+ keyname[0] = 'Z';
+ fits_write_key(outfptr, TSTRING, keyname, tform, comm, status);
+ keyname[0] = 'T';
+
+ /* all columns are now VLAs */
+ fits_modify_key_str(outfptr, keyname, "1PB", "&", status);
+
+ fits_binary_tform(tform, &coltype, &repeat, &width, status);
+
+ cptr = tform;
+ while(isdigit(*cptr)) cptr++;
+ colcode[ii] = *cptr; /* save the column type code */
+
+ /* deal with special cases */
+ if (coltype == TBIT) {
+ repeat = (repeat + 7) / 8; /* convert from bits to bytes */
+ } else if (coltype == TSTRING) {
+ width = 1; /* ignore the optional 'w' in 'rAw' format */
+ } else if (coltype < 0) { /* pointer to variable length array */
+ repeat = 1;
+
+ if (colcode[ii] == 'Q')
+ width = 16; /* this is a 'Q' column */
+ else
+ width = 8; /* this is a 'P' column */
+ }
+
+ inrepeat[ii] = repeat;
+
+ /* width (in bytes) of each element and field in the INPUT row-major table */
+ incolwidth[ii] = repeat * width;
+
+ /* starting offset of each field in the OUTPUT column-major table */
+ outcolstart[ii + 1] = outcolstart[ii] + incolwidth[ii] * nrows;
+
+ /* length of each sequence of bytes, after sorting them in signicant order */
+ outbytespan[ii] = (incolwidth[ii] * nrows) / width;
+ }
+
+ /* the transformed table has only 1 row */
+ /* output table width 8 bytes per column */
+
+ fits_modify_key_lng(outfptr, "NAXIS2", 1, "&", status);
+ fits_modify_key_lng(outfptr, "NAXIS1", ncols * 8, "&", status);
+
+ /* move to the start of the input table */
+ fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
+ ffmbyt(infptr, datastart, 0, status);
+
+ /* now transpose the rows and columns in the table into an array in memory */
+ for (jj = 0; jj < nrows; jj++) { /* loop over rows */
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+
+ cptr = buffer + (outcolstart[ii] + (jj * incolwidth[ii])); /* output address */
+ startbyte = (infptr->Fptr)->bytepos; /* save the starting byte location */
+ ffgbyt(infptr, incolwidth[ii], cptr, status); /* copy the column element */
+
+ if (incolwidth[ii] >= MINDIRECT) { /* have to explicitly move to next byte */
+ ffmbyt(infptr, startbyte + incolwidth[ii], 0, status);
+ }
+ }
+ }
+
+ fits_set_hdustruc(outfptr, status); /* reinitialize internal pointers */
+
+ /* Now compress each column. Depending on the column data type, try */
+ /* all the various available compression algorithms, then choose the one */
+ /* that gives the most compression. */
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+
+ datasize = (size_t) (outcolstart[ii + 1] - outcolstart[ii]);
+
+ /* allocate memory for the gzip compressed data */
+ gzip1_data = malloc(datasize);
+ if (!gzip1_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+ buffsize = datasize;
+
+ /* First, simply compress the bytes with gzip (GZIP_1 algorithm code). */
+ /* This algorithm can be applied to every type of column. */
+ compress2mem_from_mem(buffer + outcolstart[ii], datasize,
+ &gzip1_data, &buffsize, realloc, &gzip1_len, status);
+
+ /* depending on the data type, try other compression methods */
+ switch (colcode[ii]) {
+
+ case 'I': /* 2-byte Integer columns */
+
+ /************* first, try rice compression *****************/
+ rice_data = malloc(datasize * 2); /* memory for the compressed bytes */
+ if (!rice_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+
+#if BYTESWAPPED
+ /* have to swap the bytes on little endian machines */
+ ffswap2((short *) (buffer + outcolstart[ii]), datasize / 2);
+#endif
+ rice_len = fits_rcomp_short ((short *)(buffer + outcolstart[ii]), datasize / 2,
+ (unsigned char *) rice_data, datasize * 2, 32);
+
+#if BYTESWAPPED
+ /* un-swap the bytes, to restore the original order */
+ ffswap2((short *) (buffer + outcolstart[ii]), datasize / 2);
+#endif
+
+ /************* Second, try shuffled gzip compression *****************/
+ fits_shuffle_2bytes(buffer + outcolstart[ii], datasize / 2, status);
+
+ /* allocate memory for the shuffled gzip compressed data */
+ gzip2_data = malloc(datasize);
+ if (!gzip2_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+ buffsize = datasize;
+
+ compress2mem_from_mem(buffer + outcolstart[ii], datasize,
+ &gzip2_data, &buffsize, realloc, &gzip2_len, status);
+ break;
+
+ case 'J': /* 4-byte Integer columns */
+
+ /************* first, try rice compression *****************/
+ rice_data = malloc(datasize * 2); /* memory for the compressed bytes */
+ if (!rice_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+#if BYTESWAPPED
+ /* have to swap the bytes on little endian machines */
+ ffswap4((int *) (buffer + outcolstart[ii]), datasize / 4);
+#endif
+ rice_len = fits_rcomp ((int *)(buffer + outcolstart[ii]), datasize / 4,
+ (unsigned char *) rice_data, datasize * 2, 32);
+
+#if BYTESWAPPED
+ /* un-swap the bytes, to restore the original order */
+ ffswap4((int *) (buffer + outcolstart[ii]), datasize / 4);
+#endif
+
+ /************* Second, try shuffled gzip compression *****************/
+ fits_shuffle_4bytes(buffer + outcolstart[ii], datasize / 4, status);
+
+ /* allocate memory for the shuffled gzip compressed data */
+ gzip2_data = malloc(datasize);
+ if (!gzip2_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+ buffsize = datasize;
+
+ compress2mem_from_mem(buffer + outcolstart[ii], datasize,
+ &gzip2_data, &buffsize, realloc, &gzip2_len, status);
+ break;
+
+ case 'E': /* 4-byte floating-point */
+
+ /************* try shuffled gzip compression *****************/
+ fits_shuffle_4bytes(buffer + outcolstart[ii], datasize / 4, status);
+
+ /* allocate memory for the gzip compressed data */
+ gzip2_data = malloc(datasize);
+ if (!gzip2_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+ buffsize = datasize;
+
+ compress2mem_from_mem(buffer + outcolstart[ii], datasize,
+ &gzip2_data, &buffsize, realloc, &gzip2_len, status);
+
+ rice_len = 100 * datasize; /* rice is not applicable to R*4 data */
+
+ break;
+
+ case 'K':
+ case 'D': /* 8-byte floating-point or integers */
+
+ /************* try shuffled gzip compression *****************/
+ fits_shuffle_8bytes(buffer + outcolstart[ii], datasize / 8, status);
+
+ /* allocate memory for the gzip compressed data */
+ gzip2_data = malloc(datasize);
+ if (!gzip2_data) {
+ ffpmsg("data memory allocation error");
+ return(-1);
+ }
+ buffsize = datasize;
+
+ compress2mem_from_mem(buffer + outcolstart[ii], datasize,
+ &gzip2_data, &buffsize, realloc, &gzip2_len, status);
+
+ rice_len = 100 * datasize; /* rice is not applicable to R*8 or I*8 data */
+
+ break;
+
+ default: /* L, X, B, A, C, M, P, Q type columns: no other compression options */
+ rice_len = 100 * datasize; /* rice is not applicable */
+ gzip2_len = 100 * datasize; /* shuffled-gzip is not applicable */
+
+ } /* end of switch block */
+
+ /* now write the compressed bytes from the best algorithm */
+ fits_set_tscale(outfptr, ii + 1, 1.0, 0.0, status); /* turn off any data scaling, first */
+ if (gzip1_len <= gzip2_len && gzip1_len <= rice_len) {
+
+ fits_write_col(outfptr, TBYTE, ii + 1, 1, 1, gzip1_len, gzip1_data, status);
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "GZIP_1",
+ "compression algorithm for column", status);
+ } else if (gzip2_len <= gzip1_len && gzip2_len <= rice_len) {
+ fits_write_col(outfptr, TBYTE, ii + 1, 1, 1, gzip2_len, gzip2_data, status);
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "GZIP_2",
+ "compression algorithm for column", status);
+ } else {
+ fits_write_col(outfptr, TBYTE, ii + 1, 1, 1, rice_len, rice_data, status);
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ fits_write_key(outfptr, TSTRING, keyname, "RICE_1",
+ "compression algorithm for column", status);
+ }
+
+ /* free the temporary memory */
+ if (gzip1_data) free(gzip1_data);
+ if (gzip2_data) free(gzip2_data);
+ gzip1_data = 0;
+ gzip2_data = 0;
+ }
+
+ free(buffer);
+
+ /* shuffle and compress the input heap and append to the output file */
+
+ fits_gzip_heap(infptr, outfptr, status);
+ fits_set_hdustruc(outfptr, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_uncompress_table(fitsfile *infptr, fitsfile *outfptr, int *status)
+
+/*
+ Uncompress the table that was compressed with fits_compress_table_fast or
+ fits_compress_table_best.
+*/
+{
+ LONGLONG nrows, rmajor_colwidth[999], rmajor_colstart[1000], cmajor_colstart[1000];
+ LONGLONG cmajor_repeat[999], rmajor_repeat[999], cmajor_bytespan[999], kk;
+ LONGLONG headstart, datastart, dataend;
+ long repeat, width, vla_repeat;
+ int ncols, coltype, hdutype, anynull, tstatus, zctype[999];
+ char *buffer, *transbuffer, *cptr, keyname[9], tform[40], colcode[999];
+ long pcount, zheapptr, naxis1, naxis2, ii, jj;
+ char *ptr, comm[FLEN_COMMENT], zvalue[FLEN_VALUE];
+ size_t dlen, fullsize;
+
+ /**** do initial sanity checks *****/
+ if (*status > 0)
+ return(*status);
+
+ fits_get_hdu_type(infptr, &hdutype, status);
+ if (hdutype != BINARY_TBL) {
+ *status = NOT_BTABLE;
+ return(*status);
+ }
+
+ fits_get_num_rowsll(infptr, &nrows, status);
+ fits_get_num_cols(infptr, &ncols, status);
+
+ if (nrows != 1 || (ncols < 1)) {
+ /* just copy the HDU if the table does not have 1 row and
+ more than 0 columns */
+ if (infptr != outfptr) {
+ fits_copy_hdu (infptr, outfptr, 0, status);
+ }
+ return(*status);
+ }
+
+ /**** get size of the uncompressed table */
+ fits_read_key(infptr, TLONG, "ZNAXIS1", &naxis1, comm, status);
+ if (*status > 0) {
+ ffpmsg("Could not find the required ZNAXIS1 keyword");
+ *status = 1;
+ return(*status);
+ }
+
+ fits_read_key(infptr, TLONG, "ZNAXIS2", &naxis2, comm, status);
+ if (*status > 0) {
+ ffpmsg("Could not find the required ZNAXIS2 keyword");
+ *status = 1;
+ return(*status);
+ }
+
+ fits_read_key(infptr, TLONG, "ZPCOUNT", &pcount, comm, status);
+ if (*status > 0) {
+ ffpmsg("Could not find the required ZPCOUNT keyword");
+ *status = 1;
+ return(*status);
+ }
+
+ tstatus = 0;
+ fits_read_key(infptr, TLONG, "ZHEAPPTR", &zheapptr, comm, &tstatus);
+ if (tstatus > 0) {
+ zheapptr = 0; /* uncompressed table has no heap */
+ }
+
+ /**** recreate the uncompressed table header keywords ****/
+ fits_copy_header(infptr, outfptr, status);
+
+ /* reset the NAXISn keywords to what they were in the original uncompressed table */
+ fits_modify_key_lng(outfptr, "NAXIS1", naxis1, "&", status);
+ fits_modify_key_lng(outfptr, "NAXIS2", naxis2, "&", status);
+ fits_modify_key_lng(outfptr, "PCOUNT", pcount, "&", status);
+
+ fits_delete_key(outfptr, "ZTABLE", status);
+ fits_delete_key(outfptr, "ZNAXIS1", status);
+ fits_delete_key(outfptr, "ZNAXIS2", status);
+ fits_delete_key(outfptr, "ZPCOUNT", status);
+ fits_delete_key(outfptr, "ZTILELEN", status);
+ tstatus = 0;
+ fits_delete_key(outfptr, "ZHEAPPTR", &tstatus);
+
+ /**** get the compression method that was used for each column ****/
+ for (ii = 0; ii < ncols; ii++) {
+
+ /* construct the ZCTYPn keyword name then read the keyword */
+ fits_make_keyn("ZCTYP", ii+1, keyname, status);
+ tstatus = 0;
+ fits_read_key(infptr, TSTRING, keyname, zvalue, NULL, &tstatus);
+ if (tstatus) {
+ zctype[ii] = GZIP_2;
+ } else {
+ if (!strcmp(zvalue, "GZIP_2")) {
+ zctype[ii] = GZIP_2;
+ } else if (!strcmp(zvalue, "GZIP_1")) {
+ zctype[ii] = GZIP_1;
+ } else if (!strcmp(zvalue, "RICE_1")) {
+ zctype[ii] = RICE_1;
+ } else {
+ ffpmsg("Unrecognized ZCTYPn keyword compression code:");
+ ffpmsg(zvalue);
+ *status = DATA_DECOMPRESSION_ERR;
+ return(*status);
+ }
+
+ /* delete this keyword from the uncompressed header */
+ fits_delete_key(outfptr, keyname, status);
+ }
+ }
+
+ /**** allocate space for the full transposed and untransposed table ****/
+ fullsize = naxis1 * naxis2;
+ transbuffer = malloc(fullsize);
+ if (!transbuffer) {
+ ffpmsg("Could not allocate buffer for shuffled table");
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ buffer = malloc(fullsize);
+ if (!buffer) {
+ ffpmsg("Could not allocate buffer for unshuffled table");
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /*** loop over each column: read and uncompress the bytes ****/
+ rmajor_colstart[0] = 0;
+ cmajor_colstart[0] = 0;
+ for (ii = 0; ii < ncols; ii++) {
+
+ /* get the original column type, repeat count, and unit width */
+ fits_make_keyn("ZFORM", ii+1, keyname, status);
+ fits_read_key(infptr, TSTRING, keyname, tform, comm, status);
+
+ /* restore the original TFORM value and comment */
+ keyname[0] = 'T';
+ fits_modify_key_str(outfptr, keyname, tform, comm, status);
+
+ /* now delete the ZFORM keyword */
+ keyname[0] = 'Z';
+ fits_delete_key(outfptr, keyname, status);
+
+ cptr = tform;
+ while(isdigit(*cptr)) cptr++;
+ colcode[ii] = *cptr; /* save the column type code */
+
+ fits_binary_tform(tform, &coltype, &repeat, &width, status);
+
+ /* deal with special cases */
+ if (coltype == TBIT) {
+ repeat = (repeat + 7) / 8 ; /* convert from bits to bytes */
+ } else if (coltype == TSTRING) {
+ width = 1;
+ } else if (coltype < 0) { /* pointer to variable length array */
+ if (colcode[ii] == 'P')
+ width = 8; /* this is a 'P' column */
+ else
+ width = 16; /* this is a 'Q' not a 'P' column */
+ }
+
+ rmajor_repeat[ii] = repeat;
+ cmajor_repeat[ii] = repeat * naxis2;
+
+ /* width (in bytes) of each field in the row-major table */
+ rmajor_colwidth[ii] = rmajor_repeat[ii] * width;
+
+ /* starting offset of each field in the column-major table */
+ cmajor_colstart[ii + 1] = cmajor_colstart[ii] + rmajor_colwidth[ii] * naxis2;
+
+ /* length of each sequence of bytes, after sorting them in signicant order */
+ cmajor_bytespan[ii] = (rmajor_colwidth[ii] * naxis2) / width;
+
+ /* starting offset of each field in the row-major table */
+ rmajor_colstart[ii + 1] = rmajor_colstart[ii] + rmajor_colwidth[ii];
+
+ /* read compressed bytes from input table */
+ fits_read_descript(infptr, ii + 1, 1, &vla_repeat, NULL, status);
+
+ /* allocate memory and read in the compressed bytes */
+ ptr = malloc(vla_repeat);
+ if (!ptr) {
+ ffpmsg("Could not allocate buffer for compressed bytes");
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ fits_set_tscale(infptr, ii + 1, 1.0, 0.0, status); /* turn off any data scaling, first */
+ fits_read_col_byt(infptr, ii + 1, 1, 1, vla_repeat, 0, (unsigned char *) ptr, &anynull, status);
+
+ cptr = transbuffer + cmajor_colstart[ii];
+
+ fullsize = (size_t) (cmajor_colstart[ii+1] - cmajor_colstart[ii]);
+
+ switch (colcode[ii]) {
+ /* separate the byte planes for the 2-byte, 4-byte, and 8-byte numeric columns */
+
+
+ case 'I':
+
+ if (zctype[ii] == RICE_1) {
+ dlen = fits_rdecomp_short((unsigned char *)ptr, vla_repeat, (unsigned short *)cptr,
+ fullsize / 2, 32);
+#if BYTESWAPPED
+ ffswap2((short *) cptr, fullsize / 2);
+#endif
+ } else { /* gunzip the data into the correct location */
+ uncompress2mem_from_mem(ptr, vla_repeat, &cptr, &fullsize, realloc, &dlen, status);
+ }
+ break;
+
+ case 'J':
+
+ if (zctype[ii] == RICE_1) {
+ dlen = fits_rdecomp ((unsigned char *) ptr, vla_repeat, (unsigned int *)cptr,
+ fullsize / 4, 32);
+#if BYTESWAPPED
+ ffswap4((int *) cptr, fullsize / 4);
+#endif
+ } else { /* gunzip the data into the correct location */
+ uncompress2mem_from_mem(ptr, vla_repeat, &cptr, &fullsize, realloc, &dlen, status);
+ }
+ break;
+
+ case 'B':
+
+ if (zctype[ii] == RICE_1) {
+ dlen = fits_rdecomp_byte ((unsigned char *) ptr, vla_repeat, (unsigned char *)cptr,
+ fullsize, 32);
+ } else { /* gunzip the data into the correct location */
+ uncompress2mem_from_mem(ptr, vla_repeat, &cptr, &fullsize, realloc, &dlen, status);
+ }
+ break;
+
+ default:
+ /* gunzip the data into the correct location in the full table buffer */
+ uncompress2mem_from_mem(ptr, vla_repeat,
+ &cptr, &fullsize, realloc, &dlen, status);
+
+ } /* end of switch block */
+
+ free(ptr);
+ }
+
+ /* now transpose the rows and columns (from transbuffer to buffer) */
+ ptr = transbuffer;
+ for (ii = 0; ii < ncols; ii++) { /* loop over columns */
+
+ if ((zctype[ii] == GZIP_2)) { /* need to unshuffle the bytes */
+
+ switch (colcode[ii]) {
+
+ /* recombine the byte planes for the 2-byte, 4-byte, and 8-byte numeric columns */
+
+ case 'I':
+ /* get the 1st byte of each I*2 value */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]));
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 2;
+ }
+ }
+
+ /* get the 2nd byte of each I*2 value */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 1);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 2;
+ }
+ }
+
+ break;
+
+ case 'J':
+ case 'E':
+
+ /* get the 1st byte of each 4-byte value */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]));
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 4;
+ }
+ }
+
+ /* get the 2nd byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 1);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 4;
+ }
+ }
+
+ /* get the 3rd byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 2);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 4;
+ }
+ }
+
+ /* get the 4th byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 3);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 4;
+ }
+ }
+
+ break;
+
+ case 'D':
+ case 'K':
+
+ /* get the 1st byte of each 8-byte value */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]));
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 8;
+ }
+ }
+
+ /* get the 2nd byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 1);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 8;
+ }
+ }
+
+ /* get the 3rd byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 2);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 8;
+ }
+ }
+
+ /* get the 4th byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 3);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 8;
+ }
+ }
+
+ /* get the 5th byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 4);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 8;
+ }
+ }
+
+ /* get the 6th byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 5);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 8;
+ }
+ }
+
+ /* get the 7th byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 6);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 8;
+ }
+ }
+
+ /* get the 8th byte */
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + (jj * rmajor_colstart[ncols]) + 7);
+ for (kk = 0; kk < rmajor_repeat[ii]; kk++) {
+ *cptr = *ptr; /* copy 1 byte */
+ ptr++;
+ cptr += 8;
+ }
+ }
+
+ break;
+ default: /* should never get here */
+ ffpmsg("Error: unexpected use of GZIP_2 to compress a column");
+ *status = DATA_DECOMPRESSION_ERR;
+ return(*status);
+
+ } /* end of switch */
+
+ } else { /* not GZIP_2, so just transpose the bytes */
+
+ for (jj = 0; jj < naxis2; jj++) { /* loop over number of rows in the output table */
+ cptr = buffer + (rmajor_colstart[ii] + jj * rmajor_colstart[ncols]); /* addr to copy to */
+ memcpy(cptr, ptr, (size_t) rmajor_colwidth[ii]);
+
+ ptr += (rmajor_colwidth[ii]);
+ }
+ }
+
+ } /* end of ncols loop */
+
+ /* copy the buffer of data to the output data unit */
+ fits_get_hduaddrll(outfptr, &headstart, &datastart, &dataend, status);
+ ffmbyt(outfptr, datastart, 1, status);
+ ffpbyt(outfptr, naxis1 * naxis2, buffer, status);
+ free(buffer);
+ free(transbuffer);
+
+ /* reset internal table structure parameters */
+ fits_set_hdustruc(outfptr, status);
+
+ /* unshuffle the heap, if it exists */
+ fits_gunzip_heap(infptr, outfptr, status);
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int fits_gzip_datablocks(fitsfile *fptr, size_t *size, int *status)
+/*
+ GZIP compress all the data blocks in the binary table HDU.
+ Store the size of the compressed byte stream in the PCOUNT keyword.
+ Save the original PCOUNT value in the ZPCOUNT keyword.
+*/
+{
+ long headstart, datastart, dataend;
+ char *ptr, *cptr, *iptr;
+ size_t dlen, datasize, ii;
+
+ /* allocate memory for the data and the compressed data */
+ fits_get_hduaddr(fptr, &headstart, &datastart, &dataend, status);
+ datasize = dataend - datastart;
+ ptr = malloc(datasize);
+ cptr = malloc(datasize);
+ if (!ptr || !cptr) {
+ ffpmsg("data memory allocation error in fits_gzip_datablocks\n");
+ return(-1);
+ }
+
+ /* copy the data into memory */
+ ffmbyt(fptr,datastart, REPORT_EOF, status);
+ iptr = ptr;
+ for (ii = 0; ii < datasize; ii+= 2880) {
+ ffgbyt(fptr, 2880, iptr, status);
+ iptr += 2880;
+ }
+
+ /* gzip compress the data */
+ compress2mem_from_mem(ptr, datasize,
+ &cptr, &datasize, realloc,
+ &dlen, status);
+
+ *size = dlen;
+
+ free(cptr); /* don't need the compressed data any more */
+ free(ptr); /* don't need the original data any more */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int fits_gzip_heap(fitsfile *infptr, fitsfile *outfptr, int *status)
+
+/*
+ Compress the binary table heap in the input file and write it to the output file.
+ First, shuffle the bytes for the numeric arrays in the heap, so that
+ the bytes are sorted in order of decreasing significance. Then gzip
+ the entire heap as a single block of data. Then append this compressed heap
+ to the end of any existing data in the output file heap.
+*/
+{
+ LONGLONG datastart, dataend, nrows, naxis1, heapsize, length, offset, pcount, jj;
+ int coltype, ncols, ii;
+ char *heap, *compheap, card[FLEN_CARD];
+ size_t theapsize, compsize;
+
+ if (*status > 0)
+ return(*status);
+
+ /* insert a set of COMMENT keyword to indicate that this is a compressed table */
+ fits_read_card(outfptr, "TFIELDS", card, status);
+ fits_insert_card(outfptr, "COMMENT [FPACK] This is a compressed binary table generated by fpack.", status);
+ fits_insert_card(outfptr, "COMMENT [FPACK] It can be uncompressed using funpack.", status);
+ fits_insert_card(outfptr, "COMMENT [FPACK] fpack and funpack are available from the HEASARC Web site.", status);
+
+ /* get the size of the heap (value of PCOUNT keyword) */
+ fits_read_key(infptr, TLONGLONG, "PCOUNT", &heapsize, NULL, status);
+
+ /* return if there is no heap */
+ if (*status != 0 || heapsize == 0)
+ return(*status);
+
+ /* allocate memory for the heap and compressed heap */
+
+ heap = malloc((size_t) heapsize);
+ if (!heap) {
+ ffpmsg("Could not allocate buffer for the heap (fits_gzip_heap");
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ compheap = malloc((size_t) heapsize);
+ if (!compheap) {
+ ffpmsg("Could not allocate buffer for compressed heap (fits_gzip_heap");
+ free(heap);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ fits_get_hduaddrll(infptr, NULL, &datastart, NULL, status);
+ fits_get_num_rowsll(infptr, &nrows, status);
+ fits_get_num_cols(infptr, &ncols, status);
+ fits_read_key(infptr, TLONGLONG, "NAXIS1", &naxis1, NULL, status);
+
+ /* move to start of the heap and copy the heap into memory */
+ ffmbyt(infptr, datastart + (nrows * naxis1), REPORT_EOF, status);
+ ffgbyt(infptr, heapsize, heap, status);
+
+ /* shuffle the bytes for the numeric columns */
+ for (ii = 1; ii <= ncols; ii++) {
+
+ fits_get_coltype(infptr, ii, &coltype, NULL, NULL, status);
+
+ if (coltype >= 0) continue; /* only interested in variable length columns */
+
+ coltype = coltype * (-1);
+
+ switch (coltype) {
+ /* shuffle the bytes for the 2-byte, 4-byte, and 8-byte numeric columns */
+ case TSHORT:
+
+ for (jj = 1; jj <= nrows; jj++) {
+ fits_read_descriptll(infptr, ii, jj, &length, &offset, status);
+ fits_shuffle_2bytes(heap + offset, length, status);
+ }
+ break;
+
+ case TLONG:
+ case TFLOAT:
+ for (jj = 1; jj <= nrows; jj++) {
+ fits_read_descriptll(infptr, ii, jj, &length, &offset, status);
+ fits_shuffle_4bytes(heap + offset, length, status);
+ }
+ break;
+
+ case TDOUBLE:
+ case TLONGLONG:
+ for (jj = 1; jj <= nrows; jj++) {
+ fits_read_descriptll(infptr, ii, jj, &length, &offset, status);
+ fits_shuffle_8bytes(heap + offset, length, status);
+ }
+ break;
+
+ default: /* don't have to do anything for other column types */
+ break;
+
+ } /* end of switch block */
+ }
+
+ /* gzip compress the shuffled heap */
+ theapsize = (size_t) heapsize;
+ compress2mem_from_mem(heap, (size_t) heapsize, &compheap, &theapsize,
+ realloc, &compsize, status);
+ free(heap); /* don't need the uncompresse heap any more */
+
+ /* update the internal pointers */
+ fits_set_hdustruc(outfptr, status);
+
+ /* save offset to the start of the compressed heap, relative to the
+ start of the main data table in the ZHEAPPTR keyword, and
+ update PCOUNT to the new extended heap size */
+
+ fits_read_key(outfptr, TLONGLONG, "PCOUNT", &pcount, NULL, status);
+ fits_get_num_rowsll(outfptr, &nrows, status);
+ fits_read_key(outfptr, TLONGLONG, "NAXIS1", &naxis1, NULL, status);
+
+ fits_write_key_lng(outfptr, "ZHEAPPTR", (LONGLONG) ((nrows * naxis1) + pcount),
+ "byte offset to compressed heap", status);
+ fits_modify_key_lng(outfptr, "PCOUNT", pcount + compsize, NULL, status);
+
+ /* now append the compressed heap to the heap in the output file */
+ dataend = (outfptr->Fptr)->datastart + (outfptr->Fptr)->heapstart +
+ (outfptr->Fptr)->heapsize;
+
+ ffmbyt(outfptr, dataend, IGNORE_EOF, status);
+ ffpbyt(outfptr, compsize, compheap, status);
+ free(compheap);
+
+ /* also update the internal pointer to the heap size */
+ (outfptr->Fptr)->heapsize = (outfptr->Fptr)->heapsize + compsize;
+
+ /* update the internal pointers again */
+ fits_set_hdustruc(outfptr, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int fits_shuffle_2bytes(char *heap, LONGLONG length, int *status)
+
+/* shuffle the bytes in an array of 2-byte integers in the heap */
+
+{
+ LONGLONG ii;
+ char *ptr, *cptr, *heapptr;
+
+ ptr = malloc((size_t) (length * 2));
+ heapptr = heap;
+ cptr = ptr;
+
+ for (ii = 0; ii < length; ii++) {
+ *cptr = *heapptr;
+ heapptr++;
+ *(cptr + length) = *heapptr;
+ heapptr++;
+ cptr++;
+ }
+
+ memcpy(heap, ptr, (size_t) (length * 2));
+ free(ptr);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int fits_shuffle_4bytes(char *heap, LONGLONG length, int *status)
+
+/* shuffle the bytes in an array of 4-byte integers or floats */
+
+{
+ LONGLONG ii;
+ char *ptr, *cptr, *heapptr;
+
+ ptr = malloc((size_t) (length * 4));
+ if (!ptr) {
+ ffpmsg("malloc failed\n");
+ return(*status);
+ }
+
+ heapptr = heap;
+ cptr = ptr;
+
+ for (ii = 0; ii < length; ii++) {
+ *cptr = *heapptr;
+ heapptr++;
+ *(cptr + length) = *heapptr;
+ heapptr++;
+ *(cptr + (length * 2)) = *heapptr;
+ heapptr++;
+ *(cptr + (length * 3)) = *heapptr;
+ heapptr++;
+ cptr++;
+ }
+
+ memcpy(heap, ptr, (size_t) (length * 4));
+ free(ptr);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int fits_shuffle_8bytes(char *heap, LONGLONG length, int *status)
+
+/* shuffle the bytes in an array of 8-byte integers or doubles in the heap */
+
+{
+ LONGLONG ii;
+ char *ptr, *cptr, *heapptr;
+
+ ptr = calloc(1, (size_t) (length * 8));
+ heapptr = heap;
+
+/* for some bizarre reason this loop fails to compile under OpenSolaris using
+ the proprietary SunStudioExpress C compiler; use the following equivalent
+ loop instead.
+
+ cptr = ptr;
+
+ for (ii = 0; ii < length; ii++) {
+ *cptr = *heapptr;
+ heapptr++;
+ *(cptr + length) = *heapptr;
+ heapptr++;
+ *(cptr + (length * 2)) = *heapptr;
+ heapptr++;
+ *(cptr + (length * 3)) = *heapptr;
+ heapptr++;
+ *(cptr + (length * 4)) = *heapptr;
+ heapptr++;
+ *(cptr + (length * 5)) = *heapptr;
+ heapptr++;
+ *(cptr + (length * 6)) = *heapptr;
+ heapptr++;
+ *(cptr + (length * 7)) = *heapptr;
+ heapptr++;
+ cptr++;
+ }
+*/
+ for (ii = 0; ii < length; ii++) {
+ cptr = ptr + ii;
+
+ *cptr = *heapptr;
+
+ heapptr++;
+ cptr += length;
+ *cptr = *heapptr;
+
+ heapptr++;
+ cptr += length;
+ *cptr = *heapptr;
+
+ heapptr++;
+ cptr += length;
+ *cptr = *heapptr;
+
+ heapptr++;
+ cptr += length;
+ *cptr = *heapptr;
+
+ heapptr++;
+ cptr += length;
+ *cptr = *heapptr;
+
+ heapptr++;
+ cptr += length;
+ *cptr = *heapptr;
+
+ heapptr++;
+ cptr += length;
+ *cptr = *heapptr;
+
+ heapptr++;
+ }
+
+ memcpy(heap, ptr, (size_t) (length * 8));
+ free(ptr);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int fits_gunzip_heap(fitsfile *infptr, fitsfile *outfptr, int *status)
+
+/*
+ inverse of the fits_gzip_heap function: uncompress and unshuffle the heap
+ in the input file and write it to the output file
+*/
+{
+ LONGLONG datastart, nrows, naxis1, length, offset, pcount, jj;
+ LONGLONG zpcount, zheapptr, cheapsize;
+ int coltype, ncols, ii;
+ char *heap, *compheap;
+ size_t arraysize, theapsize;
+
+ if (*status > 0)
+ return(*status);
+
+ /* first, delete any COMMENT keywords written by fits_gzip_heap */
+ while (*status == 0) {
+ fits_delete_str(outfptr, "COMMENT [FPACK]", status);
+ }
+ if (*status == KEY_NO_EXIST) *status = 0;
+
+ /* ZPCOUNT = size of original uncompressed heap */
+ fits_read_key(infptr, TLONGLONG, "ZPCOUNT", &zpcount, NULL, status);
+
+ /* just return if there is no heap */
+ if (*status != 0 || zpcount == 0)
+ return(*status);
+
+ fits_get_num_rowsll(infptr, &nrows, status);
+ fits_read_key(infptr, TLONGLONG, "NAXIS1", &naxis1, NULL, status);
+
+ /* ZHEAPPTR = offset to the start of the compressed heap */
+ fits_read_key(infptr, TLONGLONG, "ZHEAPPTR", &zheapptr, NULL, status);
+
+ /* PCOUNT = total size of the compressed 2D table plus the compressed heap */
+ fits_read_key(infptr, TLONGLONG, "PCOUNT", &pcount, NULL, status);
+
+ /* size of the compressed heap */
+ cheapsize = pcount - (zheapptr - (naxis1 * nrows));
+
+ /* allocate memory for the heap and uncompressed heap */
+ arraysize = (size_t) zpcount;
+ heap = malloc(arraysize);
+ if (!heap) {
+ ffpmsg("Could not allocate buffer for the heap (fits_gunzip_heap");
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ compheap = malloc((size_t) cheapsize);
+ if (!compheap) {
+ ffpmsg("Could not allocate buffer for compressed heap (fits_gunzip_heap");
+ free(heap);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ fits_get_hduaddrll(infptr, NULL, &datastart, NULL, status);
+
+ /* read the compressed heap into memory */
+ ffmbyt(infptr, datastart + zheapptr, REPORT_EOF, status);
+ ffgbyt(infptr, cheapsize, compheap, status);
+
+ /* uncompress the heap */
+ theapsize = (size_t) zpcount;
+ uncompress2mem_from_mem(compheap, (size_t) cheapsize, &heap, &arraysize,
+ realloc, &theapsize, status);
+
+ free(compheap); /* don't need the compressed heap any more */
+
+ if (theapsize != zpcount) {
+ /* something is wrong */
+ ffpmsg("uncompressed heap size != to ZPCOUNT");
+ free(heap);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* get dimensions of the uncompressed table */
+ fits_get_num_rowsll(outfptr, &nrows, status);
+ fits_read_key(outfptr, TLONGLONG, "NAXIS1", &naxis1, NULL, status);
+ fits_get_num_cols(outfptr, &ncols, status);
+
+ for (ii = ncols; ii > 0; ii--) {
+
+ fits_get_coltype(outfptr, ii, &coltype, NULL, NULL, status);
+
+ if (coltype >= 0) continue; /* only interested in variable length columns */
+
+ coltype = coltype * (-1);
+
+ switch (coltype) {
+ /* recombine the byte planes for the 2-byte, 4-byte, and 8-byte numeric columns */
+ case TSHORT:
+
+ for (jj = nrows; jj > 0; jj--) {
+ fits_read_descriptll(outfptr, ii, jj, &length, &offset, status);
+ fits_unshuffle_2bytes(heap + offset, length, status);
+ }
+ break;
+
+ case TLONG:
+ case TFLOAT:
+ for (jj = nrows; jj > 0; jj--) {
+ fits_read_descriptll(outfptr, ii, jj, &length, &offset, status);
+ fits_unshuffle_4bytes(heap + offset, length, status);
+ }
+ break;
+
+ case TDOUBLE:
+ case TLONGLONG:
+ for (jj = nrows; jj > 0; jj--) {
+ fits_read_descriptll(outfptr, ii, jj, &length, &offset, status);
+ fits_unshuffle_8bytes(heap + offset, length, status);
+ }
+ break;
+
+ default: /* don't need to recombine bytes for other column types */
+ break;
+
+ } /* end of switch block */
+ }
+
+ /* copy the unshuffled heap back to the output file */
+ fits_get_hduaddrll(outfptr, NULL, &datastart, NULL, status);
+
+ ffmbyt(outfptr, datastart + (nrows * naxis1), IGNORE_EOF, status);
+ ffpbyt(outfptr, zpcount, heap, status);
+
+ free(heap);
+
+ /* also update the internal pointer to the heap size */
+ (outfptr->Fptr)->heapsize = zpcount;
+
+ /* update the internal pointers again */
+ fits_set_hdustruc(outfptr, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int fits_unshuffle_2bytes(char *heap, LONGLONG length, int *status)
+
+/* unshuffle the bytes in an array of 2-byte integers */
+
+{
+ LONGLONG ii;
+ char *ptr, *cptr, *heapptr;
+
+ ptr = malloc((size_t) (length * 2));
+ heapptr = heap + (2 * length) - 1;
+ cptr = ptr + (2 * length) - 1;
+
+ for (ii = 0; ii < length; ii++) {
+ *cptr = *heapptr;
+ cptr--;
+ *cptr = *(heapptr - length);
+ cptr--;
+ heapptr--;
+ }
+
+ memcpy(heap, ptr, (size_t) (length * 2));
+ free(ptr);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int fits_unshuffle_4bytes(char *heap, LONGLONG length, int *status)
+
+/* unshuffle the bytes in an array of 4-byte integers or floats */
+
+{
+ LONGLONG ii;
+ char *ptr, *cptr, *heapptr;
+
+ ptr = malloc((size_t) (length * 4));
+ heapptr = heap + (4 * length) -1;
+ cptr = ptr + (4 * length) -1;
+
+ for (ii = 0; ii < length; ii++) {
+ *cptr = *heapptr;
+ cptr--;
+ *cptr = *(heapptr - length);
+ cptr--;
+ *cptr = *(heapptr - (2 * length));
+ cptr--;
+ *cptr = *(heapptr - (3 * length));
+ cptr--;
+ heapptr--;
+ }
+
+ memcpy(heap, ptr, (size_t) (length * 4));
+ free(ptr);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int fits_unshuffle_8bytes(char *heap, LONGLONG length, int *status)
+
+/* unshuffle the bytes in an array of 8-byte integers or doubles */
+
+{
+ LONGLONG ii;
+ char *ptr, *cptr, *heapptr;
+
+ ptr = malloc((size_t) (length * 8));
+ heapptr = heap + (8 * length) - 1;
+ cptr = ptr + (8 * length) -1;
+
+ for (ii = 0; ii < length; ii++) {
+ *cptr = *heapptr;
+ cptr--;
+ *cptr = *(heapptr - length);
+ cptr--;
+ *cptr = *(heapptr - (2 * length));
+ cptr--;
+ *cptr = *(heapptr - (3 * length));
+ cptr--;
+ *cptr = *(heapptr - (4 * length));
+ cptr--;
+ *cptr = *(heapptr - (5 * length));
+ cptr--;
+ *cptr = *(heapptr - (6 * length));
+ cptr--;
+ *cptr = *(heapptr - (7 * length));
+ cptr--;
+ heapptr--;
+ }
+
+ memcpy(heap, ptr, (size_t) (length * 8));
+ free(ptr);
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/infback.c b/src/plugins/cfitsio/infback.c
new file mode 100644
index 0000000..af3a8c9
--- /dev/null
+++ b/src/plugins/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;
+}
diff --git a/src/plugins/cfitsio/inffast.c b/src/plugins/cfitsio/inffast.c
new file mode 100644
index 0000000..2f1d60b
--- /dev/null
+++ b/src/plugins/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 */
diff --git a/src/plugins/cfitsio/inffast.h b/src/plugins/cfitsio/inffast.h
new file mode 100644
index 0000000..e5c1aa4
--- /dev/null
+++ b/src/plugins/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));
diff --git a/src/plugins/cfitsio/inffixed.h b/src/plugins/cfitsio/inffixed.h
new file mode 100644
index 0000000..75ed4b5
--- /dev/null
+++ b/src/plugins/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}
+ };
diff --git a/src/plugins/cfitsio/inflate.c b/src/plugins/cfitsio/inflate.c
new file mode 100644
index 0000000..a8431ab
--- /dev/null
+++ b/src/plugins/cfitsio/inflate.c
@@ -0,0 +1,1480 @@
+/* inflate.c -- zlib decompression
+ * Copyright (C) 1995-2010 Mark Adler
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/*
+ * Change history:
+ *
+ * 1.2.beta0 24 Nov 2002
+ * - First version -- complete rewrite of inflate to simplify code, avoid
+ * creation of window when not needed, minimize use of window when it is
+ * needed, make inffast.c even faster, implement gzip decoding, and to
+ * improve code readability and style over the previous zlib inflate code
+ *
+ * 1.2.beta1 25 Nov 2002
+ * - Use pointers for available input and output checking in inffast.c
+ * - Remove input and output counters in inffast.c
+ * - Change inffast.c entry and loop from avail_in >= 7 to >= 6
+ * - Remove unnecessary second byte pull from length extra in inffast.c
+ * - Unroll direct copy to three copies per loop in inffast.c
+ *
+ * 1.2.beta2 4 Dec 2002
+ * - Change external routine names to reduce potential conflicts
+ * - Correct filename to inffixed.h for fixed tables in inflate.c
+ * - Make hbuf[] unsigned char to match parameter type in inflate.c
+ * - Change strm->next_out[-state->offset] to *(strm->next_out - state->offset)
+ * to avoid negation problem on Alphas (64 bit) in inflate.c
+ *
+ * 1.2.beta3 22 Dec 2002
+ * - Add comments on state->bits assertion in inffast.c
+ * - Add comments on op field in inftrees.h
+ * - Fix bug in reuse of allocated window after inflateReset()
+ * - Remove bit fields--back to byte structure for speed
+ * - Remove distance extra == 0 check in inflate_fast()--only helps for lengths
+ * - Change post-increments to pre-increments in inflate_fast(), PPC biased?
+ * - Add compile time option, POSTINC, to use post-increments instead (Intel?)
+ * - Make MATCH copy in inflate() much faster for when inflate_fast() not used
+ * - Use local copies of stream next and avail values, as well as local bit
+ * buffer and bit count in inflate()--for speed when inflate_fast() not used
+ *
+ * 1.2.beta4 1 Jan 2003
+ * - Split ptr - 257 statements in inflate_table() to avoid compiler warnings
+ * - Move a comment on output buffer sizes from inffast.c to inflate.c
+ * - Add comments in inffast.c to introduce the inflate_fast() routine
+ * - Rearrange window copies in inflate_fast() for speed and simplification
+ * - Unroll last copy for window match in inflate_fast()
+ * - Use local copies of window variables in inflate_fast() for speed
+ * - Pull out common wnext == 0 case for speed in inflate_fast()
+ * - Make op and len in inflate_fast() unsigned for consistency
+ * - Add FAR to lcode and dcode declarations in inflate_fast()
+ * - Simplified bad distance check in inflate_fast()
+ * - Added inflateBackInit(), inflateBack(), and inflateBackEnd() in new
+ * source file infback.c to provide a call-back interface to inflate for
+ * programs like gzip and unzip -- uses window as output buffer to avoid
+ * window copying
+ *
+ * 1.2.beta5 1 Jan 2003
+ * - Improved inflateBack() interface to allow the caller to provide initial
+ * input in strm.
+ * - Fixed stored blocks bug in inflateBack()
+ *
+ * 1.2.beta6 4 Jan 2003
+ * - Added comments in inffast.c on effectiveness of POSTINC
+ * - Typecasting all around to reduce compiler warnings
+ * - Changed loops from while (1) or do {} while (1) to for (;;), again to
+ * make compilers happy
+ * - Changed type of window in inflateBackInit() to unsigned char *
+ *
+ * 1.2.beta7 27 Jan 2003
+ * - Changed many types to unsigned or unsigned short to avoid warnings
+ * - Added inflateCopy() function
+ *
+ * 1.2.0 9 Mar 2003
+ * - Changed inflateBack() interface to provide separate opaque descriptors
+ * for the in() and out() functions
+ * - Changed inflateBack() argument and in_func typedef to swap the length
+ * and buffer address return values for the input function
+ * - Check next_in and next_out for Z_NULL on entry to inflate()
+ *
+ * The history for versions after 1.2.0 are in ChangeLog in zlib distribution.
+ */
+
+#include "zutil.h"
+#include "inftrees.h"
+#include "inflate.h"
+#include "inffast.h"
+
+#ifdef MAKEFIXED
+# ifndef BUILDFIXED
+# define BUILDFIXED
+# endif
+#endif
+
+/* function prototypes */
+local void fixedtables OF((struct inflate_state FAR *state));
+local int updatewindow OF((z_streamp strm, unsigned out));
+#ifdef BUILDFIXED
+ void makefixed OF((void));
+#endif
+local unsigned syncsearch OF((unsigned FAR *have, unsigned char FAR *buf,
+ unsigned len));
+
+int ZEXPORT inflateReset(strm)
+z_streamp strm;
+{
+ struct inflate_state FAR *state;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ strm->total_in = strm->total_out = state->total = 0;
+ strm->msg = Z_NULL;
+ strm->adler = 1; /* to support ill-conceived Java test suite */
+ state->mode = HEAD;
+ state->last = 0;
+ state->havedict = 0;
+ state->dmax = 32768U;
+ state->head = Z_NULL;
+ state->wsize = 0;
+ state->whave = 0;
+ state->wnext = 0;
+ state->hold = 0;
+ state->bits = 0;
+ state->lencode = state->distcode = state->next = state->codes;
+ state->sane = 1;
+ state->back = -1;
+ Tracev((stderr, "inflate: reset\n"));
+ return Z_OK;
+}
+
+int ZEXPORT inflateReset2(strm, windowBits)
+z_streamp strm;
+int windowBits;
+{
+ int wrap;
+ struct inflate_state FAR *state;
+
+ /* get the state */
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+
+ /* extract wrap request from windowBits parameter */
+ if (windowBits < 0) {
+ wrap = 0;
+ windowBits = -windowBits;
+ }
+ else {
+ wrap = (windowBits >> 4) + 1;
+#ifdef GUNZIP
+ if (windowBits < 48)
+ windowBits &= 15;
+#endif
+ }
+
+ /* set number of window bits, free window if different */
+ if (windowBits && (windowBits < 8 || windowBits > 15))
+ return Z_STREAM_ERROR;
+ if (state->window != Z_NULL && state->wbits != (unsigned)windowBits) {
+ ZFREE(strm, state->window);
+ state->window = Z_NULL;
+ }
+
+ /* update state and reset the rest of it */
+ state->wrap = wrap;
+ state->wbits = (unsigned)windowBits;
+ return inflateReset(strm);
+}
+
+int ZEXPORT inflateInit2_(strm, windowBits, version, stream_size)
+z_streamp strm;
+int windowBits;
+const char *version;
+int stream_size;
+{
+ int ret;
+ 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) 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->window = Z_NULL;
+ ret = inflateReset2(strm, windowBits);
+ if (ret != Z_OK) {
+ ZFREE(strm, state);
+ strm->state = Z_NULL;
+ }
+ return ret;
+}
+
+int ZEXPORT inflateInit_(strm, version, stream_size)
+z_streamp strm;
+const char *version;
+int stream_size;
+{
+ return inflateInit2_(strm, DEF_WBITS, version, stream_size);
+}
+
+int ZEXPORT inflatePrime(strm, bits, value)
+z_streamp strm;
+int bits;
+int value;
+{
+ struct inflate_state FAR *state;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if (bits < 0) {
+ state->hold = 0;
+ state->bits = 0;
+ return Z_OK;
+ }
+ if (bits > 16 || state->bits + bits > 32) return Z_STREAM_ERROR;
+ value &= (1L << bits) - 1;
+ state->hold += value << state->bits;
+ state->bits += bits;
+ 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;
+}
+
+#ifdef MAKEFIXED
+#include <stdio.h>
+
+/*
+ Write out the inffixed.h that is #include'd above. Defining MAKEFIXED also
+ defines BUILDFIXED, so the tables are built on the fly. makefixed() writes
+ those tables to stdout, which would be piped to inffixed.h. A small program
+ can simply call makefixed to do this:
+
+ void makefixed(void);
+
+ int main(void)
+ {
+ makefixed();
+ return 0;
+ }
+
+ Then that can be linked with zlib built with MAKEFIXED defined and run:
+
+ a.out > inffixed.h
+ */
+void makefixed()
+{
+ unsigned low, size;
+ struct inflate_state state;
+
+ fixedtables(&state);
+ puts(" /* inffixed.h -- table for decoding fixed codes");
+ puts(" * Generated automatically by makefixed().");
+ puts(" */");
+ puts("");
+ puts(" /* WARNING: this file should *not* be used by applications.");
+ puts(" It is part of the implementation of this library and is");
+ puts(" subject to change. Applications should only use zlib.h.");
+ puts(" */");
+ puts("");
+ size = 1U << 9;
+ printf(" static const code lenfix[%u] = {", size);
+ low = 0;
+ for (;;) {
+ if ((low % 7) == 0) printf("\n ");
+ printf("{%u,%u,%d}", state.lencode[low].op, state.lencode[low].bits,
+ state.lencode[low].val);
+ if (++low == size) break;
+ putchar(',');
+ }
+ puts("\n };");
+ size = 1U << 5;
+ printf("\n static const code distfix[%u] = {", size);
+ low = 0;
+ for (;;) {
+ if ((low % 6) == 0) printf("\n ");
+ printf("{%u,%u,%d}", state.distcode[low].op, state.distcode[low].bits,
+ state.distcode[low].val);
+ if (++low == size) break;
+ putchar(',');
+ }
+ puts("\n };");
+}
+#endif /* MAKEFIXED */
+
+/*
+ Update the window with the last wsize (normally 32K) bytes written before
+ returning. If window does not exist yet, create it. This is only called
+ when a window is already in use, or when output has been written during this
+ inflate call, but the end of the deflate stream has not been reached yet.
+ It is also called to create a window for dictionary data when a dictionary
+ is loaded.
+
+ Providing output buffers larger than 32K to inflate() should provide a speed
+ advantage, since only the last 32K of output is copied to the sliding window
+ upon return from inflate(), and since all distances after the first 32K of
+ output will fall in the output data, making match copies simpler and faster.
+ The advantage may be dependent on the size of the processor's data caches.
+ */
+local int updatewindow(strm, out)
+z_streamp strm;
+unsigned out;
+{
+ struct inflate_state FAR *state;
+ unsigned copy, dist;
+
+ state = (struct inflate_state FAR *)strm->state;
+
+ /* if it hasn't been done already, allocate space for the window */
+ if (state->window == Z_NULL) {
+ state->window = (unsigned char FAR *)
+ ZALLOC(strm, 1U << state->wbits,
+ sizeof(unsigned char));
+ if (state->window == Z_NULL) return 1;
+ }
+
+ /* if window not in use yet, initialize */
+ if (state->wsize == 0) {
+ state->wsize = 1U << state->wbits;
+ state->wnext = 0;
+ state->whave = 0;
+ }
+
+ /* copy state->wsize or less output bytes into the circular window */
+ copy = out - strm->avail_out;
+ if (copy >= state->wsize) {
+ zmemcpy(state->window, strm->next_out - state->wsize, state->wsize);
+ state->wnext = 0;
+ state->whave = state->wsize;
+ }
+ else {
+ dist = state->wsize - state->wnext;
+ if (dist > copy) dist = copy;
+ zmemcpy(state->window + state->wnext, strm->next_out - copy, dist);
+ copy -= dist;
+ if (copy) {
+ zmemcpy(state->window, strm->next_out - copy, copy);
+ state->wnext = copy;
+ state->whave = state->wsize;
+ }
+ else {
+ state->wnext += dist;
+ if (state->wnext == state->wsize) state->wnext = 0;
+ if (state->whave < state->wsize) state->whave += dist;
+ }
+ }
+ return 0;
+}
+
+/* Macros for inflate(): */
+
+/* check function to use adler32() for zlib or crc32() for gzip */
+#ifdef GUNZIP
+# define UPDATE(check, buf, len) \
+ (state->flags ? crc32(check, buf, len) : adler32(check, buf, len))
+#else
+# define UPDATE(check, buf, len) adler32(check, buf, len)
+#endif
+
+/* check macros for header crc */
+#ifdef GUNZIP
+# define CRC2(check, word) \
+ do { \
+ hbuf[0] = (unsigned char)(word); \
+ hbuf[1] = (unsigned char)((word) >> 8); \
+ check = crc32(check, hbuf, 2); \
+ } while (0)
+
+# define CRC4(check, word) \
+ do { \
+ hbuf[0] = (unsigned char)(word); \
+ hbuf[1] = (unsigned char)((word) >> 8); \
+ hbuf[2] = (unsigned char)((word) >> 16); \
+ hbuf[3] = (unsigned char)((word) >> 24); \
+ check = crc32(check, hbuf, 4); \
+ } while (0)
+#endif
+
+/* Load registers with state in inflate() for speed */
+#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)
+
+/* Restore state from registers in inflate() */
+#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)
+
+/* Get a byte of input into the bit accumulator, or return from inflate()
+ if there is no input available. */
+#define PULLBYTE() \
+ do { \
+ if (have == 0) goto inf_leave; \
+ 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 inflate(). */
+#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)
+
+/* Reverse the bytes in a 32-bit value */
+#define REVERSE(q) \
+ ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \
+ (((q) & 0xff00) << 8) + (((q) & 0xff) << 24))
+
+/*
+ inflate() uses a state machine to process as much input data and generate as
+ much output data as possible before returning. The state machine is
+ structured roughly as follows:
+
+ for (;;) switch (state) {
+ ...
+ case STATEn:
+ if (not enough input data or output space to make progress)
+ return;
+ ... make progress ...
+ state = STATEm;
+ break;
+ ...
+ }
+
+ so when inflate() is called again, the same case is attempted again, and
+ if the appropriate resources are provided, the machine proceeds to the
+ next state. The NEEDBITS() macro is usually the way the state evaluates
+ whether it can proceed or should return. NEEDBITS() does the return if
+ the requested bits are not available. The typical use of the BITS macros
+ is:
+
+ NEEDBITS(n);
+ ... do something with BITS(n) ...
+ DROPBITS(n);
+
+ where NEEDBITS(n) either returns from inflate() if there isn't enough
+ input left to load n bits into the accumulator, or it continues. BITS(n)
+ gives the low n bits in the accumulator. When done, DROPBITS(n) drops
+ the low n bits off the accumulator. INITBITS() clears the accumulator
+ and sets the number of available bits to zero. BYTEBITS() discards just
+ enough bits to put the accumulator on a byte boundary. After BYTEBITS()
+ and a NEEDBITS(8), then BITS(8) would return the next byte in the stream.
+
+ NEEDBITS(n) uses PULLBYTE() to get an available byte of input, or to return
+ if there is no input available. The decoding of variable length codes uses
+ PULLBYTE() directly in order to pull just enough bytes to decode the next
+ code, and no more.
+
+ Some states loop until they get enough input, making sure that enough
+ state information is maintained to continue the loop where it left off
+ if NEEDBITS() returns in the loop. For example, want, need, and keep
+ would all have to actually be part of the saved state in case NEEDBITS()
+ returns:
+
+ case STATEw:
+ while (want < need) {
+ NEEDBITS(n);
+ keep[want++] = BITS(n);
+ DROPBITS(n);
+ }
+ state = STATEx;
+ case STATEx:
+
+ As shown above, if the next state is also the next case, then the break
+ is omitted.
+
+ A state may also return if there is not enough output space available to
+ complete that state. Those states are copying stored data, writing a
+ literal byte, and copying a matching string.
+
+ When returning, a "goto inf_leave" is used to update the total counters,
+ update the check value, and determine whether any progress has been made
+ during that inflate() call in order to return the proper return code.
+ Progress is defined as a change in either strm->avail_in or strm->avail_out.
+ When there is a window, goto inf_leave will update the window with the last
+ output written. If a goto inf_leave occurs in the middle of decompression
+ and there is no window currently, goto inf_leave will create one and copy
+ output to the window for the next call of inflate().
+
+ In this implementation, the flush parameter of inflate() only affects the
+ return code (per zlib.h). inflate() always writes as much as possible to
+ strm->next_out, given the space available and the provided input--the effect
+ documented in zlib.h of Z_SYNC_FLUSH. Furthermore, inflate() always defers
+ the allocation of and copying into a sliding window until necessary, which
+ provides the effect documented in zlib.h for Z_FINISH when the entire input
+ stream available. So the only thing the flush parameter actually does is:
+ when flush is set to Z_FINISH, inflate() cannot return Z_OK. Instead it
+ will return Z_BUF_ERROR if it has not reached the end of the stream.
+ */
+
+int ZEXPORT inflate(strm, flush)
+z_streamp strm;
+int flush;
+{
+ 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 in, out; /* save starting available input and output */
+ 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 */
+#ifdef GUNZIP
+ unsigned char hbuf[4]; /* buffer for gzip header crc calculation */
+#endif
+ 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};
+
+ if (strm == Z_NULL || strm->state == Z_NULL || strm->next_out == Z_NULL ||
+ (strm->next_in == Z_NULL && strm->avail_in != 0))
+ return Z_STREAM_ERROR;
+
+ state = (struct inflate_state FAR *)strm->state;
+ if (state->mode == TYPE) state->mode = TYPEDO; /* skip check */
+ LOAD();
+ in = have;
+ out = left;
+ ret = Z_OK;
+ for (;;)
+ switch (state->mode) {
+ case HEAD:
+ if (state->wrap == 0) {
+ state->mode = TYPEDO;
+ break;
+ }
+ NEEDBITS(16);
+#ifdef GUNZIP
+ if ((state->wrap & 2) && hold == 0x8b1f) { /* gzip header */
+ state->check = crc32(0L, Z_NULL, 0);
+ CRC2(state->check, hold);
+ INITBITS();
+ state->mode = FLAGS;
+ break;
+ }
+ state->flags = 0; /* expect zlib header */
+ if (state->head != Z_NULL)
+ state->head->done = -1;
+ if (!(state->wrap & 1) || /* check if zlib header allowed */
+#else
+ if (
+#endif
+ ((BITS(8) << 8) + (hold >> 8)) % 31) {
+ strm->msg = (char *)"incorrect header check";
+ state->mode = BAD;
+ break;
+ }
+ if (BITS(4) != Z_DEFLATED) {
+ strm->msg = (char *)"unknown compression method";
+ state->mode = BAD;
+ break;
+ }
+ DROPBITS(4);
+ len = BITS(4) + 8;
+ if (state->wbits == 0)
+ state->wbits = len;
+ else if (len > state->wbits) {
+ strm->msg = (char *)"invalid window size";
+ state->mode = BAD;
+ break;
+ }
+ state->dmax = 1U << len;
+ Tracev((stderr, "inflate: zlib header ok\n"));
+ strm->adler = state->check = adler32(0L, Z_NULL, 0);
+ state->mode = hold & 0x200 ? DICTID : TYPE;
+ INITBITS();
+ break;
+#ifdef GUNZIP
+ case FLAGS:
+ NEEDBITS(16);
+ state->flags = (int)(hold);
+ if ((state->flags & 0xff) != Z_DEFLATED) {
+ strm->msg = (char *)"unknown compression method";
+ state->mode = BAD;
+ break;
+ }
+ if (state->flags & 0xe000) {
+ strm->msg = (char *)"unknown header flags set";
+ state->mode = BAD;
+ break;
+ }
+ if (state->head != Z_NULL)
+ state->head->text = (int)((hold >> 8) & 1);
+ if (state->flags & 0x0200) CRC2(state->check, hold);
+ INITBITS();
+ state->mode = TIME;
+ case TIME:
+ NEEDBITS(32);
+ if (state->head != Z_NULL)
+ state->head->time = hold;
+ if (state->flags & 0x0200) CRC4(state->check, hold);
+ INITBITS();
+ state->mode = OS;
+ case OS:
+ NEEDBITS(16);
+ if (state->head != Z_NULL) {
+ state->head->xflags = (int)(hold & 0xff);
+ state->head->os = (int)(hold >> 8);
+ }
+ if (state->flags & 0x0200) CRC2(state->check, hold);
+ INITBITS();
+ state->mode = EXLEN;
+ case EXLEN:
+ if (state->flags & 0x0400) {
+ NEEDBITS(16);
+ state->length = (unsigned)(hold);
+ if (state->head != Z_NULL)
+ state->head->extra_len = (unsigned)hold;
+ if (state->flags & 0x0200) CRC2(state->check, hold);
+ INITBITS();
+ }
+ else if (state->head != Z_NULL)
+ state->head->extra = Z_NULL;
+ state->mode = EXTRA;
+ case EXTRA:
+ if (state->flags & 0x0400) {
+ copy = state->length;
+ if (copy > have) copy = have;
+ if (copy) {
+ if (state->head != Z_NULL &&
+ state->head->extra != Z_NULL) {
+ len = state->head->extra_len - state->length;
+ zmemcpy(state->head->extra + len, next,
+ len + copy > state->head->extra_max ?
+ state->head->extra_max - len : copy);
+ }
+ if (state->flags & 0x0200)
+ state->check = crc32(state->check, next, copy);
+ have -= copy;
+ next += copy;
+ state->length -= copy;
+ }
+ if (state->length) goto inf_leave;
+ }
+ state->length = 0;
+ state->mode = NAME;
+ case NAME:
+ if (state->flags & 0x0800) {
+ if (have == 0) goto inf_leave;
+ copy = 0;
+ do {
+ len = (unsigned)(next[copy++]);
+ if (state->head != Z_NULL &&
+ state->head->name != Z_NULL &&
+ state->length < state->head->name_max)
+ state->head->name[state->length++] = len;
+ } while (len && copy < have);
+ if (state->flags & 0x0200)
+ state->check = crc32(state->check, next, copy);
+ have -= copy;
+ next += copy;
+ if (len) goto inf_leave;
+ }
+ else if (state->head != Z_NULL)
+ state->head->name = Z_NULL;
+ state->length = 0;
+ state->mode = COMMENT;
+ case COMMENT:
+ if (state->flags & 0x1000) {
+ if (have == 0) goto inf_leave;
+ copy = 0;
+ do {
+ len = (unsigned)(next[copy++]);
+ if (state->head != Z_NULL &&
+ state->head->comment != Z_NULL &&
+ state->length < state->head->comm_max)
+ state->head->comment[state->length++] = len;
+ } while (len && copy < have);
+ if (state->flags & 0x0200)
+ state->check = crc32(state->check, next, copy);
+ have -= copy;
+ next += copy;
+ if (len) goto inf_leave;
+ }
+ else if (state->head != Z_NULL)
+ state->head->comment = Z_NULL;
+ state->mode = HCRC;
+ case HCRC:
+ if (state->flags & 0x0200) {
+ NEEDBITS(16);
+ if (hold != (state->check & 0xffff)) {
+ strm->msg = (char *)"header crc mismatch";
+ state->mode = BAD;
+ break;
+ }
+ INITBITS();
+ }
+ if (state->head != Z_NULL) {
+ state->head->hcrc = (int)((state->flags >> 9) & 1);
+ state->head->done = 1;
+ }
+ strm->adler = state->check = crc32(0L, Z_NULL, 0);
+ state->mode = TYPE;
+ break;
+#endif
+ case DICTID:
+ NEEDBITS(32);
+ strm->adler = state->check = REVERSE(hold);
+ INITBITS();
+ state->mode = DICT;
+ case DICT:
+ if (state->havedict == 0) {
+ RESTORE();
+ return Z_NEED_DICT;
+ }
+ strm->adler = state->check = adler32(0L, Z_NULL, 0);
+ state->mode = TYPE;
+ case TYPE:
+ if (flush == Z_BLOCK || flush == Z_TREES) goto inf_leave;
+ case TYPEDO:
+ if (state->last) {
+ BYTEBITS();
+ state->mode = CHECK;
+ 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 */
+ if (flush == Z_TREES) {
+ DROPBITS(2);
+ goto inf_leave;
+ }
+ 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:
+ 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();
+ state->mode = COPY_;
+ if (flush == Z_TREES) goto inf_leave;
+ case COPY_:
+ state->mode = COPY;
+ case COPY:
+ copy = state->length;
+ if (copy) {
+ if (copy > have) copy = have;
+ if (copy > left) copy = left;
+ if (copy == 0) goto inf_leave;
+ zmemcpy(put, next, copy);
+ have -= copy;
+ next += copy;
+ left -= copy;
+ put += copy;
+ state->length -= copy;
+ break;
+ }
+ Tracev((stderr, "inflate: stored end\n"));
+ state->mode = TYPE;
+ break;
+ case TABLE:
+ 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"));
+ state->have = 0;
+ state->mode = LENLENS;
+ case LENLENS:
+ 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"));
+ state->have = 0;
+ state->mode = CODELENS;
+ case CODELENS:
+ 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 = 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_;
+ if (flush == Z_TREES) goto inf_leave;
+ case LEN_:
+ state->mode = LEN;
+ case LEN:
+ if (have >= 6 && left >= 258) {
+ RESTORE();
+ inflate_fast(strm, out);
+ LOAD();
+ if (state->mode == TYPE)
+ state->back = -1;
+ break;
+ }
+ state->back = 0;
+ 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);
+ state->back += last.bits;
+ }
+ DROPBITS(here.bits);
+ state->back += here.bits;
+ state->length = (unsigned)here.val;
+ if ((int)(here.op) == 0) {
+ Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
+ "inflate: literal '%c'\n" :
+ "inflate: literal 0x%02x\n", here.val));
+ state->mode = LIT;
+ break;
+ }
+ if (here.op & 32) {
+ Tracevv((stderr, "inflate: end of block\n"));
+ state->back = -1;
+ state->mode = TYPE;
+ break;
+ }
+ if (here.op & 64) {
+ strm->msg = (char *)"invalid literal/length code";
+ state->mode = BAD;
+ break;
+ }
+ state->extra = (unsigned)(here.op) & 15;
+ state->mode = LENEXT;
+ case LENEXT:
+ if (state->extra) {
+ NEEDBITS(state->extra);
+ state->length += BITS(state->extra);
+ DROPBITS(state->extra);
+ state->back += state->extra;
+ }
+ Tracevv((stderr, "inflate: length %u\n", state->length));
+ state->was = state->length;
+ state->mode = DIST;
+ case DIST:
+ 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);
+ state->back += last.bits;
+ }
+ DROPBITS(here.bits);
+ state->back += here.bits;
+ if (here.op & 64) {
+ strm->msg = (char *)"invalid distance code";
+ state->mode = BAD;
+ break;
+ }
+ state->offset = (unsigned)here.val;
+ state->extra = (unsigned)(here.op) & 15;
+ state->mode = DISTEXT;
+ case DISTEXT:
+ if (state->extra) {
+ NEEDBITS(state->extra);
+ state->offset += BITS(state->extra);
+ DROPBITS(state->extra);
+ state->back += state->extra;
+ }
+#ifdef INFLATE_STRICT
+ if (state->offset > state->dmax) {
+ strm->msg = (char *)"invalid distance too far back";
+ state->mode = BAD;
+ break;
+ }
+#endif
+ Tracevv((stderr, "inflate: distance %u\n", state->offset));
+ state->mode = MATCH;
+ case MATCH:
+ if (left == 0) goto inf_leave;
+ copy = out - left;
+ if (state->offset > copy) { /* copy from window */
+ copy = state->offset - copy;
+ if (copy > state->whave) {
+ if (state->sane) {
+ strm->msg = (char *)"invalid distance too far back";
+ state->mode = BAD;
+ break;
+ }
+#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
+ Trace((stderr, "inflate.c too far\n"));
+ copy -= state->whave;
+ if (copy > state->length) copy = state->length;
+ if (copy > left) copy = left;
+ left -= copy;
+ state->length -= copy;
+ do {
+ *put++ = 0;
+ } while (--copy);
+ if (state->length == 0) state->mode = LEN;
+ break;
+#endif
+ }
+ if (copy > state->wnext) {
+ copy -= state->wnext;
+ from = state->window + (state->wsize - copy);
+ }
+ else
+ from = state->window + (state->wnext - copy);
+ if (copy > state->length) copy = state->length;
+ }
+ else { /* copy from output */
+ from = put - state->offset;
+ copy = state->length;
+ }
+ if (copy > left) copy = left;
+ left -= copy;
+ state->length -= copy;
+ do {
+ *put++ = *from++;
+ } while (--copy);
+ if (state->length == 0) state->mode = LEN;
+ break;
+ case LIT:
+ if (left == 0) goto inf_leave;
+ *put++ = (unsigned char)(state->length);
+ left--;
+ state->mode = LEN;
+ break;
+ case CHECK:
+ if (state->wrap) {
+ NEEDBITS(32);
+ out -= left;
+ strm->total_out += out;
+ state->total += out;
+ if (out)
+ strm->adler = state->check =
+ UPDATE(state->check, put - out, out);
+ out = left;
+ if ((
+#ifdef GUNZIP
+ state->flags ? hold :
+#endif
+ REVERSE(hold)) != state->check) {
+ strm->msg = (char *)"incorrect data check";
+ state->mode = BAD;
+ break;
+ }
+ INITBITS();
+ Tracev((stderr, "inflate: check matches trailer\n"));
+ }
+#ifdef GUNZIP
+ state->mode = LENGTH;
+ case LENGTH:
+ if (state->wrap && state->flags) {
+ NEEDBITS(32);
+ if (hold != (state->total & 0xffffffffUL)) {
+ strm->msg = (char *)"incorrect length check";
+ state->mode = BAD;
+ break;
+ }
+ INITBITS();
+ Tracev((stderr, "inflate: length matches trailer\n"));
+ }
+#endif
+ state->mode = DONE;
+ case DONE:
+ ret = Z_STREAM_END;
+ goto inf_leave;
+ case BAD:
+ ret = Z_DATA_ERROR;
+ goto inf_leave;
+ case MEM:
+ return Z_MEM_ERROR;
+ case SYNC:
+ default:
+ return Z_STREAM_ERROR;
+ }
+
+ /*
+ Return from inflate(), updating the total counts and the check value.
+ If there was no progress during the inflate() call, return a buffer
+ error. Call updatewindow() to create and/or update the window state.
+ Note: a memory error from inflate() is non-recoverable.
+ */
+ inf_leave:
+ RESTORE();
+ if (state->wsize || (state->mode < CHECK && out != strm->avail_out))
+ if (updatewindow(strm, out)) {
+ state->mode = MEM;
+ return Z_MEM_ERROR;
+ }
+ in -= strm->avail_in;
+ out -= strm->avail_out;
+ strm->total_in += in;
+ strm->total_out += out;
+ state->total += out;
+ if (state->wrap && out)
+ strm->adler = state->check =
+ UPDATE(state->check, strm->next_out - out, out);
+ strm->data_type = state->bits + (state->last ? 64 : 0) +
+ (state->mode == TYPE ? 128 : 0) +
+ (state->mode == LEN_ || state->mode == COPY_ ? 256 : 0);
+ if (((in == 0 && out == 0) || flush == Z_FINISH) && ret == Z_OK)
+ ret = Z_BUF_ERROR;
+ return ret;
+}
+
+int ZEXPORT inflateEnd(strm)
+z_streamp strm;
+{
+ struct inflate_state FAR *state;
+ if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0)
+ return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if (state->window != Z_NULL) ZFREE(strm, state->window);
+ ZFREE(strm, strm->state);
+ strm->state = Z_NULL;
+ Tracev((stderr, "inflate: end\n"));
+ return Z_OK;
+}
+
+int ZEXPORT inflateSetDictionary(strm, dictionary, dictLength)
+z_streamp strm;
+const Bytef *dictionary;
+uInt dictLength;
+{
+ struct inflate_state FAR *state;
+ unsigned long id;
+
+ /* check state */
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if (state->wrap != 0 && state->mode != DICT)
+ return Z_STREAM_ERROR;
+
+ /* check for correct dictionary id */
+ if (state->mode == DICT) {
+ id = adler32(0L, Z_NULL, 0);
+ id = adler32(id, dictionary, dictLength);
+ if (id != state->check)
+ return Z_DATA_ERROR;
+ }
+
+ /* copy dictionary to window */
+ if (updatewindow(strm, strm->avail_out)) {
+ state->mode = MEM;
+ return Z_MEM_ERROR;
+ }
+ if (dictLength > state->wsize) {
+ zmemcpy(state->window, dictionary + dictLength - state->wsize,
+ state->wsize);
+ state->whave = state->wsize;
+ }
+ else {
+ zmemcpy(state->window + state->wsize - dictLength, dictionary,
+ dictLength);
+ state->whave = dictLength;
+ }
+ state->havedict = 1;
+ Tracev((stderr, "inflate: dictionary set\n"));
+ return Z_OK;
+}
+
+int ZEXPORT inflateGetHeader(strm, head)
+z_streamp strm;
+gz_headerp head;
+{
+ struct inflate_state FAR *state;
+
+ /* check state */
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if ((state->wrap & 2) == 0) return Z_STREAM_ERROR;
+
+ /* save header structure */
+ state->head = head;
+ head->done = 0;
+ return Z_OK;
+}
+
+/*
+ Search buf[0..len-1] for the pattern: 0, 0, 0xff, 0xff. Return when found
+ or when out of input. When called, *have is the number of pattern bytes
+ found in order so far, in 0..3. On return *have is updated to the new
+ state. If on return *have equals four, then the pattern was found and the
+ return value is how many bytes were read including the last byte of the
+ pattern. If *have is less than four, then the pattern has not been found
+ yet and the return value is len. In the latter case, syncsearch() can be
+ called again with more data and the *have state. *have is initialized to
+ zero for the first call.
+ */
+local unsigned syncsearch(have, buf, len)
+unsigned FAR *have;
+unsigned char FAR *buf;
+unsigned len;
+{
+ unsigned got;
+ unsigned next;
+
+ got = *have;
+ next = 0;
+ while (next < len && got < 4) {
+ if ((int)(buf[next]) == (got < 2 ? 0 : 0xff))
+ got++;
+ else if (buf[next])
+ got = 0;
+ else
+ got = 4 - got;
+ next++;
+ }
+ *have = got;
+ return next;
+}
+
+int ZEXPORT inflateSync(strm)
+z_streamp strm;
+{
+ unsigned len; /* number of bytes to look at or looked at */
+ unsigned long in, out; /* temporary to save total_in and total_out */
+ unsigned char buf[4]; /* to restore bit buffer to byte string */
+ struct inflate_state FAR *state;
+
+ /* check parameters */
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ if (strm->avail_in == 0 && state->bits < 8) return Z_BUF_ERROR;
+
+ /* if first time, start search in bit buffer */
+ if (state->mode != SYNC) {
+ state->mode = SYNC;
+ state->hold <<= state->bits & 7;
+ state->bits -= state->bits & 7;
+ len = 0;
+ while (state->bits >= 8) {
+ buf[len++] = (unsigned char)(state->hold);
+ state->hold >>= 8;
+ state->bits -= 8;
+ }
+ state->have = 0;
+ syncsearch(&(state->have), buf, len);
+ }
+
+ /* search available input */
+ len = syncsearch(&(state->have), strm->next_in, strm->avail_in);
+ strm->avail_in -= len;
+ strm->next_in += len;
+ strm->total_in += len;
+
+ /* return no joy or set up to restart inflate() on a new block */
+ if (state->have != 4) return Z_DATA_ERROR;
+ in = strm->total_in; out = strm->total_out;
+ inflateReset(strm);
+ strm->total_in = in; strm->total_out = out;
+ state->mode = TYPE;
+ return Z_OK;
+}
+
+/*
+ Returns true if inflate is currently at the end of a block generated by
+ Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP
+ implementation to provide an additional safety check. PPP uses
+ Z_SYNC_FLUSH but removes the length bytes of the resulting empty stored
+ block. When decompressing, PPP checks that at the end of input packet,
+ inflate is waiting for these length bytes.
+ */
+int ZEXPORT inflateSyncPoint(strm)
+z_streamp strm;
+{
+ struct inflate_state FAR *state;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ return state->mode == STORED && state->bits == 0;
+}
+
+int ZEXPORT inflateCopy(dest, source)
+z_streamp dest;
+z_streamp source;
+{
+ struct inflate_state FAR *state;
+ struct inflate_state FAR *copy;
+ unsigned char FAR *window;
+ unsigned wsize;
+
+ /* check input */
+ if (dest == Z_NULL || source == Z_NULL || source->state == Z_NULL ||
+ source->zalloc == (alloc_func)0 || source->zfree == (free_func)0)
+ return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)source->state;
+
+ /* allocate space */
+ copy = (struct inflate_state FAR *)
+ ZALLOC(source, 1, sizeof(struct inflate_state));
+ if (copy == Z_NULL) return Z_MEM_ERROR;
+ window = Z_NULL;
+ if (state->window != Z_NULL) {
+ window = (unsigned char FAR *)
+ ZALLOC(source, 1U << state->wbits, sizeof(unsigned char));
+ if (window == Z_NULL) {
+ ZFREE(source, copy);
+ return Z_MEM_ERROR;
+ }
+ }
+
+ /* copy state */
+ zmemcpy(dest, source, sizeof(z_stream));
+ zmemcpy(copy, state, sizeof(struct inflate_state));
+ if (state->lencode >= state->codes &&
+ state->lencode <= state->codes + ENOUGH - 1) {
+ copy->lencode = copy->codes + (state->lencode - state->codes);
+ copy->distcode = copy->codes + (state->distcode - state->codes);
+ }
+ copy->next = copy->codes + (state->next - state->codes);
+ if (window != Z_NULL) {
+ wsize = 1U << state->wbits;
+ zmemcpy(window, state->window, wsize);
+ }
+ copy->window = window;
+ dest->state = (struct internal_state FAR *)copy;
+ return Z_OK;
+}
+
+int ZEXPORT inflateUndermine(strm, subvert)
+z_streamp strm;
+int subvert;
+{
+ struct inflate_state FAR *state;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR;
+ state = (struct inflate_state FAR *)strm->state;
+ state->sane = !subvert;
+#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
+ return Z_OK;
+#else
+ state->sane = 1;
+ return Z_DATA_ERROR;
+#endif
+}
+
+long ZEXPORT inflateMark(strm)
+z_streamp strm;
+{
+ struct inflate_state FAR *state;
+
+ if (strm == Z_NULL || strm->state == Z_NULL) return -1L << 16;
+ state = (struct inflate_state FAR *)strm->state;
+ return ((long)(state->back) << 16) +
+ (state->mode == COPY ? state->length :
+ (state->mode == MATCH ? state->was - state->length : 0));
+}
diff --git a/src/plugins/cfitsio/inflate.h b/src/plugins/cfitsio/inflate.h
new file mode 100644
index 0000000..95f4986
--- /dev/null
+++ b/src/plugins/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 */
+};
diff --git a/src/plugins/cfitsio/inftrees.c b/src/plugins/cfitsio/inftrees.c
new file mode 100644
index 0000000..11e9c52
--- /dev/null
+++ b/src/plugins/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;
+}
diff --git a/src/plugins/cfitsio/inftrees.h b/src/plugins/cfitsio/inftrees.h
new file mode 100644
index 0000000..baa53a0
--- /dev/null
+++ b/src/plugins/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));
diff --git a/src/plugins/cfitsio/iraffits.c b/src/plugins/cfitsio/iraffits.c
new file mode 100644
index 0000000..d8fc06b
--- /dev/null
+++ b/src/plugins/cfitsio/iraffits.c
@@ -0,0 +1,2073 @@
+/*------------------------------------------------------------------------*/
+/* */
+/* These routines have been modified by William Pence for use by CFITSIO */
+/* The original files were provided by Doug Mink */
+/*------------------------------------------------------------------------*/
+
+/* File imhfile.c
+ * August 6, 1998
+ * By Doug Mink, based on Mike VanHilst's readiraf.c
+
+ * Module: imhfile.c (IRAF .imh image file reading and writing)
+ * Purpose: Read and write IRAF image files (and translate headers)
+ * Subroutine: irafrhead (filename, lfhead, fitsheader, lihead)
+ * Read IRAF image header
+ * Subroutine: irafrimage (fitsheader)
+ * Read IRAF image pixels (call after irafrhead)
+ * Subroutine: same_path (pixname, hdrname)
+ * Put filename and header path together
+ * Subroutine: iraf2fits (hdrname, irafheader, nbiraf, nbfits)
+ * Convert IRAF image header to FITS image header
+ * Subroutine: irafgeti4 (irafheader, offset)
+ * Get 4-byte integer from arbitrary part of IRAF header
+ * Subroutine: irafgetc2 (irafheader, offset)
+ * Get character string from arbitrary part of IRAF v.1 header
+ * Subroutine: irafgetc (irafheader, offset)
+ * Get character string from arbitrary part of IRAF header
+ * Subroutine: iraf2str (irafstring, nchar)
+ * Convert 2-byte/char IRAF string to 1-byte/char string
+ * Subroutine: irafswap (bitpix,string,nbytes)
+ * Swap bytes in string in place, with FITS bits/pixel code
+ * Subroutine: irafswap2 (string,nbytes)
+ * Swap bytes in string in place
+ * Subroutine irafswap4 (string,nbytes)
+ * Reverse bytes of Integer*4 or Real*4 vector in place
+ * Subroutine irafswap8 (string,nbytes)
+ * Reverse bytes of Real*8 vector in place
+
+
+ * Copyright: 2000 Smithsonian Astrophysical Observatory
+ * You may do anything you like with this file except remove
+ * this copyright. The Smithsonian Astrophysical Observatory
+ * makes no representations about the suitability of this
+ * software for any purpose. It is provided "as is" without
+ * express or implied warranty.
+ */
+
+#include <stdio.h> /* define stderr, FD, and NULL */
+#include <stdlib.h>
+#include <stddef.h> /* stddef.h is apparently needed to define size_t */
+#include <string.h>
+
+#define FILE_NOT_OPENED 104
+
+/* Parameters from iraf/lib/imhdr.h for IRAF version 1 images */
+#define SZ_IMPIXFILE 79 /* name of pixel storage file */
+#define SZ_IMHDRFILE 79 /* length of header storage file */
+#define SZ_IMTITLE 79 /* image title string */
+#define LEN_IMHDR 2052 /* length of std header */
+
+/* Parameters from iraf/lib/imhdr.h for IRAF version 2 images */
+#define SZ_IM2PIXFILE 255 /* name of pixel storage file */
+#define SZ_IM2HDRFILE 255 /* name of header storage file */
+#define SZ_IM2TITLE 383 /* image title string */
+#define LEN_IM2HDR 2046 /* length of std header */
+
+/* Offsets into header in bytes for parameters in IRAF version 1 images */
+#define IM_HDRLEN 12 /* Length of header in 4-byte ints */
+#define IM_PIXTYPE 16 /* Datatype of the pixels */
+#define IM_NDIM 20 /* Number of dimensions */
+#define IM_LEN 24 /* Length (as stored) */
+#define IM_PHYSLEN 52 /* Physical length (as stored) */
+#define IM_PIXOFF 88 /* Offset of the pixels */
+#define IM_CTIME 108 /* Time of image creation */
+#define IM_MTIME 112 /* Time of last modification */
+#define IM_LIMTIME 116 /* Time of min,max computation */
+#define IM_MAX 120 /* Maximum pixel value */
+#define IM_MIN 124 /* Maximum pixel value */
+#define IM_PIXFILE 412 /* Name of pixel storage file */
+#define IM_HDRFILE 572 /* Name of header storage file */
+#define IM_TITLE 732 /* Image name string */
+
+/* Offsets into header in bytes for parameters in IRAF version 2 images */
+#define IM2_HDRLEN 6 /* Length of header in 4-byte ints */
+#define IM2_PIXTYPE 10 /* Datatype of the pixels */
+#define IM2_SWAPPED 14 /* Pixels are byte swapped */
+#define IM2_NDIM 18 /* Number of dimensions */
+#define IM2_LEN 22 /* Length (as stored) */
+#define IM2_PHYSLEN 50 /* Physical length (as stored) */
+#define IM2_PIXOFF 86 /* Offset of the pixels */
+#define IM2_CTIME 106 /* Time of image creation */
+#define IM2_MTIME 110 /* Time of last modification */
+#define IM2_LIMTIME 114 /* Time of min,max computation */
+#define IM2_MAX 118 /* Maximum pixel value */
+#define IM2_MIN 122 /* Maximum pixel value */
+#define IM2_PIXFILE 126 /* Name of pixel storage file */
+#define IM2_HDRFILE 382 /* Name of header storage file */
+#define IM2_TITLE 638 /* Image name string */
+
+/* Codes from iraf/unix/hlib/iraf.h */
+#define TY_CHAR 2
+#define TY_SHORT 3
+#define TY_INT 4
+#define TY_LONG 5
+#define TY_REAL 6
+#define TY_DOUBLE 7
+#define TY_COMPLEX 8
+#define TY_POINTER 9
+#define TY_STRUCT 10
+#define TY_USHORT 11
+#define TY_UBYTE 12
+
+#define LEN_PIXHDR 1024
+#define MAXINT 2147483647 /* Biggest number that can fit in long */
+
+static int isirafswapped(char *irafheader, int offset);
+static int irafgeti4(char *irafheader, int offset);
+static char *irafgetc2(char *irafheader, int offset, int nc);
+static char *irafgetc(char *irafheader, int offset, int nc);
+static char *iraf2str(char *irafstring, int nchar);
+static char *irafrdhead(char *filename, int *lihead);
+static int irafrdimage (char **buffptr, size_t *buffsize,
+ size_t *filesize, int *status);
+static int iraftofits (char *hdrname, char *irafheader, int nbiraf,
+ char **buffptr, size_t *nbfits, size_t *fitssize, int *status);
+static char *same_path(char *pixname, char *hdrname);
+
+static int swaphead=0; /* =1 to swap data bytes of IRAF header values */
+static int swapdata=0; /* =1 to swap bytes in IRAF data pixels */
+
+static void irafswap(int bitpix, char *string, int nbytes);
+static void irafswap2(char *string, int nbytes);
+static void irafswap4(char *string, int nbytes);
+static void irafswap8(char *string, int nbytes);
+static int pix_version (char *irafheader);
+static int irafncmp (char *irafheader, char *teststring, int nc);
+static int machswap(void);
+static int head_version (char *irafheader);
+static int hgeti4(char* hstring, char* keyword, int* val);
+static int hgets(char* hstring, char* keyword, int lstr, char* string);
+static char* hgetc(char* hstring, char* keyword);
+static char* ksearch(char* hstring, char* keyword);
+static char *blsearch (char* hstring, char* keyword);
+static char *strsrch (char* s1, char* s2);
+static char *strnsrch ( char* s1,char* s2,int ls1);
+static void hputi4(char* hstring,char* keyword, int ival);
+static void hputs(char* hstring,char* keyword,char* cval);
+static void hputcom(char* hstring,char* keyword,char* comment);
+static void hputl(char* hstring,char* keyword,int lval);
+static void hputc(char* hstring,char* keyword,char* cval);
+static int getirafpixname (char *hdrname, char *irafheader, char *pixfilename, int *status);
+int iraf2mem(char *filename, char **buffptr, size_t *buffsize,
+ size_t *filesize, int *status);
+
+void ffpmsg(const char *err_message);
+
+/*--------------------------------------------------------------------------*/
+int fits_delete_iraf_file(char *filename, /* name of input file */
+ int *status) /* IO - error status */
+
+/*
+ Delete the iraf .imh header file and the associated .pix data file
+*/
+{
+ char *irafheader;
+ int lenirafhead;
+
+ char pixfilename[SZ_IM2PIXFILE+1];
+
+ /* read IRAF header into dynamically created char array (free it later!) */
+ irafheader = irafrdhead(filename, &lenirafhead);
+
+ if (!irafheader)
+ {
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ getirafpixname (filename, irafheader, pixfilename, status);
+
+ /* don't need the IRAF header any more */
+ free(irafheader);
+
+ if (*status > 0)
+ return(*status);
+
+ remove(filename);
+ remove(pixfilename);
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int iraf2mem(char *filename, /* name of input file */
+ char **buffptr, /* O - memory pointer (initially NULL) */
+ size_t *buffsize, /* O - size of mem buffer, in bytes */
+ size_t *filesize, /* O - size of FITS file, in bytes */
+ int *status) /* IO - error status */
+
+/*
+ Driver routine that reads an IRAF image into memory, also converting
+ it into FITS format.
+*/
+{
+ char *irafheader;
+ int lenirafhead;
+
+ *buffptr = NULL;
+ *buffsize = 0;
+ *filesize = 0;
+
+ /* read IRAF header into dynamically created char array (free it later!) */
+ irafheader = irafrdhead(filename, &lenirafhead);
+
+ if (!irafheader)
+ {
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ /* convert IRAF header to FITS header in memory */
+ iraftofits(filename, irafheader, lenirafhead, buffptr, buffsize, filesize,
+ status);
+
+ /* don't need the IRAF header any more */
+ free(irafheader);
+
+ if (*status > 0)
+ return(*status);
+
+ *filesize = (((*filesize - 1) / 2880 ) + 1 ) * 2880; /* multiple of 2880 */
+
+ /* append the image data onto the FITS header */
+ irafrdimage(buffptr, buffsize, filesize, status);
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+/* Subroutine: irafrdhead (was irafrhead in D. Mink's original code)
+ * Purpose: Open and read the iraf .imh file.
+ * Returns: NULL if failure, else pointer to IRAF .imh image header
+ * Notes: The imhdr format is defined in iraf/lib/imhdr.h, some of
+ * which defines or mimicked, above.
+ */
+
+static char *irafrdhead (
+ char *filename, /* Name of IRAF header file */
+ int *lihead) /* Length of IRAF image header in bytes (returned) */
+{
+ FILE *fd;
+ int nbr;
+ char *irafheader;
+ char errmsg[81];
+ long nbhead;
+ int nihead;
+
+ *lihead = 0;
+
+ /* open the image header file */
+ fd = fopen (filename, "rb");
+ if (fd == NULL) {
+ ffpmsg("unable to open IRAF header file:");
+ ffpmsg(filename);
+ return (NULL);
+ }
+
+ /* Find size of image header file */
+ if (fseek(fd, 0, 2) != 0) /* move to end of the file */
+ {
+ ffpmsg("IRAFRHEAD: cannot seek in file:");
+ ffpmsg(filename);
+ return(NULL);
+ }
+
+ nbhead = ftell(fd); /* position = size of file */
+ if (nbhead < 0)
+ {
+ ffpmsg("IRAFRHEAD: cannot get pos. in file:");
+ ffpmsg(filename);
+ return(NULL);
+ }
+
+ if (fseek(fd, 0, 0) != 0) /* move back to beginning */
+ {
+ ffpmsg("IRAFRHEAD: cannot seek to beginning of file:");
+ ffpmsg(filename);
+ return(NULL);
+ }
+
+ /* allocate initial sized buffer */
+ nihead = nbhead + 5000;
+ irafheader = (char *) calloc (1, nihead);
+ if (irafheader == NULL) {
+ sprintf(errmsg, "IRAFRHEAD Cannot allocate %d-byte header",
+ nihead);
+ ffpmsg(errmsg);
+ ffpmsg(filename);
+ return (NULL);
+ }
+ *lihead = nihead;
+
+ /* Read IRAF header */
+ nbr = fread (irafheader, 1, nbhead, fd);
+ fclose (fd);
+
+ /* Reject if header less than minimum length */
+ if (nbr < LEN_PIXHDR) {
+ sprintf(errmsg, "IRAFRHEAD header file: %d / %d bytes read.",
+ nbr,LEN_PIXHDR);
+ ffpmsg(errmsg);
+ ffpmsg(filename);
+ free (irafheader);
+ return (NULL);
+ }
+
+ return (irafheader);
+}
+/*--------------------------------------------------------------------------*/
+static int irafrdimage (
+ char **buffptr, /* FITS image header (filled) */
+ size_t *buffsize, /* allocated size of the buffer */
+ size_t *filesize, /* actual size of the FITS file */
+ int *status)
+{
+ FILE *fd;
+ char *bang;
+ int nax = 1, naxis1 = 1, naxis2 = 1, naxis3 = 1, naxis4 = 1, npaxis1 = 1, npaxis2;
+ int bitpix, bytepix, i;
+ char *fitsheader, *image;
+ int nbr, nbimage, nbaxis, nbl, nbdiff;
+ char *pixheader;
+ char *linebuff;
+ int imhver, lpixhead = 0;
+ char pixname[SZ_IM2PIXFILE+1];
+ char errmsg[81];
+ size_t newfilesize;
+
+ fitsheader = *buffptr; /* pointer to start of header */
+
+ /* Convert pixel file name to character string */
+ hgets (fitsheader, "PIXFILE", SZ_IM2PIXFILE, pixname);
+ hgeti4 (fitsheader, "PIXOFF", &lpixhead);
+
+ /* Open pixel file, ignoring machine name if present */
+ if ((bang = strchr (pixname, '!')) != NULL )
+ fd = fopen (bang + 1, "rb");
+ else
+ fd = fopen (pixname, "rb");
+
+ /* Print error message and exit if pixel file is not found */
+ if (!fd) {
+ ffpmsg("IRAFRIMAGE: Cannot open IRAF pixel file:");
+ ffpmsg(pixname);
+ return (*status = FILE_NOT_OPENED);
+ }
+
+ /* Read pixel header */
+ pixheader = (char *) calloc (lpixhead, 1);
+ if (pixheader == NULL) {
+ ffpmsg("IRAFRIMAGE: Cannot alloc memory for pixel header");
+ ffpmsg(pixname);
+ fclose (fd);
+ return (*status = FILE_NOT_OPENED);
+ }
+ nbr = fread (pixheader, 1, lpixhead, fd);
+
+ /* Check size of pixel header */
+ if (nbr < lpixhead) {
+ sprintf(errmsg, "IRAF pixel file: %d / %d bytes read.",
+ nbr,LEN_PIXHDR);
+ ffpmsg(errmsg);
+ free (pixheader);
+ fclose (fd);
+ return (*status = FILE_NOT_OPENED);
+ }
+
+ /* check pixel header magic word */
+ imhver = pix_version (pixheader);
+ if (imhver < 1) {
+ ffpmsg("File not valid IRAF pixel file:");
+ ffpmsg(pixname);
+ free (pixheader);
+ fclose (fd);
+ return (*status = FILE_NOT_OPENED);
+ }
+ free (pixheader);
+
+ /* Find number of bytes to read */
+ hgeti4 (fitsheader,"NAXIS",&nax);
+ hgeti4 (fitsheader,"NAXIS1",&naxis1);
+ hgeti4 (fitsheader,"NPAXIS1",&npaxis1);
+ if (nax > 1) {
+ hgeti4 (fitsheader,"NAXIS2",&naxis2);
+ hgeti4 (fitsheader,"NPAXIS2",&npaxis2);
+ }
+ if (nax > 2)
+ hgeti4 (fitsheader,"NAXIS3",&naxis3);
+ if (nax > 3)
+ hgeti4 (fitsheader,"NAXIS4",&naxis4);
+
+ hgeti4 (fitsheader,"BITPIX",&bitpix);
+ if (bitpix < 0)
+ bytepix = -bitpix / 8;
+ else
+ bytepix = bitpix / 8;
+
+ nbimage = naxis1 * naxis2 * naxis3 * naxis4 * bytepix;
+
+ newfilesize = *filesize + nbimage; /* header + data */
+ newfilesize = (((newfilesize - 1) / 2880 ) + 1 ) * 2880;
+
+ if (newfilesize > *buffsize) /* need to allocate more memory? */
+ {
+ fitsheader = (char *) realloc (*buffptr, newfilesize);
+ if (fitsheader == NULL) {
+ sprintf(errmsg, "IRAFRIMAGE Cannot allocate %d-byte image buffer",
+ (int) (*filesize));
+ ffpmsg(errmsg);
+ ffpmsg(pixname);
+ fclose (fd);
+ return (*status = FILE_NOT_OPENED);
+ }
+ }
+
+ *buffptr = fitsheader;
+ *buffsize = newfilesize;
+
+ image = fitsheader + *filesize;
+ *filesize = newfilesize;
+
+ /* Read IRAF image all at once if physical and image dimensions are the same */
+ if (npaxis1 == naxis1)
+ nbr = fread (image, 1, nbimage, fd);
+
+ /* Read IRAF image one line at a time if physical and image dimensions differ */
+ else {
+ nbdiff = (npaxis1 - naxis1) * bytepix;
+ nbaxis = naxis1 * bytepix;
+ linebuff = image;
+ nbr = 0;
+ if (naxis2 == 1 && naxis3 > 1)
+ naxis2 = naxis3;
+ for (i = 0; i < naxis2; i++) {
+ nbl = fread (linebuff, 1, nbaxis, fd);
+ nbr = nbr + nbl;
+ fseek (fd, nbdiff, 1);
+ linebuff = linebuff + nbaxis;
+ }
+ }
+ fclose (fd);
+
+ /* Check size of image */
+ if (nbr < nbimage) {
+ sprintf(errmsg, "IRAF pixel file: %d / %d bytes read.",
+ nbr,nbimage);
+ ffpmsg(errmsg);
+ ffpmsg(pixname);
+ return (*status = FILE_NOT_OPENED);
+ }
+
+ /* Byte-reverse image, if necessary */
+ if (swapdata)
+ irafswap (bitpix, image, nbimage);
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+/* Return IRAF image format version number from magic word in IRAF header*/
+
+static int head_version (
+ char *irafheader) /* IRAF image header from file */
+
+{
+
+ /* Check header file magic word */
+ if (irafncmp (irafheader, "imhdr", 5) != 0 ) {
+ if (strncmp (irafheader, "imhv2", 5) != 0)
+ return (0);
+ else
+ return (2);
+ }
+ else
+ return (1);
+}
+
+/*--------------------------------------------------------------------------*/
+/* Return IRAF image format version number from magic word in IRAF pixel file */
+
+static int pix_version (
+ char *irafheader) /* IRAF image header from file */
+{
+
+ /* Check pixel file header magic word */
+ if (irafncmp (irafheader, "impix", 5) != 0) {
+ if (strncmp (irafheader, "impv2", 5) != 0)
+ return (0);
+ else
+ return (2);
+ }
+ else
+ return (1);
+}
+
+/*--------------------------------------------------------------------------*/
+/* Verify that file is valid IRAF imhdr or impix by checking first 5 chars
+ * Returns: 0 on success, 1 on failure */
+
+static int irafncmp (
+
+char *irafheader, /* IRAF image header from file */
+char *teststring, /* C character string to compare */
+int nc) /* Number of characters to compate */
+
+{
+ char *line;
+
+ if ((line = iraf2str (irafheader, nc)) == NULL)
+ return (1);
+ if (strncmp (line, teststring, nc) == 0) {
+ free (line);
+ return (0);
+ }
+ else {
+ free (line);
+ return (1);
+ }
+}
+/*--------------------------------------------------------------------------*/
+
+/* Convert IRAF image header to FITS image header, returning FITS header */
+
+static int iraftofits (
+ char *hdrname, /* IRAF header file name (may be path) */
+ char *irafheader, /* IRAF image header */
+ int nbiraf, /* Number of bytes in IRAF header */
+ char **buffptr, /* pointer to the FITS header */
+ size_t *nbfits, /* allocated size of the FITS header buffer */
+ size_t *fitssize, /* Number of bytes in FITS header (returned) */
+ /* = number of bytes to the end of the END keyword */
+ int *status)
+{
+ char *objname; /* object name from FITS file */
+ int lstr, i, j, k, ib, nax, nbits;
+ char *pixname, *newpixname, *bang, *chead;
+ char *fitsheader;
+ int nblock, nlines;
+ char *fhead, *fhead1, *fp, endline[81];
+ char irafchar;
+ char fitsline[81];
+ int pixtype;
+ int imhver, n, imu, pixoff, impixoff;
+/* int immax, immin, imtime; */
+ int imndim, imlen, imphyslen, impixtype;
+ char errmsg[81];
+
+ /* Set up last line of FITS header */
+ (void)strncpy (endline,"END", 3);
+ for (i = 3; i < 80; i++)
+ endline[i] = ' ';
+ endline[80] = 0;
+
+ /* Check header magic word */
+ imhver = head_version (irafheader);
+ if (imhver < 1) {
+ ffpmsg("File not valid IRAF image header");
+ ffpmsg(hdrname);
+ return(*status = FILE_NOT_OPENED);
+ }
+ if (imhver == 2) {
+ nlines = 24 + ((nbiraf - LEN_IM2HDR) / 81);
+ imndim = IM2_NDIM;
+ imlen = IM2_LEN;
+ imphyslen = IM2_PHYSLEN;
+ impixtype = IM2_PIXTYPE;
+ impixoff = IM2_PIXOFF;
+/* imtime = IM2_MTIME; */
+/* immax = IM2_MAX; */
+/* immin = IM2_MIN; */
+ }
+ else {
+ nlines = 24 + ((nbiraf - LEN_IMHDR) / 162);
+ imndim = IM_NDIM;
+ imlen = IM_LEN;
+ imphyslen = IM_PHYSLEN;
+ impixtype = IM_PIXTYPE;
+ impixoff = IM_PIXOFF;
+/* imtime = IM_MTIME; */
+/* immax = IM_MAX; */
+/* immin = IM_MIN; */
+ }
+
+ /* Initialize FITS header */
+ nblock = (nlines * 80) / 2880;
+ *nbfits = (nblock + 5) * 2880 + 4;
+ fitsheader = (char *) calloc (*nbfits, 1);
+ if (fitsheader == NULL) {
+ sprintf(errmsg, "IRAF2FITS Cannot allocate %d-byte FITS header",
+ (int) (*nbfits));
+ ffpmsg(hdrname);
+ return (*status = FILE_NOT_OPENED);
+ }
+
+ fhead = fitsheader;
+ *buffptr = fitsheader;
+ (void)strncpy (fitsheader, endline, 80);
+ hputl (fitsheader, "SIMPLE", 1);
+ fhead = fhead + 80;
+
+ /* check if the IRAF file is in big endian (sun) format (= 0) or not. */
+ /* This is done by checking the 4 byte integer in the header that */
+ /* represents the iraf pixel type. This 4-byte word is guaranteed to */
+ /* have the least sig byte != 0 and the most sig byte = 0, so if the */
+ /* first byte of the word != 0, then the file in little endian format */
+ /* like on an Alpha machine. */
+
+ swaphead = isirafswapped(irafheader, impixtype);
+ if (imhver == 1)
+ swapdata = swaphead; /* vers 1 data has same swapness as header */
+ else
+ swapdata = irafgeti4 (irafheader, IM2_SWAPPED);
+
+ /* Set pixel size in FITS header */
+ pixtype = irafgeti4 (irafheader, impixtype);
+ switch (pixtype) {
+ case TY_CHAR:
+ nbits = 8;
+ break;
+ case TY_UBYTE:
+ nbits = 8;
+ break;
+ case TY_SHORT:
+ nbits = 16;
+ break;
+ case TY_USHORT:
+ nbits = -16;
+ break;
+ case TY_INT:
+ case TY_LONG:
+ nbits = 32;
+ break;
+ case TY_REAL:
+ nbits = -32;
+ break;
+ case TY_DOUBLE:
+ nbits = -64;
+ break;
+ default:
+ sprintf(errmsg,"Unsupported IRAF data type: %d", pixtype);
+ ffpmsg(errmsg);
+ ffpmsg(hdrname);
+ return (*status = FILE_NOT_OPENED);
+ }
+ hputi4 (fitsheader,"BITPIX",nbits);
+ hputcom (fitsheader,"BITPIX", "IRAF .imh pixel type");
+ fhead = fhead + 80;
+
+ /* Set image dimensions in FITS header */
+ nax = irafgeti4 (irafheader, imndim);
+ hputi4 (fitsheader,"NAXIS",nax);
+ hputcom (fitsheader,"NAXIS", "IRAF .imh naxis");
+ fhead = fhead + 80;
+
+ n = irafgeti4 (irafheader, imlen);
+ hputi4 (fitsheader, "NAXIS1", n);
+ hputcom (fitsheader,"NAXIS1", "IRAF .imh image naxis[1]");
+ fhead = fhead + 80;
+
+ if (nax > 1) {
+ n = irafgeti4 (irafheader, imlen+4);
+ hputi4 (fitsheader, "NAXIS2", n);
+ hputcom (fitsheader,"NAXIS2", "IRAF .imh image naxis[2]");
+ fhead = fhead + 80;
+ }
+ if (nax > 2) {
+ n = irafgeti4 (irafheader, imlen+8);
+ hputi4 (fitsheader, "NAXIS3", n);
+ hputcom (fitsheader,"NAXIS3", "IRAF .imh image naxis[3]");
+ fhead = fhead + 80;
+ }
+ if (nax > 3) {
+ n = irafgeti4 (irafheader, imlen+12);
+ hputi4 (fitsheader, "NAXIS4", n);
+ hputcom (fitsheader,"NAXIS4", "IRAF .imh image naxis[4]");
+ fhead = fhead + 80;
+ }
+
+ /* Set object name in FITS header */
+ if (imhver == 2)
+ objname = irafgetc (irafheader, IM2_TITLE, SZ_IM2TITLE);
+ else
+ objname = irafgetc2 (irafheader, IM_TITLE, SZ_IMTITLE);
+ if ((lstr = strlen (objname)) < 8) {
+ for (i = lstr; i < 8; i++)
+ objname[i] = ' ';
+ objname[8] = 0;
+ }
+ hputs (fitsheader,"OBJECT",objname);
+ hputcom (fitsheader,"OBJECT", "IRAF .imh title");
+ free (objname);
+ fhead = fhead + 80;
+
+ /* Save physical axis lengths so image file can be read */
+ n = irafgeti4 (irafheader, imphyslen);
+ hputi4 (fitsheader, "NPAXIS1", n);
+ hputcom (fitsheader,"NPAXIS1", "IRAF .imh physical naxis[1]");
+ fhead = fhead + 80;
+ if (nax > 1) {
+ n = irafgeti4 (irafheader, imphyslen+4);
+ hputi4 (fitsheader, "NPAXIS2", n);
+ hputcom (fitsheader,"NPAXIS2", "IRAF .imh physical naxis[2]");
+ fhead = fhead + 80;
+ }
+ if (nax > 2) {
+ n = irafgeti4 (irafheader, imphyslen+8);
+ hputi4 (fitsheader, "NPAXIS3", n);
+ hputcom (fitsheader,"NPAXIS3", "IRAF .imh physical naxis[3]");
+ fhead = fhead + 80;
+ }
+ if (nax > 3) {
+ n = irafgeti4 (irafheader, imphyslen+12);
+ hputi4 (fitsheader, "NPAXIS4", n);
+ hputcom (fitsheader,"NPAXIS4", "IRAF .imh physical naxis[4]");
+ fhead = fhead + 80;
+ }
+
+ /* Save image header filename in header */
+ hputs (fitsheader,"IMHFILE",hdrname);
+ hputcom (fitsheader,"IMHFILE", "IRAF header file name");
+ fhead = fhead + 80;
+
+ /* Save image pixel file pathname in header */
+ if (imhver == 2)
+ pixname = irafgetc (irafheader, IM2_PIXFILE, SZ_IM2PIXFILE);
+ else
+ pixname = irafgetc2 (irafheader, IM_PIXFILE, SZ_IMPIXFILE);
+ if (strncmp(pixname, "HDR", 3) == 0 ) {
+ newpixname = same_path (pixname, hdrname);
+ if (newpixname) {
+ free (pixname);
+ pixname = newpixname;
+ }
+ }
+ if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) {
+ newpixname = same_path (pixname, hdrname);
+ if (newpixname) {
+ free (pixname);
+ pixname = newpixname;
+ }
+ }
+
+ if ((bang = strchr (pixname, '!')) != NULL )
+ hputs (fitsheader,"PIXFILE",bang+1);
+ else
+ hputs (fitsheader,"PIXFILE",pixname);
+ free (pixname);
+ hputcom (fitsheader,"PIXFILE", "IRAF .pix pixel file");
+ fhead = fhead + 80;
+
+ /* Save image offset from star of pixel file */
+ pixoff = irafgeti4 (irafheader, impixoff);
+ pixoff = (pixoff - 1) * 2;
+ hputi4 (fitsheader, "PIXOFF", pixoff);
+ hputcom (fitsheader,"PIXOFF", "IRAF .pix pixel offset (Do not change!)");
+ fhead = fhead + 80;
+
+ /* Save IRAF file format version in header */
+ hputi4 (fitsheader,"IMHVER",imhver);
+ hputcom (fitsheader,"IMHVER", "IRAF .imh format version (1 or 2)");
+ fhead = fhead + 80;
+
+ /* Save flag as to whether to swap IRAF data for this file and machine */
+ if (swapdata)
+ hputl (fitsheader, "PIXSWAP", 1);
+ else
+ hputl (fitsheader, "PIXSWAP", 0);
+ hputcom (fitsheader,"PIXSWAP", "IRAF pixels, FITS byte orders differ if T");
+ fhead = fhead + 80;
+
+ /* Add user portion of IRAF header to FITS header */
+ fitsline[80] = 0;
+ if (imhver == 2) {
+ imu = LEN_IM2HDR;
+ chead = irafheader;
+ j = 0;
+ for (k = 0; k < 80; k++)
+ fitsline[k] = ' ';
+ for (i = imu; i < nbiraf; i++) {
+ irafchar = chead[i];
+ if (irafchar == 0)
+ break;
+ else if (irafchar == 10) {
+ (void)strncpy (fhead, fitsline, 80);
+ /* fprintf (stderr,"%80s\n",fitsline); */
+ if (strncmp (fitsline, "OBJECT ", 7) != 0) {
+ fhead = fhead + 80;
+ }
+ for (k = 0; k < 80; k++)
+ fitsline[k] = ' ';
+ j = 0;
+ }
+ else {
+ if (j > 80) {
+ if (strncmp (fitsline, "OBJECT ", 7) != 0) {
+ (void)strncpy (fhead, fitsline, 80);
+ /* fprintf (stderr,"%80s\n",fitsline); */
+ j = 9;
+ fhead = fhead + 80;
+ }
+ for (k = 0; k < 80; k++)
+ fitsline[k] = ' ';
+ }
+ if (irafchar > 32 && irafchar < 127)
+ fitsline[j] = irafchar;
+ j++;
+ }
+ }
+ }
+ else {
+ imu = LEN_IMHDR;
+ chead = irafheader;
+ if (swaphead == 1)
+ ib = 0;
+ else
+ ib = 1;
+ for (k = 0; k < 80; k++)
+ fitsline[k] = ' ';
+ j = 0;
+ for (i = imu; i < nbiraf; i=i+2) {
+ irafchar = chead[i+ib];
+ if (irafchar == 0)
+ break;
+ else if (irafchar == 10) {
+ if (strncmp (fitsline, "OBJECT ", 7) != 0) {
+ (void)strncpy (fhead, fitsline, 80);
+ fhead = fhead + 80;
+ }
+ /* fprintf (stderr,"%80s\n",fitsline); */
+ j = 0;
+ for (k = 0; k < 80; k++)
+ fitsline[k] = ' ';
+ }
+ else {
+ if (j > 80) {
+ if (strncmp (fitsline, "OBJECT ", 7) != 0) {
+ (void)strncpy (fhead, fitsline, 80);
+ j = 9;
+ fhead = fhead + 80;
+ }
+ /* fprintf (stderr,"%80s\n",fitsline); */
+ for (k = 0; k < 80; k++)
+ fitsline[k] = ' ';
+ }
+ if (irafchar > 32 && irafchar < 127)
+ fitsline[j] = irafchar;
+ j++;
+ }
+ }
+ }
+
+ /* Add END to last line */
+ (void)strncpy (fhead, endline, 80);
+
+ /* Find end of last 2880-byte block of header */
+ fhead = ksearch (fitsheader, "END") + 80;
+ nblock = *nbfits / 2880;
+ fhead1 = fitsheader + (nblock * 2880);
+ *fitssize = fhead - fitsheader; /* no. of bytes to end of END keyword */
+
+ /* Pad rest of header with spaces */
+ strncpy (endline," ",3);
+ for (fp = fhead; fp < fhead1; fp = fp + 80) {
+ (void)strncpy (fp, endline,80);
+ }
+
+ return (*status);
+}
+/*--------------------------------------------------------------------------*/
+
+/* get the IRAF pixel file name */
+
+static int getirafpixname (
+ char *hdrname, /* IRAF header file name (may be path) */
+ char *irafheader, /* IRAF image header */
+ char *pixfilename, /* IRAF pixel file name */
+ int *status)
+{
+ int imhver;
+ char *pixname, *newpixname, *bang;
+
+ /* Check header magic word */
+ imhver = head_version (irafheader);
+ if (imhver < 1) {
+ ffpmsg("File not valid IRAF image header");
+ ffpmsg(hdrname);
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ /* get image pixel file pathname in header */
+ if (imhver == 2)
+ pixname = irafgetc (irafheader, IM2_PIXFILE, SZ_IM2PIXFILE);
+ else
+ pixname = irafgetc2 (irafheader, IM_PIXFILE, SZ_IMPIXFILE);
+
+ if (strncmp(pixname, "HDR", 3) == 0 ) {
+ newpixname = same_path (pixname, hdrname);
+ if (newpixname) {
+ free (pixname);
+ pixname = newpixname;
+ }
+ }
+
+ if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) {
+ newpixname = same_path (pixname, hdrname);
+ if (newpixname) {
+ free (pixname);
+ pixname = newpixname;
+ }
+ }
+
+ if ((bang = strchr (pixname, '!')) != NULL )
+ strcpy(pixfilename,bang+1);
+ else
+ strcpy(pixfilename,pixname);
+
+ free (pixname);
+
+ return (*status);
+}
+
+/*--------------------------------------------------------------------------*/
+/* Put filename and header path together */
+
+static char *same_path (
+
+char *pixname, /* IRAF pixel file pathname */
+char *hdrname) /* IRAF image header file pathname */
+
+{
+ int len;
+ char *newpixname;
+
+/* WDP - 10/16/2007 - increased allocation to avoid possible overflow */
+/* newpixname = (char *) calloc (SZ_IM2PIXFILE, sizeof (char)); */
+
+ newpixname = (char *) calloc (2*SZ_IM2PIXFILE+1, sizeof (char));
+ if (newpixname == NULL) {
+ ffpmsg("iraffits same_path: Cannot alloc memory for newpixname");
+ return (NULL);
+ }
+
+ /* Pixel file is in same directory as header */
+ if (strncmp(pixname, "HDR$", 4) == 0 ) {
+ (void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE);
+
+ /* find the end of the pathname */
+ len = strlen (newpixname);
+#ifndef VMS
+ while( (len > 0) && (newpixname[len-1] != '/') )
+#else
+ while( (len > 0) && (newpixname[len-1] != ']') && (newpixname[len-1] != ':') )
+#endif
+ len--;
+
+ /* add name */
+ newpixname[len] = '\0';
+ (void)strncat (newpixname, &pixname[4], SZ_IM2PIXFILE);
+ }
+
+ /* Bare pixel file with no path is assumed to be same as HDR$filename */
+ else if (strchr (pixname, '/') == NULL && strchr (pixname, '$') == NULL) {
+ (void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE);
+
+ /* find the end of the pathname */
+ len = strlen (newpixname);
+#ifndef VMS
+ while( (len > 0) && (newpixname[len-1] != '/') )
+#else
+ while( (len > 0) && (newpixname[len-1] != ']') && (newpixname[len-1] != ':') )
+#endif
+ len--;
+
+ /* add name */
+ newpixname[len] = '\0';
+ (void)strncat (newpixname, pixname, SZ_IM2PIXFILE);
+ }
+
+ /* Pixel file has same name as header file, but with .pix extension */
+ else if (strncmp (pixname, "HDR", 3) == 0) {
+
+ /* load entire header name string into name buffer */
+ (void)strncpy (newpixname, hdrname, SZ_IM2PIXFILE);
+ len = strlen (newpixname);
+ newpixname[len-3] = 'p';
+ newpixname[len-2] = 'i';
+ newpixname[len-1] = 'x';
+ }
+
+ return (newpixname);
+}
+
+/*--------------------------------------------------------------------------*/
+static int isirafswapped (
+
+char *irafheader, /* IRAF image header */
+int offset) /* Number of bytes to skip before number */
+
+ /* check if the IRAF file is in big endian (sun) format (= 0) or not */
+ /* This is done by checking the 4 byte integer in the header that */
+ /* represents the iraf pixel type. This 4-byte word is guaranteed to */
+ /* have the least sig byte != 0 and the most sig byte = 0, so if the */
+ /* first byte of the word != 0, then the file in little endian format */
+ /* like on an Alpha machine. */
+
+{
+ int swapped;
+
+ if (irafheader[offset] != 0)
+ swapped = 1;
+ else
+ swapped = 0;
+
+ return (swapped);
+}
+/*--------------------------------------------------------------------------*/
+static int irafgeti4 (
+
+char *irafheader, /* IRAF image header */
+int offset) /* Number of bytes to skip before number */
+
+{
+ char *ctemp, *cheader;
+ int temp;
+
+ cheader = irafheader;
+ ctemp = (char *) &temp;
+
+ if (machswap() != swaphead) {
+ ctemp[3] = cheader[offset];
+ ctemp[2] = cheader[offset+1];
+ ctemp[1] = cheader[offset+2];
+ ctemp[0] = cheader[offset+3];
+ }
+ else {
+ ctemp[0] = cheader[offset];
+ ctemp[1] = cheader[offset+1];
+ ctemp[2] = cheader[offset+2];
+ ctemp[3] = cheader[offset+3];
+ }
+ return (temp);
+}
+
+/*--------------------------------------------------------------------------*/
+/* IRAFGETC2 -- Get character string from arbitrary part of v.1 IRAF header */
+
+static char *irafgetc2 (
+
+char *irafheader, /* IRAF image header */
+int offset, /* Number of bytes to skip before string */
+int nc) /* Maximum number of characters in string */
+
+{
+ char *irafstring, *string;
+
+ irafstring = irafgetc (irafheader, offset, 2*(nc+1));
+ string = iraf2str (irafstring, nc);
+ free (irafstring);
+
+ return (string);
+}
+
+/*--------------------------------------------------------------------------*/
+/* IRAFGETC -- Get character string from arbitrary part of IRAF header */
+
+static char *irafgetc (
+
+char *irafheader, /* IRAF image header */
+int offset, /* Number of bytes to skip before string */
+int nc) /* Maximum number of characters in string */
+
+{
+ char *ctemp, *cheader;
+ int i;
+
+ cheader = irafheader;
+ ctemp = (char *) calloc (nc+1, 1);
+ if (ctemp == NULL) {
+ ffpmsg("IRAFGETC Cannot allocate memory for string variable");
+ return (NULL);
+ }
+ for (i = 0; i < nc; i++) {
+ ctemp[i] = cheader[offset+i];
+ if (ctemp[i] > 0 && ctemp[i] < 32)
+ ctemp[i] = ' ';
+ }
+
+ return (ctemp);
+}
+
+/*--------------------------------------------------------------------------*/
+/* Convert IRAF 2-byte/char string to 1-byte/char string */
+
+static char *iraf2str (
+
+char *irafstring, /* IRAF 2-byte/character string */
+int nchar) /* Number of characters in string */
+{
+ char *string;
+ int i, j;
+
+ string = (char *) calloc (nchar+1, 1);
+ if (string == NULL) {
+ ffpmsg("IRAF2STR Cannot allocate memory for string variable");
+ return (NULL);
+ }
+
+ /* the chars are in bytes 1, 3, 5, ... if bigendian format (SUN) */
+ /* else in bytes 0, 2, 4, ... if little endian format (Alpha) */
+
+ if (irafstring[0] != 0)
+ j = 0;
+ else
+ j = 1;
+
+ /* Convert appropriate byte of input to output character */
+ for (i = 0; i < nchar; i++) {
+ string[i] = irafstring[j];
+ j = j + 2;
+ }
+
+ return (string);
+}
+
+/*--------------------------------------------------------------------------*/
+/* IRAFSWAP -- Reverse bytes of any type of vector in place */
+
+static void irafswap (
+
+int bitpix, /* Number of bits per pixel */
+ /* 16 = short, -16 = unsigned short, 32 = int */
+ /* -32 = float, -64 = double */
+char *string, /* Address of starting point of bytes to swap */
+int nbytes) /* Number of bytes to swap */
+
+{
+ switch (bitpix) {
+
+ case 16:
+ if (nbytes < 2) return;
+ irafswap2 (string,nbytes);
+ break;
+
+ case 32:
+ if (nbytes < 4) return;
+ irafswap4 (string,nbytes);
+ break;
+
+ case -16:
+ if (nbytes < 2) return;
+ irafswap2 (string,nbytes);
+ break;
+
+ case -32:
+ if (nbytes < 4) return;
+ irafswap4 (string,nbytes);
+ break;
+
+ case -64:
+ if (nbytes < 8) return;
+ irafswap8 (string,nbytes);
+ break;
+
+ }
+ return;
+}
+
+/*--------------------------------------------------------------------------*/
+/* IRAFSWAP2 -- Swap bytes in string in place */
+
+static void irafswap2 (
+
+char *string, /* Address of starting point of bytes to swap */
+int nbytes) /* Number of bytes to swap */
+
+{
+ char *sbyte, temp, *slast;
+
+ slast = string + nbytes;
+ sbyte = string;
+ while (sbyte < slast) {
+ temp = sbyte[0];
+ sbyte[0] = sbyte[1];
+ sbyte[1] = temp;
+ sbyte= sbyte + 2;
+ }
+ return;
+}
+
+/*--------------------------------------------------------------------------*/
+/* IRAFSWAP4 -- Reverse bytes of Integer*4 or Real*4 vector in place */
+
+static void irafswap4 (
+
+char *string, /* Address of Integer*4 or Real*4 vector */
+int nbytes) /* Number of bytes to reverse */
+
+{
+ char *sbyte, *slast;
+ char temp0, temp1, temp2, temp3;
+
+ slast = string + nbytes;
+ sbyte = string;
+ while (sbyte < slast) {
+ temp3 = sbyte[0];
+ temp2 = sbyte[1];
+ temp1 = sbyte[2];
+ temp0 = sbyte[3];
+ sbyte[0] = temp0;
+ sbyte[1] = temp1;
+ sbyte[2] = temp2;
+ sbyte[3] = temp3;
+ sbyte = sbyte + 4;
+ }
+
+ return;
+}
+
+/*--------------------------------------------------------------------------*/
+/* IRAFSWAP8 -- Reverse bytes of Real*8 vector in place */
+
+static void irafswap8 (
+
+char *string, /* Address of Real*8 vector */
+int nbytes) /* Number of bytes to reverse */
+
+{
+ char *sbyte, *slast;
+ char temp[8];
+
+ slast = string + nbytes;
+ sbyte = string;
+ while (sbyte < slast) {
+ temp[7] = sbyte[0];
+ temp[6] = sbyte[1];
+ temp[5] = sbyte[2];
+ temp[4] = sbyte[3];
+ temp[3] = sbyte[4];
+ temp[2] = sbyte[5];
+ temp[1] = sbyte[6];
+ temp[0] = sbyte[7];
+ sbyte[0] = temp[0];
+ sbyte[1] = temp[1];
+ sbyte[2] = temp[2];
+ sbyte[3] = temp[3];
+ sbyte[4] = temp[4];
+ sbyte[5] = temp[5];
+ sbyte[6] = temp[6];
+ sbyte[7] = temp[7];
+ sbyte = sbyte + 8;
+ }
+ return;
+}
+
+/*--------------------------------------------------------------------------*/
+static int
+machswap (void)
+
+{
+ char *ctest;
+ int itest;
+
+ itest = 1;
+ ctest = (char *)&itest;
+ if (*ctest)
+ return (1);
+ else
+ return (0);
+}
+
+/*--------------------------------------------------------------------------*/
+/* the following routines were originally in hget.c */
+/*--------------------------------------------------------------------------*/
+
+
+static int lhead0 = 0;
+
+/*--------------------------------------------------------------------------*/
+
+/* Extract long value for variable from FITS header string */
+
+static int
+hgeti4 (hstring,keyword,ival)
+
+char *hstring; /* character string containing FITS header information
+ in the format <keyword>= <value> {/ <comment>} */
+char *keyword; /* character string containing the name of the keyword
+ the value of which is returned. hget searches for a
+ line beginning with this string. if "[n]" is present,
+ the n'th token in the value is returned.
+ (the first 8 characters must be unique) */
+int *ival;
+{
+char *value;
+double dval;
+int minint;
+char val[30];
+
+/* Get value and comment from header string */
+ value = hgetc (hstring,keyword);
+
+/* Translate value from ASCII to binary */
+ if (value != NULL) {
+ minint = -MAXINT - 1;
+ strcpy (val, value);
+ dval = atof (val);
+ if (dval+0.001 > MAXINT)
+ *ival = MAXINT;
+ else if (dval >= 0)
+ *ival = (int) (dval + 0.001);
+ else if (dval-0.001 < minint)
+ *ival = minint;
+ else
+ *ival = (int) (dval - 0.001);
+ return (1);
+ }
+ else {
+ return (0);
+ }
+}
+
+/*-------------------------------------------------------------------*/
+/* Extract string value for variable from FITS header string */
+
+static int
+hgets (hstring, keyword, lstr, str)
+
+char *hstring; /* character string containing FITS header information
+ in the format <keyword>= <value> {/ <comment>} */
+char *keyword; /* character string containing the name of the keyword
+ the value of which is returned. hget searches for a
+ line beginning with this string. if "[n]" is present,
+ the n'th token in the value is returned.
+ (the first 8 characters must be unique) */
+int lstr; /* Size of str in characters */
+char *str; /* String (returned) */
+{
+ char *value;
+ int lval;
+
+/* Get value and comment from header string */
+ value = hgetc (hstring,keyword);
+
+ if (value != NULL) {
+ lval = strlen (value);
+ if (lval < lstr)
+ strcpy (str, value);
+ else if (lstr > 1)
+ strncpy (str, value, lstr-1);
+ else
+ str[0] = value[0];
+ return (1);
+ }
+ else
+ return (0);
+}
+
+/*-------------------------------------------------------------------*/
+/* Extract character value for variable from FITS header string */
+
+static char *
+hgetc (hstring,keyword0)
+
+char *hstring; /* character string containing FITS header information
+ in the format <keyword>= <value> {/ <comment>} */
+char *keyword0; /* character string containing the name of the keyword
+ the value of which is returned. hget searches for a
+ line beginning with this string. if "[n]" is present,
+ the n'th token in the value is returned.
+ (the first 8 characters must be unique) */
+{
+ static char cval[80];
+ char *value;
+ char cwhite[2];
+ char squot[2], dquot[2], lbracket[2], rbracket[2], slash[2], comma[2];
+ char keyword[81]; /* large for ESO hierarchical keywords */
+ char line[100];
+ char *vpos, *cpar = NULL;
+ char *q1, *q2 = NULL, *v1, *v2, *c1, *brack1, *brack2;
+ int ipar, i;
+
+ squot[0] = 39;
+ squot[1] = 0;
+ dquot[0] = 34;
+ dquot[1] = 0;
+ lbracket[0] = 91;
+ lbracket[1] = 0;
+ comma[0] = 44;
+ comma[1] = 0;
+ rbracket[0] = 93;
+ rbracket[1] = 0;
+ slash[0] = 47;
+ slash[1] = 0;
+
+/* Find length of variable name */
+ strncpy (keyword,keyword0, sizeof(keyword)-1);
+ brack1 = strsrch (keyword,lbracket);
+ if (brack1 == NULL)
+ brack1 = strsrch (keyword,comma);
+ if (brack1 != NULL) {
+ *brack1 = '\0';
+ brack1++;
+ }
+
+/* Search header string for variable name */
+ vpos = ksearch (hstring,keyword);
+
+/* Exit if not found */
+ if (vpos == NULL) {
+ return (NULL);
+ }
+
+/* Initialize line to nulls */
+ for (i = 0; i < 100; i++)
+ line[i] = 0;
+
+/* In standard FITS, data lasts until 80th character */
+
+/* Extract entry for this variable from the header */
+ strncpy (line,vpos,80);
+
+/* check for quoted value */
+ q1 = strsrch (line,squot);
+ c1 = strsrch (line,slash);
+ if (q1 != NULL) {
+ if (c1 != NULL && q1 < c1)
+ q2 = strsrch (q1+1,squot);
+ else if (c1 == NULL)
+ q2 = strsrch (q1+1,squot);
+ else
+ q1 = NULL;
+ }
+ else {
+ q1 = strsrch (line,dquot);
+ if (q1 != NULL) {
+ if (c1 != NULL && q1 < c1)
+ q2 = strsrch (q1+1,dquot);
+ else if (c1 == NULL)
+ q2 = strsrch (q1+1,dquot);
+ else
+ q1 = NULL;
+ }
+ else {
+ q1 = NULL;
+ q2 = line + 10;
+ }
+ }
+
+/* Extract value and remove excess spaces */
+ if (q1 != NULL) {
+ v1 = q1 + 1;
+ v2 = q2;
+ c1 = strsrch (q2,"/");
+ }
+ else {
+ v1 = strsrch (line,"=") + 1;
+ c1 = strsrch (line,"/");
+ if (c1 != NULL)
+ v2 = c1;
+ else
+ v2 = line + 79;
+ }
+
+/* Ignore leading spaces */
+ while (*v1 == ' ' && v1 < v2) {
+ v1++;
+ }
+
+/* Drop trailing spaces */
+ *v2 = '\0';
+ v2--;
+ while (*v2 == ' ' && v2 > v1) {
+ *v2 = '\0';
+ v2--;
+ }
+
+ if (!strcmp (v1, "-0"))
+ v1++;
+ strcpy (cval,v1);
+ value = cval;
+
+/* If keyword has brackets, extract appropriate token from value */
+ if (brack1 != NULL) {
+ brack2 = strsrch (brack1,rbracket);
+ if (brack2 != NULL)
+ *brack2 = '\0';
+ ipar = atoi (brack1);
+ if (ipar > 0) {
+ cwhite[0] = ' ';
+ cwhite[1] = '\0';
+ for (i = 1; i <= ipar; i++) {
+ cpar = strtok (v1,cwhite);
+ v1 = NULL;
+ }
+ if (cpar != NULL) {
+ strcpy (cval,cpar);
+ }
+ else
+ value = NULL;
+ }
+ }
+
+ return (value);
+}
+
+
+/*-------------------------------------------------------------------*/
+/* Find beginning of fillable blank line before FITS header keyword line */
+
+static char *
+blsearch (hstring,keyword)
+
+/* Find entry for keyword keyword in FITS header string hstring.
+ (the keyword may have a maximum of eight letters)
+ NULL is returned if the keyword is not found */
+
+char *hstring; /* character string containing fits-style header
+ information in the format <keyword>= <value> {/ <comment>}
+ the default is that each entry is 80 characters long;
+ however, lines may be of arbitrary length terminated by
+ nulls, carriage returns or linefeeds, if packed is true. */
+char *keyword; /* character string containing the name of the variable
+ to be returned. ksearch searches for a line beginning
+ with this string. The string may be a character
+ literal or a character variable terminated by a null
+ or '$'. it is truncated to 8 characters. */
+{
+ char *loc, *headnext, *headlast, *pval, *lc, *line;
+ char *bval;
+ int icol, nextchar, lkey, nleft, lhstr;
+
+ pval = 0;
+
+ /* Search header string for variable name */
+ if (lhead0)
+ lhstr = lhead0;
+ else {
+ lhstr = 0;
+ while (lhstr < 57600 && hstring[lhstr] != 0)
+ lhstr++;
+ }
+ headlast = hstring + lhstr;
+ headnext = hstring;
+ pval = NULL;
+ while (headnext < headlast) {
+ nleft = headlast - headnext;
+ loc = strnsrch (headnext, keyword, nleft);
+
+ /* Exit if keyword is not found */
+ if (loc == NULL) {
+ break;
+ }
+
+ icol = (loc - hstring) % 80;
+ lkey = strlen (keyword);
+ nextchar = (int) *(loc + lkey);
+
+ /* If this is not in the first 8 characters of a line, keep searching */
+ if (icol > 7)
+ headnext = loc + 1;
+
+ /* If parameter name in header is longer, keep searching */
+ else if (nextchar != 61 && nextchar > 32 && nextchar < 127)
+ headnext = loc + 1;
+
+ /* If preceeding characters in line are not blanks, keep searching */
+ else {
+ line = loc - icol;
+ for (lc = line; lc < loc; lc++) {
+ if (*lc != ' ')
+ headnext = loc + 1;
+ }
+
+ /* Return pointer to start of line if match */
+ if (loc >= headnext) {
+ pval = line;
+ break;
+ }
+ }
+ }
+
+ /* Return NULL if keyword is found at start of FITS header string */
+ if (pval == NULL)
+ return (pval);
+
+ /* Return NULL if found the first keyword in the header */
+ if (pval == hstring)
+ return (NULL);
+
+ /* Find last nonblank line before requested keyword */
+ bval = pval - 80;
+ while (!strncmp (bval," ",8))
+ bval = bval - 80;
+ bval = bval + 80;
+
+ /* Return pointer to calling program if blank lines found */
+ if (bval < pval)
+ return (bval);
+ else
+ return (NULL);
+}
+
+
+/*-------------------------------------------------------------------*/
+/* Find FITS header line containing specified keyword */
+
+static char *ksearch (hstring,keyword)
+
+/* Find entry for keyword keyword in FITS header string hstring.
+ (the keyword may have a maximum of eight letters)
+ NULL is returned if the keyword is not found */
+
+char *hstring; /* character string containing fits-style header
+ information in the format <keyword>= <value> {/ <comment>}
+ the default is that each entry is 80 characters long;
+ however, lines may be of arbitrary length terminated by
+ nulls, carriage returns or linefeeds, if packed is true. */
+char *keyword; /* character string containing the name of the variable
+ to be returned. ksearch searches for a line beginning
+ with this string. The string may be a character
+ literal or a character variable terminated by a null
+ or '$'. it is truncated to 8 characters. */
+{
+ char *loc, *headnext, *headlast, *pval, *lc, *line;
+ int icol, nextchar, lkey, nleft, lhstr;
+
+ pval = 0;
+
+/* Search header string for variable name */
+ if (lhead0)
+ lhstr = lhead0;
+ else {
+ lhstr = 0;
+ while (lhstr < 57600 && hstring[lhstr] != 0)
+ lhstr++;
+ }
+ headlast = hstring + lhstr;
+ headnext = hstring;
+ pval = NULL;
+ while (headnext < headlast) {
+ nleft = headlast - headnext;
+ loc = strnsrch (headnext, keyword, nleft);
+
+ /* Exit if keyword is not found */
+ if (loc == NULL) {
+ break;
+ }
+
+ icol = (loc - hstring) % 80;
+ lkey = strlen (keyword);
+ nextchar = (int) *(loc + lkey);
+
+ /* If this is not in the first 8 characters of a line, keep searching */
+ if (icol > 7)
+ headnext = loc + 1;
+
+ /* If parameter name in header is longer, keep searching */
+ else if (nextchar != 61 && nextchar > 32 && nextchar < 127)
+ headnext = loc + 1;
+
+ /* If preceeding characters in line are not blanks, keep searching */
+ else {
+ line = loc - icol;
+ for (lc = line; lc < loc; lc++) {
+ if (*lc != ' ')
+ headnext = loc + 1;
+ }
+
+ /* Return pointer to start of line if match */
+ if (loc >= headnext) {
+ pval = line;
+ break;
+ }
+ }
+ }
+
+/* Return pointer to calling program */
+ return (pval);
+
+}
+
+/*-------------------------------------------------------------------*/
+/* Find string s2 within null-terminated string s1 */
+
+static char *
+strsrch (s1, s2)
+
+char *s1; /* String to search */
+char *s2; /* String to look for */
+
+{
+ int ls1;
+ ls1 = strlen (s1);
+ return (strnsrch (s1, s2, ls1));
+}
+
+/*-------------------------------------------------------------------*/
+/* Find string s2 within string s1 */
+
+static char *
+strnsrch (s1, s2, ls1)
+
+char *s1; /* String to search */
+char *s2; /* String to look for */
+int ls1; /* Length of string being searched */
+
+{
+ char *s,*s1e;
+ char cfirst,clast;
+ int i,ls2;
+
+ /* Return null string if either pointer is NULL */
+ if (s1 == NULL || s2 == NULL)
+ return (NULL);
+
+ /* A zero-length pattern is found in any string */
+ ls2 = strlen (s2);
+ if (ls2 ==0)
+ return (s1);
+
+ /* Only a zero-length string can be found in a zero-length string */
+ if (ls1 ==0)
+ return (NULL);
+
+ cfirst = s2[0];
+ clast = s2[ls2-1];
+ s1e = s1 + ls1 - ls2 + 1;
+ s = s1;
+ while (s < s1e) {
+
+ /* Search for first character in pattern string */
+ if (*s == cfirst) {
+
+ /* If single character search, return */
+ if (ls2 == 1)
+ return (s);
+
+ /* Search for last character in pattern string if first found */
+ if (s[ls2-1] == clast) {
+
+ /* If two-character search, return */
+ if (ls2 == 2)
+ return (s);
+
+ /* If 3 or more characters, check for rest of search string */
+ i = 1;
+ while (i < ls2 && s[i] == s2[i])
+ i++;
+
+ /* If entire string matches, return */
+ if (i >= ls2)
+ return (s);
+ }
+ }
+ s++;
+ }
+ return (NULL);
+}
+
+/*-------------------------------------------------------------------*/
+/* the following routines were originally in hget.c */
+/*-------------------------------------------------------------------*/
+/* HPUTI4 - Set int keyword = ival in FITS header string */
+
+static void
+hputi4 (hstring,keyword,ival)
+
+ char *hstring; /* character string containing FITS-style header
+ information in the format
+ <keyword>= <value> {/ <comment>}
+ each entry is padded with spaces to 80 characters */
+
+ char *keyword; /* character string containing the name of the variable
+ to be returned. hput searches for a line beginning
+ with this string, and if there isn't one, creates one.
+ The first 8 characters of keyword must be unique. */
+ int ival; /* int number */
+{
+ char value[30];
+
+ /* Translate value from binary to ASCII */
+ sprintf (value,"%d",ival);
+
+ /* Put value into header string */
+ hputc (hstring,keyword,value);
+
+ /* Return to calling program */
+ return;
+}
+
+/*-------------------------------------------------------------------*/
+
+/* HPUTL - Set keyword = F if lval=0, else T, in FITS header string */
+
+static void
+hputl (hstring, keyword,lval)
+
+char *hstring; /* FITS header */
+char *keyword; /* Keyword name */
+int lval; /* logical variable (0=false, else true) */
+{
+ char value[8];
+
+ /* Translate value from binary to ASCII */
+ if (lval)
+ strcpy (value, "T");
+ else
+ strcpy (value, "F");
+
+ /* Put value into header string */
+ hputc (hstring,keyword,value);
+
+ /* Return to calling program */
+ return;
+}
+
+/*-------------------------------------------------------------------*/
+
+/* HPUTS - Set character string keyword = 'cval' in FITS header string */
+
+static void
+hputs (hstring,keyword,cval)
+
+char *hstring; /* FITS header */
+char *keyword; /* Keyword name */
+char *cval; /* character string containing the value for variable
+ keyword. trailing and leading blanks are removed. */
+{
+ char squot = 39;
+ char value[70];
+ int lcval;
+
+ /* find length of variable string */
+
+ lcval = strlen (cval);
+ if (lcval > 67)
+ lcval = 67;
+
+ /* Put quotes around string */
+ value[0] = squot;
+ strncpy (&value[1],cval,lcval);
+ value[lcval+1] = squot;
+ value[lcval+2] = 0;
+
+ /* Put value into header string */
+ hputc (hstring,keyword,value);
+
+ /* Return to calling program */
+ return;
+}
+
+/*---------------------------------------------------------------------*/
+/* HPUTC - Set character string keyword = value in FITS header string */
+
+static void
+hputc (hstring,keyword,value)
+
+char *hstring;
+char *keyword;
+char *value; /* character string containing the value for variable
+ keyword. trailing and leading blanks are removed. */
+{
+ char squot = 39;
+ char line[100];
+ char newcom[50];
+ char blank[80];
+ char *v, *vp, *v1, *v2, *q1, *q2, *c1, *ve;
+ int lkeyword, lcom, lval, lc, i;
+
+ for (i = 0; i < 80; i++)
+ blank[i] = ' ';
+
+ /* find length of keyword and value */
+ lkeyword = strlen (keyword);
+ lval = strlen (value);
+
+ /* If COMMENT or HISTORY, always add it just before the END */
+ if (lkeyword == 7 && (strncmp (keyword,"COMMENT",7) == 0 ||
+ strncmp (keyword,"HISTORY",7) == 0)) {
+
+ /* Find end of header */
+ v1 = ksearch (hstring,"END");
+ v2 = v1 + 80;
+
+ /* Move END down one line */
+ strncpy (v2, v1, 80);
+
+ /* Insert keyword */
+ strncpy (v1,keyword,7);
+
+ /* Pad with spaces */
+ for (vp = v1+lkeyword; vp < v2; vp++)
+ *vp = ' ';
+
+ /* Insert comment */
+ strncpy (v1+9,value,lval);
+ return;
+ }
+
+ /* Otherwise search for keyword */
+ else
+ v1 = ksearch (hstring,keyword);
+
+ /* If parameter is not found, find a place to put it */
+ if (v1 == NULL) {
+
+ /* First look for blank lines before END */
+ v1 = blsearch (hstring, "END");
+
+ /* Otherwise, create a space for it at the end of the header */
+ if (v1 == NULL) {
+ ve = ksearch (hstring,"END");
+ v1 = ve;
+ v2 = v1 + 80;
+ strncpy (v2, ve, 80);
+ }
+ else
+ v2 = v1 + 80;
+ lcom = 0;
+ newcom[0] = 0;
+ }
+
+ /* Otherwise, extract the entry for this keyword from the header */
+ else {
+ strncpy (line, v1, 80);
+ line[80] = 0;
+ v2 = v1 + 80;
+
+ /* check for quoted value */
+ q1 = strchr (line, squot);
+ if (q1 != NULL)
+ q2 = strchr (q1+1,squot);
+ else
+ q2 = line;
+
+ /* extract comment and remove trailing spaces */
+
+ c1 = strchr (q2,'/');
+ if (c1 != NULL) {
+ lcom = 80 - (c1 - line);
+ strncpy (newcom, c1+1, lcom);
+ vp = newcom + lcom - 1;
+ while (vp-- > newcom && *vp == ' ')
+ *vp = 0;
+ lcom = strlen (newcom);
+ }
+ else {
+ newcom[0] = 0;
+ lcom = 0;
+ }
+ }
+
+ /* Fill new entry with spaces */
+ for (vp = v1; vp < v2; vp++)
+ *vp = ' ';
+
+ /* Copy keyword to new entry */
+ strncpy (v1, keyword, lkeyword);
+
+ /* Add parameter value in the appropriate place */
+ vp = v1 + 8;
+ *vp = '=';
+ vp = v1 + 9;
+ *vp = ' ';
+ vp = vp + 1;
+ if (*value == squot) {
+ strncpy (vp, value, lval);
+ if (lval+12 > 31)
+ lc = lval + 12;
+ else
+ lc = 30;
+ }
+ else {
+ vp = v1 + 30 - lval;
+ strncpy (vp, value, lval);
+ lc = 30;
+ }
+
+ /* Add comment in the appropriate place */
+ if (lcom > 0) {
+ if (lc+2+lcom > 80)
+ lcom = 78 - lc;
+ vp = v1 + lc + 2; /* Jul 16 1997: was vp = v1 + lc * 2 */
+ *vp = '/';
+ vp = vp + 1;
+ strncpy (vp, newcom, lcom);
+ for (v = vp + lcom; v < v2; v++)
+ *v = ' ';
+ }
+
+ return;
+}
+
+/*-------------------------------------------------------------------*/
+/* HPUTCOM - Set comment for keyword or on line in FITS header string */
+
+static void
+hputcom (hstring,keyword,comment)
+
+ char *hstring;
+ char *keyword;
+ char *comment;
+{
+ char squot;
+ char line[100];
+ int lkeyword, lcom;
+ char *vp, *v1, *v2, *c0 = NULL, *c1, *q1, *q2;
+
+ squot = 39;
+
+/* Find length of variable name */
+ lkeyword = strlen (keyword);
+
+/* If COMMENT or HISTORY, always add it just before the END */
+ if (lkeyword == 7 && (strncmp (keyword,"COMMENT",7) == 0 ||
+ strncmp (keyword,"HISTORY",7) == 0)) {
+
+ /* Find end of header */
+ v1 = ksearch (hstring,"END");
+ v2 = v1 + 80;
+ strncpy (v2, v1, 80);
+
+ /* blank out new line and insert keyword */
+ for (vp = v1; vp < v2; vp++)
+ *vp = ' ';
+ strncpy (v1, keyword, lkeyword);
+ }
+
+/* search header string for variable name */
+ else {
+ v1 = ksearch (hstring,keyword);
+ v2 = v1 + 80;
+
+ /* if parameter is not found, return without doing anything */
+ if (v1 == NULL) {
+ return;
+ }
+
+ /* otherwise, extract entry for this variable from the header */
+ strncpy (line, v1, 80);
+
+ /* check for quoted value */
+ q1 = strchr (line,squot);
+ if (q1 != NULL)
+ q2 = strchr (q1+1,squot);
+ else
+ q2 = NULL;
+
+ if (q2 == NULL || q2-line < 31)
+ c0 = v1 + 31;
+ else
+ c0 = v1 + (q2-line) + 2; /* allan: 1997-09-30, was c0=q2+2 */
+
+ strncpy (c0, "/ ",2);
+ }
+
+/* create new entry */
+ lcom = strlen (comment);
+
+ if (lcom > 0) {
+ c1 = c0 + 2;
+ if (c1+lcom > v2)
+ lcom = v2 - c1;
+ strncpy (c1, comment, lcom);
+ }
+
+}
diff --git a/src/plugins/cfitsio/iter_a.c b/src/plugins/cfitsio/iter_a.c
new file mode 100644
index 0000000..19ea1d1
--- /dev/null
+++ b/src/plugins/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 */
+}
diff --git a/src/plugins/cfitsio/iter_b.c b/src/plugins/cfitsio/iter_b.c
new file mode 100644
index 0000000..296f4e1
--- /dev/null
+++ b/src/plugins/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);
+}
diff --git a/src/plugins/cfitsio/iter_c.c b/src/plugins/cfitsio/iter_c.c
new file mode 100644
index 0000000..bbf9774
--- /dev/null
+++ b/src/plugins/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);
+}
+
diff --git a/src/plugins/cfitsio/iter_image.c b/src/plugins/cfitsio/iter_image.c
new file mode 100644
index 0000000..43f263c
--- /dev/null
+++ b/src/plugins/cfitsio/iter_image.c
@@ -0,0 +1,93 @@
+#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_image.fit' image file by setting
+ all the pixel values to zero (DESTROYING THE ORIGINAL IMAGE!!!)
+*/
+main()
+{
+ extern zero_image(); /* 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_image.fit"; /* name of rate FITS file */
+
+ status = 0;
+
+ fits_open_file(&fptr, filename, READWRITE, &status); /* open file */
+
+
+ n_cols = 1;
+
+ /* define input column structure members for the iterator function */
+ fits_iter_set_file(&cols[0], fptr);
+ fits_iter_set_iotype(&cols[0], InputOutputCol);
+ fits_iter_set_datatype(&cols[0], 0);
+
+ 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,
+ zero_image, 0L, &status);
+
+ fits_close_file(fptr, &status); /* all done */
+
+ if (status)
+ fits_report_error(stderr, status); /* print out error messages */
+
+ return(status);
+}
+/*--------------------------------------------------------------------------*/
+int zero_image(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 int *counts;
+
+ /*--------------------------------------------------------*/
+ /* Initialization procedures: execute on the first call */
+ /*--------------------------------------------------------*/
+ if (firstrow == 1)
+ {
+ if (ncols != 1)
+ return(-1); /* number of columns incorrect */
+
+ /* assign the input pointers to the appropriate arrays and null ptrs*/
+ counts = (int *) fits_iter_get_array(&cols[0]);
+ }
+
+ /*--------------------------------------------*/
+ /* 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++)
+ {
+ counts[ii] = 1.;
+ }
+ printf("firstrows, nrows = %d %d\n", firstrow, nrows);
+
+ return(0); /* return successful status */
+}
diff --git a/src/plugins/cfitsio/iter_var.c b/src/plugins/cfitsio/iter_var.c
new file mode 100644
index 0000000..50d0132
--- /dev/null
+++ b/src/plugins/cfitsio/iter_var.c
@@ -0,0 +1,100 @@
+#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[] = "vari.fits"; /* 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, "COMPRESSED_IMAGE", 0, &status) )
+ fits_report_error(stderr, status); /* print out error messages */
+
+ n_cols = 1; /* number of columns */
+
+ /* define input column structure members for the iterator function */
+ fits_iter_set_by_name(&cols[0], fptr, "COMPRESSED_DATA", 0, InputCol);
+
+ 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;
+ long repeat;
+
+ /* declare variables static to preserve their values between calls */
+ static unsigned char *counts;
+
+ /*--------------------------------------------------------*/
+ /* Initialization procedures: execute on the first call */
+ /*--------------------------------------------------------*/
+ if (firstrow == 1)
+ {
+
+printf("Datatype of column = %d\n",fits_iter_get_datatype(&cols[0]));
+
+ /* assign the input pointers to the appropriate arrays and null ptrs*/
+ counts = (long *) fits_iter_get_array(&cols[0]);
+
+ }
+
+ /*--------------------------------------------*/
+ /* 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++)
+ {
+ repeat = fits_iter_get_repeat(&cols[0]);
+ printf ("repeat = %d, %d\n",repeat, counts[1]);
+
+ }
+
+
+ return(0); /* return successful status */
+}
diff --git a/src/plugins/cfitsio/longnam.h b/src/plugins/cfitsio/longnam.h
new file mode 100644
index 0000000..cac8da4
--- /dev/null
+++ b/src/plugins/cfitsio/longnam.h
@@ -0,0 +1,592 @@
+#ifndef _LONGNAME_H
+#define _LONGNAME_H
+
+#define fits_parse_input_url ffiurl
+#define fits_parse_input_filename ffifile
+#define fits_parse_rootname ffrtnm
+#define fits_file_exists ffexist
+#define fits_parse_output_url ffourl
+#define fits_parse_extspec ffexts
+#define fits_parse_extnum ffextn
+#define fits_parse_binspec ffbins
+#define fits_parse_binrange ffbinr
+#define fits_parse_range ffrwrg
+#define fits_parse_rangell ffrwrgll
+#define fits_open_memfile ffomem
+
+/*
+ use the following special macro to test that the fitsio.h include
+ file that was used to build the CFITSIO library is the same version
+ as included when compiling the application program
+*/
+#define fits_open_file(A, B, C, D) ffopentest( CFITSIO_VERSION, A, B, C, D)
+
+#define fits_open_data ffdopn
+#define fits_open_table fftopn
+#define fits_open_image ffiopn
+#define fits_open_diskfile ffdkopn
+#define fits_reopen_file ffreopen
+#define fits_create_file ffinit
+#define fits_create_diskfile ffdkinit
+#define fits_create_memfile ffimem
+#define fits_create_template fftplt
+#define fits_flush_file ffflus
+#define fits_flush_buffer ffflsh
+#define fits_close_file ffclos
+#define fits_delete_file ffdelt
+#define fits_file_name ffflnm
+#define fits_file_mode ffflmd
+#define fits_url_type ffurlt
+
+#define fits_get_version ffvers
+#define fits_uppercase ffupch
+#define fits_get_errstatus ffgerr
+#define fits_write_errmsg ffpmsg
+#define fits_write_errmark ffpmrk
+#define fits_read_errmsg ffgmsg
+#define fits_clear_errmsg ffcmsg
+#define fits_clear_errmark ffcmrk
+#define fits_report_error ffrprt
+#define fits_compare_str ffcmps
+#define fits_test_keyword fftkey
+#define fits_test_record fftrec
+#define fits_null_check ffnchk
+#define fits_make_keyn ffkeyn
+#define fits_make_nkey ffnkey
+#define fits_get_keyclass ffgkcl
+#define fits_get_keytype ffdtyp
+#define fits_get_inttype ffinttyp
+#define fits_parse_value ffpsvc
+#define fits_get_keyname ffgknm
+#define fits_parse_template ffgthd
+#define fits_ascii_tform ffasfm
+#define fits_binary_tform ffbnfm
+#define fits_binary_tformll ffbnfmll
+#define fits_get_tbcol ffgabc
+#define fits_get_rowsize ffgrsz
+#define fits_get_col_display_width ffgcdw
+
+#define fits_write_record ffprec
+#define fits_write_key ffpky
+#define fits_write_key_unit ffpunt
+#define fits_write_comment ffpcom
+#define fits_write_history ffphis
+#define fits_write_date ffpdat
+#define fits_get_system_time ffgstm
+#define fits_get_system_date ffgsdt
+#define fits_date2str ffdt2s
+#define fits_time2str fftm2s
+#define fits_str2date ffs2dt
+#define fits_str2time ffs2tm
+#define fits_write_key_longstr ffpkls
+#define fits_write_key_longwarn ffplsw
+#define fits_write_key_null ffpkyu
+#define fits_write_key_str ffpkys
+#define fits_write_key_log ffpkyl
+#define fits_write_key_lng ffpkyj
+#define fits_write_key_fixflt ffpkyf
+#define fits_write_key_flt ffpkye
+#define fits_write_key_fixdbl ffpkyg
+#define fits_write_key_dbl ffpkyd
+#define fits_write_key_fixcmp ffpkfc
+#define fits_write_key_cmp ffpkyc
+#define fits_write_key_fixdblcmp ffpkfm
+#define fits_write_key_dblcmp ffpkym
+#define fits_write_key_triple ffpkyt
+#define fits_write_tdim ffptdm
+#define fits_write_tdimll ffptdmll
+#define fits_write_keys_str ffpkns
+#define fits_write_keys_log ffpknl
+#define fits_write_keys_lng ffpknj
+#define fits_write_keys_fixflt ffpknf
+#define fits_write_keys_flt ffpkne
+#define fits_write_keys_fixdbl ffpkng
+#define fits_write_keys_dbl ffpknd
+#define fits_copy_key ffcpky
+#define fits_write_imghdr ffphps
+#define fits_write_imghdrll ffphpsll
+#define fits_write_grphdr ffphpr
+#define fits_write_grphdrll ffphprll
+#define fits_write_atblhdr ffphtb
+#define fits_write_btblhdr ffphbn
+#define fits_write_exthdr ffphext
+#define fits_write_key_template ffpktp
+
+#define fits_get_hdrspace ffghsp
+#define fits_get_hdrpos ffghps
+#define fits_movabs_key ffmaky
+#define fits_movrel_key ffmrky
+#define fits_find_nextkey ffgnxk
+
+#define fits_read_record ffgrec
+#define fits_read_card ffgcrd
+#define fits_read_str ffgstr
+#define fits_read_key_unit ffgunt
+#define fits_read_keyn ffgkyn
+#define fits_read_key ffgky
+#define fits_read_keyword ffgkey
+#define fits_read_key_str ffgkys
+#define fits_read_key_log ffgkyl
+#define fits_read_key_lng ffgkyj
+#define fits_read_key_lnglng ffgkyjj
+#define fits_read_key_flt ffgkye
+#define fits_read_key_dbl ffgkyd
+#define fits_read_key_cmp ffgkyc
+#define fits_read_key_dblcmp ffgkym
+#define fits_read_key_triple ffgkyt
+#define fits_read_key_longstr ffgkls
+#define fits_free_memory fffree
+#define fits_read_tdim ffgtdm
+#define fits_read_tdimll ffgtdmll
+#define fits_decode_tdim ffdtdm
+#define fits_decode_tdimll ffdtdmll
+#define fits_read_keys_str ffgkns
+#define fits_read_keys_log ffgknl
+#define fits_read_keys_lng ffgknj
+#define fits_read_keys_lnglng ffgknjj
+#define fits_read_keys_flt ffgkne
+#define fits_read_keys_dbl ffgknd
+#define fits_read_imghdr ffghpr
+#define fits_read_imghdrll ffghprll
+#define fits_read_atblhdr ffghtb
+#define fits_read_btblhdr ffghbn
+#define fits_read_atblhdrll ffghtbll
+#define fits_read_btblhdrll ffghbnll
+#define fits_hdr2str ffhdr2str
+#define fits_convert_hdr2str ffcnvthdr2str
+
+#define fits_update_card ffucrd
+#define fits_update_key ffuky
+#define fits_update_key_null ffukyu
+#define fits_update_key_str ffukys
+#define fits_update_key_longstr ffukls
+#define fits_update_key_log ffukyl
+#define fits_update_key_lng ffukyj
+#define fits_update_key_fixflt ffukyf
+#define fits_update_key_flt ffukye
+#define fits_update_key_fixdbl ffukyg
+#define fits_update_key_dbl ffukyd
+#define fits_update_key_fixcmp ffukfc
+#define fits_update_key_cmp ffukyc
+#define fits_update_key_fixdblcmp ffukfm
+#define fits_update_key_dblcmp ffukym
+
+#define fits_modify_record ffmrec
+#define fits_modify_card ffmcrd
+#define fits_modify_name ffmnam
+#define fits_modify_comment ffmcom
+#define fits_modify_key_null ffmkyu
+#define fits_modify_key_str ffmkys
+#define fits_modify_key_longstr ffmkls
+#define fits_modify_key_log ffmkyl
+#define fits_modify_key_lng ffmkyj
+#define fits_modify_key_fixflt ffmkyf
+#define fits_modify_key_flt ffmkye
+#define fits_modify_key_fixdbl ffmkyg
+#define fits_modify_key_dbl ffmkyd
+#define fits_modify_key_fixcmp ffmkfc
+#define fits_modify_key_cmp ffmkyc
+#define fits_modify_key_fixdblcmp ffmkfm
+#define fits_modify_key_dblcmp ffmkym
+
+#define fits_insert_record ffirec
+#define fits_insert_card ffikey
+#define fits_insert_key_null ffikyu
+#define fits_insert_key_str ffikys
+#define fits_insert_key_longstr ffikls
+#define fits_insert_key_log ffikyl
+#define fits_insert_key_lng ffikyj
+#define fits_insert_key_fixflt ffikyf
+#define fits_insert_key_flt ffikye
+#define fits_insert_key_fixdbl ffikyg
+#define fits_insert_key_dbl ffikyd
+#define fits_insert_key_fixcmp ffikfc
+#define fits_insert_key_cmp ffikyc
+#define fits_insert_key_fixdblcmp ffikfm
+#define fits_insert_key_dblcmp ffikym
+
+#define fits_delete_key ffdkey
+#define fits_delete_str ffdstr
+#define fits_delete_record ffdrec
+#define fits_get_hdu_num ffghdn
+#define fits_get_hdu_type ffghdt
+#define fits_get_hduaddr ffghad
+#define fits_get_hduaddrll ffghadll
+#define fits_get_hduoff ffghof
+
+#define fits_get_img_param ffgipr
+#define fits_get_img_paramll ffgiprll
+
+#define fits_get_img_type ffgidt
+#define fits_get_img_equivtype ffgiet
+#define fits_get_img_dim ffgidm
+#define fits_get_img_size ffgisz
+#define fits_get_img_sizell ffgiszll
+
+#define fits_movabs_hdu ffmahd
+#define fits_movrel_hdu ffmrhd
+#define fits_movnam_hdu ffmnhd
+#define fits_get_num_hdus ffthdu
+#define fits_create_img ffcrim
+#define fits_create_imgll ffcrimll
+#define fits_create_tbl ffcrtb
+#define fits_create_hdu ffcrhd
+#define fits_insert_img ffiimg
+#define fits_insert_imgll ffiimgll
+#define fits_insert_atbl ffitab
+#define fits_insert_btbl ffibin
+#define fits_resize_img ffrsim
+#define fits_resize_imgll ffrsimll
+
+#define fits_delete_hdu ffdhdu
+#define fits_copy_hdu ffcopy
+#define fits_copy_file ffcpfl
+#define fits_copy_header ffcphd
+#define fits_copy_data ffcpdt
+#define fits_write_hdu ffwrhdu
+
+#define fits_set_hdustruc ffrdef
+#define fits_set_hdrsize ffhdef
+#define fits_write_theap ffpthp
+
+#define fits_encode_chksum ffesum
+#define fits_decode_chksum ffdsum
+#define fits_write_chksum ffpcks
+#define fits_update_chksum ffupck
+#define fits_verify_chksum ffvcks
+#define fits_get_chksum ffgcks
+
+#define fits_set_bscale ffpscl
+#define fits_set_tscale fftscl
+#define fits_set_imgnull ffpnul
+#define fits_set_btblnull fftnul
+#define fits_set_atblnull ffsnul
+
+#define fits_get_colnum ffgcno
+#define fits_get_colname ffgcnn
+#define fits_get_coltype ffgtcl
+#define fits_get_coltypell ffgtclll
+#define fits_get_eqcoltype ffeqty
+#define fits_get_eqcoltypell ffeqtyll
+#define fits_get_num_rows ffgnrw
+#define fits_get_num_rowsll ffgnrwll
+#define fits_get_num_cols ffgncl
+#define fits_get_acolparms ffgacl
+#define fits_get_bcolparms ffgbcl
+#define fits_get_bcolparmsll ffgbclll
+
+#define fits_iterate_data ffiter
+
+#define fits_read_grppar_byt ffggpb
+#define fits_read_grppar_sbyt ffggpsb
+#define fits_read_grppar_usht ffggpui
+#define fits_read_grppar_ulng ffggpuj
+#define fits_read_grppar_sht ffggpi
+#define fits_read_grppar_lng ffggpj
+#define fits_read_grppar_lnglng ffggpjj
+#define fits_read_grppar_int ffggpk
+#define fits_read_grppar_uint ffggpuk
+#define fits_read_grppar_flt ffggpe
+#define fits_read_grppar_dbl ffggpd
+
+#define fits_read_pix ffgpxv
+#define fits_read_pixll ffgpxvll
+#define fits_read_pixnull ffgpxf
+#define fits_read_pixnullll ffgpxfll
+#define fits_read_img ffgpv
+#define fits_read_imgnull ffgpf
+#define fits_read_img_byt ffgpvb
+#define fits_read_img_sbyt ffgpvsb
+#define fits_read_img_usht ffgpvui
+#define fits_read_img_ulng ffgpvuj
+#define fits_read_img_sht ffgpvi
+#define fits_read_img_lng ffgpvj
+#define fits_read_img_lnglng ffgpvjj
+#define fits_read_img_uint ffgpvuk
+#define fits_read_img_int ffgpvk
+#define fits_read_img_flt ffgpve
+#define fits_read_img_dbl ffgpvd
+
+#define fits_read_imgnull_byt ffgpfb
+#define fits_read_imgnull_sbyt ffgpfsb
+#define fits_read_imgnull_usht ffgpfui
+#define fits_read_imgnull_ulng ffgpfuj
+#define fits_read_imgnull_sht ffgpfi
+#define fits_read_imgnull_lng ffgpfj
+#define fits_read_imgnull_lnglng ffgpfjj
+#define fits_read_imgnull_uint ffgpfuk
+#define fits_read_imgnull_int ffgpfk
+#define fits_read_imgnull_flt ffgpfe
+#define fits_read_imgnull_dbl ffgpfd
+
+#define fits_read_2d_byt ffg2db
+#define fits_read_2d_sbyt ffg2dsb
+#define fits_read_2d_usht ffg2dui
+#define fits_read_2d_ulng ffg2duj
+#define fits_read_2d_sht ffg2di
+#define fits_read_2d_lng ffg2dj
+#define fits_read_2d_lnglng ffg2djj
+#define fits_read_2d_uint ffg2duk
+#define fits_read_2d_int ffg2dk
+#define fits_read_2d_flt ffg2de
+#define fits_read_2d_dbl ffg2dd
+
+#define fits_read_3d_byt ffg3db
+#define fits_read_3d_sbyt ffg3dsb
+#define fits_read_3d_usht ffg3dui
+#define fits_read_3d_ulng ffg3duj
+#define fits_read_3d_sht ffg3di
+#define fits_read_3d_lng ffg3dj
+#define fits_read_3d_lnglng ffg3djj
+#define fits_read_3d_uint ffg3duk
+#define fits_read_3d_int ffg3dk
+#define fits_read_3d_flt ffg3de
+#define fits_read_3d_dbl ffg3dd
+
+#define fits_read_subset ffgsv
+#define fits_read_subset_byt ffgsvb
+#define fits_read_subset_sbyt ffgsvsb
+#define fits_read_subset_usht ffgsvui
+#define fits_read_subset_ulng ffgsvuj
+#define fits_read_subset_sht ffgsvi
+#define fits_read_subset_lng ffgsvj
+#define fits_read_subset_lnglng ffgsvjj
+#define fits_read_subset_uint ffgsvuk
+#define fits_read_subset_int ffgsvk
+#define fits_read_subset_flt ffgsve
+#define fits_read_subset_dbl ffgsvd
+
+#define fits_read_subsetnull_byt ffgsfb
+#define fits_read_subsetnull_sbyt ffgsfsb
+#define fits_read_subsetnull_usht ffgsfui
+#define fits_read_subsetnull_ulng ffgsfuj
+#define fits_read_subsetnull_sht ffgsfi
+#define fits_read_subsetnull_lng ffgsfj
+#define fits_read_subsetnull_lnglng ffgsfjj
+#define fits_read_subsetnull_uint ffgsfuk
+#define fits_read_subsetnull_int ffgsfk
+#define fits_read_subsetnull_flt ffgsfe
+#define fits_read_subsetnull_dbl ffgsfd
+
+#define ffcpimg fits_copy_image_section
+#define fits_compress_img fits_comp_img
+#define fits_decompress_img fits_decomp_img
+
+#define fits_read_col ffgcv
+#define fits_read_colnull ffgcf
+#define fits_read_col_str ffgcvs
+#define fits_read_col_log ffgcvl
+#define fits_read_col_byt ffgcvb
+#define fits_read_col_sbyt ffgcvsb
+#define fits_read_col_usht ffgcvui
+#define fits_read_col_ulng ffgcvuj
+#define fits_read_col_sht ffgcvi
+#define fits_read_col_lng ffgcvj
+#define fits_read_col_lnglng ffgcvjj
+#define fits_read_col_uint ffgcvuk
+#define fits_read_col_int ffgcvk
+#define fits_read_col_flt ffgcve
+#define fits_read_col_dbl ffgcvd
+#define fits_read_col_cmp ffgcvc
+#define fits_read_col_dblcmp ffgcvm
+#define fits_read_col_bit ffgcx
+#define fits_read_col_bit_usht ffgcxui
+#define fits_read_col_bit_uint ffgcxuk
+
+#define fits_read_colnull_str ffgcfs
+#define fits_read_colnull_log ffgcfl
+#define fits_read_colnull_byt ffgcfb
+#define fits_read_colnull_sbyt ffgcfsb
+#define fits_read_colnull_usht ffgcfui
+#define fits_read_colnull_ulng ffgcfuj
+#define fits_read_colnull_sht ffgcfi
+#define fits_read_colnull_lng ffgcfj
+#define fits_read_colnull_lnglng ffgcfjj
+#define fits_read_colnull_uint ffgcfuk
+#define fits_read_colnull_int ffgcfk
+#define fits_read_colnull_flt ffgcfe
+#define fits_read_colnull_dbl ffgcfd
+#define fits_read_colnull_cmp ffgcfc
+#define fits_read_colnull_dblcmp ffgcfm
+
+#define fits_read_descript ffgdes
+#define fits_read_descriptll ffgdesll
+#define fits_read_descripts ffgdess
+#define fits_read_descriptsll ffgdessll
+#define fits_read_tblbytes ffgtbb
+
+#define fits_write_grppar_byt ffpgpb
+#define fits_write_grppar_sbyt ffpgpsb
+#define fits_write_grppar_usht ffpgpui
+#define fits_write_grppar_ulng ffpgpuj
+#define fits_write_grppar_sht ffpgpi
+#define fits_write_grppar_lng ffpgpj
+#define fits_write_grppar_lnglng ffpgpjj
+#define fits_write_grppar_uint ffpgpuk
+#define fits_write_grppar_int ffpgpk
+#define fits_write_grppar_flt ffpgpe
+#define fits_write_grppar_dbl ffpgpd
+
+#define fits_write_pix ffppx
+#define fits_write_pixll ffppxll
+#define fits_write_pixnull ffppxn
+#define fits_write_pixnullll ffppxnll
+#define fits_write_img ffppr
+#define fits_write_img_byt ffpprb
+#define fits_write_img_sbyt ffpprsb
+#define fits_write_img_usht ffpprui
+#define fits_write_img_ulng ffppruj
+#define fits_write_img_sht ffppri
+#define fits_write_img_lng ffpprj
+#define fits_write_img_lnglng ffpprjj
+#define fits_write_img_uint ffppruk
+#define fits_write_img_int ffpprk
+#define fits_write_img_flt ffppre
+#define fits_write_img_dbl ffpprd
+
+#define fits_write_imgnull ffppn
+#define fits_write_imgnull_byt ffppnb
+#define fits_write_imgnull_sbyt ffppnsb
+#define fits_write_imgnull_usht ffppnui
+#define fits_write_imgnull_ulng ffppnuj
+#define fits_write_imgnull_sht ffppni
+#define fits_write_imgnull_lng ffppnj
+#define fits_write_imgnull_lnglng ffppnjj
+#define fits_write_imgnull_uint ffppnuk
+#define fits_write_imgnull_int ffppnk
+#define fits_write_imgnull_flt ffppne
+#define fits_write_imgnull_dbl ffppnd
+
+#define fits_write_img_null ffppru
+#define fits_write_null_img ffpprn
+
+#define fits_write_2d_byt ffp2db
+#define fits_write_2d_sbyt ffp2dsb
+#define fits_write_2d_usht ffp2dui
+#define fits_write_2d_ulng ffp2duj
+#define fits_write_2d_sht ffp2di
+#define fits_write_2d_lng ffp2dj
+#define fits_write_2d_lnglng ffp2djj
+#define fits_write_2d_uint ffp2duk
+#define fits_write_2d_int ffp2dk
+#define fits_write_2d_flt ffp2de
+#define fits_write_2d_dbl ffp2dd
+
+#define fits_write_3d_byt ffp3db
+#define fits_write_3d_sbyt ffp3dsb
+#define fits_write_3d_usht ffp3dui
+#define fits_write_3d_ulng ffp3duj
+#define fits_write_3d_sht ffp3di
+#define fits_write_3d_lng ffp3dj
+#define fits_write_3d_lnglng ffp3djj
+#define fits_write_3d_uint ffp3duk
+#define fits_write_3d_int ffp3dk
+#define fits_write_3d_flt ffp3de
+#define fits_write_3d_dbl ffp3dd
+
+#define fits_write_subset ffpss
+#define fits_write_subset_byt ffpssb
+#define fits_write_subset_sbyt ffpsssb
+#define fits_write_subset_usht ffpssui
+#define fits_write_subset_ulng ffpssuj
+#define fits_write_subset_sht ffpssi
+#define fits_write_subset_lng ffpssj
+#define fits_write_subset_lnglng ffpssjj
+#define fits_write_subset_uint ffpssuk
+#define fits_write_subset_int ffpssk
+#define fits_write_subset_flt ffpsse
+#define fits_write_subset_dbl ffpssd
+
+#define fits_write_col ffpcl
+#define fits_write_col_str ffpcls
+#define fits_write_col_log ffpcll
+#define fits_write_col_byt ffpclb
+#define fits_write_col_sbyt ffpclsb
+#define fits_write_col_usht ffpclui
+#define fits_write_col_ulng ffpcluj
+#define fits_write_col_sht ffpcli
+#define fits_write_col_lng ffpclj
+#define fits_write_col_lnglng ffpcljj
+#define fits_write_col_uint ffpcluk
+#define fits_write_col_int ffpclk
+#define fits_write_col_flt ffpcle
+#define fits_write_col_dbl ffpcld
+#define fits_write_col_cmp ffpclc
+#define fits_write_col_dblcmp ffpclm
+#define fits_write_col_null ffpclu
+#define fits_write_col_bit ffpclx
+#define fits_write_nulrows ffprwu
+#define fits_write_nullrows ffprwu
+
+#define fits_write_colnull ffpcn
+#define fits_write_colnull_str ffpcns
+#define fits_write_colnull_log ffpcnl
+#define fits_write_colnull_byt ffpcnb
+#define fits_write_colnull_sbyt ffpcnsb
+#define fits_write_colnull_usht ffpcnui
+#define fits_write_colnull_ulng ffpcnuj
+#define fits_write_colnull_sht ffpcni
+#define fits_write_colnull_lng ffpcnj
+#define fits_write_colnull_lnglng ffpcnjj
+#define fits_write_colnull_uint ffpcnuk
+#define fits_write_colnull_int ffpcnk
+#define fits_write_colnull_flt ffpcne
+#define fits_write_colnull_dbl ffpcnd
+
+#define fits_write_ext ffpextn
+#define fits_read_ext ffgextn
+
+#define fits_write_descript ffpdes
+#define fits_compress_heap ffcmph
+#define fits_test_heap fftheap
+
+#define fits_write_tblbytes ffptbb
+#define fits_insert_rows ffirow
+#define fits_delete_rows ffdrow
+#define fits_delete_rowrange ffdrrg
+#define fits_delete_rowlist ffdrws
+#define fits_delete_rowlistll ffdrwsll
+#define fits_insert_col fficol
+#define fits_insert_cols fficls
+#define fits_delete_col ffdcol
+#define fits_copy_col ffcpcl
+#define fits_copy_rows ffcprw
+#define fits_modify_vector_len ffmvec
+
+#define fits_read_img_coord ffgics
+#define fits_read_img_coord_version ffgicsa
+#define fits_read_tbl_coord ffgtcs
+#define fits_pix_to_world ffwldp
+#define fits_world_to_pix ffxypx
+
+#define fits_get_image_wcs_keys ffgiwcs
+#define fits_get_table_wcs_keys ffgtwcs
+
+#define fits_find_rows fffrow
+#define fits_find_first_row ffffrw
+#define fits_find_rows_cmp fffrwc
+#define fits_select_rows ffsrow
+#define fits_calc_rows ffcrow
+#define fits_calculator ffcalc
+#define fits_calculator_rng ffcalc_rng
+#define fits_test_expr fftexp
+
+#define fits_create_group ffgtcr
+#define fits_insert_group ffgtis
+#define fits_change_group ffgtch
+#define fits_remove_group ffgtrm
+#define fits_copy_group ffgtcp
+#define fits_merge_groups ffgtmg
+#define fits_compact_group ffgtcm
+#define fits_verify_group ffgtvf
+#define fits_open_group ffgtop
+#define fits_add_group_member ffgtam
+#define fits_get_num_members ffgtnm
+
+#define fits_get_num_groups ffgmng
+#define fits_open_member ffgmop
+#define fits_copy_member ffgmcp
+#define fits_transfer_member ffgmtf
+#define fits_remove_member ffgmrm
+
+#endif
diff --git a/src/plugins/cfitsio/modkey.c b/src/plugins/cfitsio/modkey.c
new file mode 100644
index 0000000..e6fe03a
--- /dev/null
+++ b/src/plugins/cfitsio/modkey.c
@@ -0,0 +1,1706 @@
+/* This file, modkey.c, contains routines that modify, insert, or update */
+/* keywords in a FITS header. */
+
+/* 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>
+/* stddef.h is apparently needed to define size_t */
+#include <ctype.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+/*--------------------------------------------------------------------------*/
+int ffuky( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ const char *keyname, /* I - name of keyword to write */
+ void *value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Update the keyword, value and comment in the FITS header.
+ The datatype is specified by the 2nd argument.
+*/
+{
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (datatype == TSTRING)
+ {
+ ffukys(fptr, keyname, (char *) value, comm, status);
+ }
+ else if (datatype == TBYTE)
+ {
+ ffukyj(fptr, keyname, (LONGLONG) *(unsigned char *) value, comm, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffukyj(fptr, keyname, (LONGLONG) *(signed char *) value, comm, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffukyj(fptr, keyname, (LONGLONG) *(unsigned short *) value, comm, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffukyj(fptr, keyname, (LONGLONG) *(short *) value, comm, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffukyj(fptr, keyname, (LONGLONG) *(int *) value, comm, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffukyg(fptr, keyname, (double) *(unsigned int *) value, 0,
+ comm, status);
+ }
+ else if (datatype == TLOGICAL)
+ {
+ ffukyl(fptr, keyname, *(int *) value, comm, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffukyg(fptr, keyname, (double) *(unsigned long *) value, 0,
+ comm, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffukyj(fptr, keyname, (LONGLONG) *(long *) value, comm, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffukyj(fptr, keyname, *(LONGLONG *) value, comm, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffukye(fptr, keyname, *(float *) value, -7, comm, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffukyd(fptr, keyname, *(double *) value, -15, comm, status);
+ }
+ else if (datatype == TCOMPLEX)
+ {
+ ffukyc(fptr, keyname, (float *) value, -7, comm, status);
+ }
+ else if (datatype == TDBLCOMPLEX)
+ {
+ ffukym(fptr, keyname, (double *) value, -15, comm, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukyu(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkyu(fptr, keyname, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkyu(fptr, keyname, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukys(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkys(fptr, keyname, value, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkys(fptr, keyname, value, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukls(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ /* update a long string keyword */
+
+ int tstatus;
+ char junk[FLEN_ERRMSG];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkls(fptr, keyname, value, comm, status) == KEY_NO_EXIST)
+ {
+ /* since the ffmkls call failed, it wrote a bogus error message */
+ fits_read_errmsg(junk); /* clear the error message */
+
+ *status = tstatus;
+ ffpkls(fptr, keyname, value, comm, status);
+ }
+ return(*status);
+}/*--------------------------------------------------------------------------*/
+int ffukyl(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ int value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkyl(fptr, keyname, value, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkyl(fptr, keyname, value, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukyj(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ LONGLONG value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkyj(fptr, keyname, value, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkyj(fptr, keyname, value, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukyf(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkyf(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkyf(fptr, keyname, value, decim, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukye(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkye(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkye(fptr, keyname, value, decim, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukyg(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkyg(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkyg(fptr, keyname, value, decim, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukyd(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkyd(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkyd(fptr, keyname, value, decim, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukfc(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkfc(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkfc(fptr, keyname, value, decim, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukyc(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkyc(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkyc(fptr, keyname, value, decim, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukfm(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkfm(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkfm(fptr, keyname, value, decim, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffukym(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmkym(fptr, keyname, value, decim, comm, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffpkym(fptr, keyname, value, decim, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffucrd(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *card, /* I - card string value */
+ int *status) /* IO - error status */
+{
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = *status;
+
+ if (ffmcrd(fptr, keyname, card, status) == KEY_NO_EXIST)
+ {
+ *status = tstatus;
+ ffprec(fptr, card, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmrec(fitsfile *fptr, /* I - FITS file pointer */
+ int nkey, /* I - number of the keyword to modify */
+ char *card, /* I - card string value */
+ int *status) /* IO - error status */
+{
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffmaky(fptr, nkey+1, status);
+ ffmkey(fptr, card, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmcrd(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *card, /* I - card string value */
+ int *status) /* IO - error status */
+{
+ char tcard[FLEN_CARD], valstring[FLEN_CARD], comm[FLEN_CARD], value[FLEN_CARD];
+ int keypos, len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgcrd(fptr, keyname, tcard, status) > 0)
+ return(*status);
+
+ ffmkey(fptr, card, status);
+
+ /* calc position of keyword in header */
+ keypos = (int) ((((fptr->Fptr)->nextkey) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu])) / 80) + 1;
+
+ ffpsvc(tcard, valstring, comm, status);
+
+ /* check for string value which may be continued over multiple keywords */
+ ffc2s(valstring, value, status); /* remove quotes and trailing spaces */
+ len = strlen(value);
+
+ while (len && value[len - 1] == '&') /* ampersand used as continuation char */
+ {
+ ffgcnt(fptr, value, status);
+ if (*value)
+ {
+ ffdrec(fptr, keypos, status); /* delete the keyword */
+ len = strlen(value);
+ }
+ else /* a null valstring indicates no continuation */
+ len = 0;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmnam(fitsfile *fptr, /* I - FITS file pointer */
+ const char *oldname, /* I - existing keyword name */
+ const char *newname, /* I - new name for keyword */
+ int *status) /* IO - error status */
+{
+ char comm[FLEN_COMMENT];
+ char value[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, oldname, value, comm, status) > 0)
+ return(*status);
+
+ ffmkky(newname, value, comm, card, status); /* construct the card */
+ ffmkey(fptr, card, status); /* rewrite with new name */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmcom(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char oldcomm[FLEN_COMMENT];
+ char value[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, value, oldcomm, status) > 0)
+ return(*status);
+
+ ffmkky(keyname, value, comm, card, status); /* construct the card */
+ ffmkey(fptr, card, status); /* rewrite with new comment */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpunt(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *unit, /* I - keyword unit string */
+ int *status) /* IO - error status */
+/*
+ Write (put) the units string into the comment field of the existing
+ keyword. This routine uses a local FITS convention (not defined in the
+ official FITS standard) in which the units are enclosed in
+ square brackets following the '/' comment field delimiter, e.g.:
+
+ KEYWORD = 12 / [kpc] comment string goes here
+*/
+{
+ char oldcomm[FLEN_COMMENT];
+ char newcomm[FLEN_COMMENT];
+ char value[FLEN_VALUE];
+ char card[FLEN_CARD];
+ char *loc;
+ size_t len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, value, oldcomm, status) > 0)
+ return(*status);
+
+ /* copy the units string to the new comment string if not null */
+ if (*unit)
+ {
+ strcpy(newcomm, "[");
+ strncat(newcomm, unit, 45); /* max allowed length is about 45 chars */
+ strcat(newcomm, "] ");
+ len = strlen(newcomm);
+ len = FLEN_COMMENT - len - 1; /* amount of space left in the field */
+ }
+ else
+ {
+ newcomm[0] = '\0';
+ len = FLEN_COMMENT - 1;
+ }
+
+ if (oldcomm[0] == '[') /* check for existing units field */
+ {
+ loc = strchr(oldcomm, ']'); /* look for the closing bracket */
+ if (loc)
+ {
+ loc++;
+ while (*loc == ' ') /* skip any blank spaces */
+ loc++;
+
+ strncat(newcomm, loc, len); /* concat remainder of comment */
+ }
+ else
+ {
+ strncat(newcomm, oldcomm, len); /* append old comment onto new */
+ }
+ }
+ else
+ {
+ strncat(newcomm, oldcomm, len);
+ }
+
+ ffmkky(keyname, value, newcomm, card, status); /* construct the card */
+ ffmkey(fptr, card, status); /* rewrite with new units string */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkyu(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ strcpy(valstring," "); /* create a dummy value string */
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkys(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ /* NOTE: This routine does not support long continued strings */
+ /* It will correctly overwrite an existing long continued string, */
+ /* but it will not write a new long string. */
+
+ char oldval[FLEN_VALUE], valstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+ int len, keypos;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, oldval, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ ffs2c(value, valstring, status); /* convert value to a string */
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status); /* overwrite the previous keyword */
+
+ keypos = (int) (((((fptr->Fptr)->nextkey) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu])) / 80) + 1);
+
+ /* check if old string value was continued over multiple keywords */
+ ffc2s(oldval, valstring, status); /* remove quotes and trailing spaces */
+ len = strlen(valstring);
+
+ while (len && valstring[len - 1] == '&') /* ampersand is continuation char */
+ {
+ ffgcnt(fptr, valstring, status);
+ if (*valstring)
+ {
+ ffdrec(fptr, keypos, status); /* delete the continuation */
+ len = strlen(valstring);
+ }
+ else /* a null valstring indicates no continuation */
+ len = 0;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkls( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ char *value, /* I - keyword value */
+ char *incomm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Modify the value and optionally the comment of a long string keyword.
+ This routine supports the
+ HEASARC long string convention and can modify arbitrarily long string
+ keyword values. The value is continued over multiple keywords that
+ have the name COMTINUE without an equal sign in column 9 of the card.
+ This routine also supports simple string keywords which are less than
+ 69 characters in length.
+
+ This routine is not very efficient, so it should be used sparingly.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD], tmpkeyname[FLEN_CARD];
+ char comm[FLEN_COMMENT];
+ char tstring[FLEN_VALUE], *cptr;
+ char *longval;
+ int next, remain, vlen, nquote, nchar, namelen, contin, tstatus = -1;
+ int nkeys, keypos;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (!incomm || incomm[0] == '&') /* preserve the old comment string */
+ {
+ ffghps(fptr, &nkeys, &keypos, status); /* save current position */
+
+ if (ffgkls(fptr, keyname, &longval, comm, status) > 0)
+ return(*status); /* keyword doesn't exist */
+
+ free(longval); /* don't need the old value */
+
+ /* move back to previous position to ensure that we delete */
+ /* the right keyword in case there are more than one keyword */
+ /* with this same name. */
+ ffgrec(fptr, keypos - 1, card, status);
+ } else {
+ /* copy the input comment string */
+ strncpy(comm, incomm, FLEN_COMMENT-1);
+ comm[FLEN_COMMENT-1] = '\0';
+ }
+
+ /* delete the old keyword */
+ if (ffdkey(fptr, keyname, status) > 0)
+ return(*status); /* keyword doesn't exist */
+
+ ffghps(fptr, &nkeys, &keypos, status); /* save current position */
+
+ /* now construct the new keyword, and insert into header */
+ remain = strlen(value); /* number of characters to write out */
+ next = 0; /* pointer to next character to write */
+
+ /* count the number of single quote characters in the string */
+ nquote = 0;
+ cptr = strchr(value, '\''); /* search for quote character */
+
+ while (cptr) /* search for quote character */
+ {
+ nquote++; /* increment no. of quote characters */
+ cptr++; /* increment pointer to next character */
+ cptr = strchr(cptr, '\''); /* search for another quote char */
+ }
+
+ strncpy(tmpkeyname, keyname, 80);
+ tmpkeyname[80] = '\0';
+
+ cptr = tmpkeyname;
+ while(*cptr == ' ') /* skip over leading spaces in name */
+ cptr++;
+
+ /* determine the number of characters that will fit on the line */
+ /* Note: each quote character is expanded to 2 quotes */
+
+ namelen = strlen(cptr);
+ if (namelen <= 8 && (fftkey(cptr, &tstatus) <= 0) )
+ {
+ /* This a normal 8-character FITS keyword */
+ nchar = 68 - nquote; /* max of 68 chars fit in a FITS string value */
+ }
+ else
+ {
+ /* This a HIERARCH keyword */
+ if (FSTRNCMP(cptr, "HIERARCH ", 9) &&
+ FSTRNCMP(cptr, "hierarch ", 9))
+ nchar = 66 - nquote - namelen;
+ else
+ nchar = 75 - nquote - namelen; /* don't count 'HIERARCH' twice */
+
+ }
+
+ contin = 0;
+ while (remain > 0)
+ {
+ strncpy(tstring, &value[next], nchar); /* copy string to temp buff */
+ tstring[nchar] = '\0';
+ ffs2c(tstring, valstring, status); /* put quotes around the string */
+
+ if (remain > nchar) /* if string is continued, put & as last char */
+ {
+ vlen = strlen(valstring);
+ nchar -= 1; /* outputting one less character now */
+
+ if (valstring[vlen-2] != '\'')
+ valstring[vlen-2] = '&'; /* over write last char with & */
+ else
+ { /* last char was a pair of single quotes, so over write both */
+ valstring[vlen-3] = '&';
+ valstring[vlen-1] = '\0';
+ }
+ }
+
+ if (contin) /* This is a CONTINUEd keyword */
+ {
+ ffmkky("CONTINUE", valstring, comm, card, status); /* make keyword */
+ strncpy(&card[8], " ", 2); /* overwrite the '=' */
+ }
+ else
+ {
+ ffmkky(keyname, valstring, comm, card, status); /* make keyword */
+ }
+
+ ffirec(fptr, keypos, card, status); /* insert the keyword */
+
+ keypos++; /* next insert position */
+ contin = 1;
+ remain -= nchar;
+ next += nchar;
+ nchar = 68 - nquote;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkyl(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ int value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ ffl2c(value, valstring, status); /* convert value to a string */
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkyj(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ LONGLONG value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ ffi2c(value, valstring, status); /* convert value to a string */
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkyf(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ ffr2f(value, decim, valstring, status); /* convert value to a string */
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkye(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ ffr2e(value, decim, valstring, status); /* convert value to a string */
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkyg(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ ffd2f(value, decim, valstring, status); /* convert value to a string */
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkyd(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ ffd2e(value, decim, valstring, status); /* convert value to a string */
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkfc(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ strcpy(valstring, "(" );
+ ffr2f(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffr2f(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkyc(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ strcpy(valstring, "(" );
+ ffr2e(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffr2e(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkfm(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ strcpy(valstring, "(" );
+ ffd2f(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffd2f(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffmkym(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char oldcomm[FLEN_COMMENT];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, oldcomm, status) > 0)
+ return(*status); /* get old comment */
+
+ strcpy(valstring, "(" );
+ ffd2e(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffd2e(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ if (!comm || comm[0] == '&') /* preserve the current comment string */
+ ffmkky(keyname, valstring, oldcomm, card, status);
+ else
+ ffmkky(keyname, valstring, comm, card, status);
+
+ ffmkey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikyu(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Insert a null-valued keyword and comment into the FITS header.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ strcpy(valstring," "); /* create a dummy value string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikys(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ char *value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffs2c(value, valstring, status); /* put quotes around the string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikls( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ char *value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Insert a long string keyword. This routine supports the
+ HEASARC long string convention and can insert arbitrarily long string
+ keyword values. The value is continued over multiple keywords that
+ have the name COMTINUE without an equal sign in column 9 of the card.
+ This routine also supports simple string keywords which are less than
+ 69 characters in length.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD], tmpkeyname[FLEN_CARD];
+ char tstring[FLEN_VALUE], *cptr;
+ int next, remain, vlen, nquote, nchar, namelen, contin, tstatus = -1;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* construct the new keyword, and insert into header */
+ remain = strlen(value); /* number of characters to write out */
+ next = 0; /* pointer to next character to write */
+
+ /* count the number of single quote characters in the string */
+ nquote = 0;
+ cptr = strchr(value, '\''); /* search for quote character */
+
+ while (cptr) /* search for quote character */
+ {
+ nquote++; /* increment no. of quote characters */
+ cptr++; /* increment pointer to next character */
+ cptr = strchr(cptr, '\''); /* search for another quote char */
+ }
+
+
+ strncpy(tmpkeyname, keyname, 80);
+ tmpkeyname[80] = '\0';
+
+ cptr = tmpkeyname;
+ while(*cptr == ' ') /* skip over leading spaces in name */
+ cptr++;
+
+ /* determine the number of characters that will fit on the line */
+ /* Note: each quote character is expanded to 2 quotes */
+
+ namelen = strlen(cptr);
+ if (namelen <= 8 && (fftkey(cptr, &tstatus) <= 0) )
+ {
+ /* This a normal 8-character FITS keyword */
+ nchar = 68 - nquote; /* max of 68 chars fit in a FITS string value */
+ }
+ else
+ {
+ /* This a HIERARCH keyword */
+ if (FSTRNCMP(cptr, "HIERARCH ", 9) &&
+ FSTRNCMP(cptr, "hierarch ", 9))
+ nchar = 66 - nquote - namelen;
+ else
+ nchar = 75 - nquote - namelen; /* don't count 'HIERARCH' twice */
+
+ }
+
+ contin = 0;
+ while (remain > 0)
+ {
+ strncpy(tstring, &value[next], nchar); /* copy string to temp buff */
+ tstring[nchar] = '\0';
+ ffs2c(tstring, valstring, status); /* put quotes around the string */
+
+ if (remain > nchar) /* if string is continued, put & as last char */
+ {
+ vlen = strlen(valstring);
+ nchar -= 1; /* outputting one less character now */
+
+ if (valstring[vlen-2] != '\'')
+ valstring[vlen-2] = '&'; /* over write last char with & */
+ else
+ { /* last char was a pair of single quotes, so over write both */
+ valstring[vlen-3] = '&';
+ valstring[vlen-1] = '\0';
+ }
+ }
+
+ if (contin) /* This is a CONTINUEd keyword */
+ {
+ ffmkky("CONTINUE", valstring, comm, card, status); /* make keyword */
+ strncpy(&card[8], " ", 2); /* overwrite the '=' */
+ }
+ else
+ {
+ ffmkky(keyname, valstring, comm, card, status); /* make keyword */
+ }
+
+ ffikey(fptr, card, status); /* insert the keyword */
+
+ contin = 1;
+ remain -= nchar;
+ next += nchar;
+ nchar = 68 - nquote;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikyl(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ int value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffl2c(value, valstring, status); /* convert logical to 'T' or 'F' */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikyj(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ LONGLONG value, /* I - keyword value */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffi2c(value, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikyf(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffr2f(value, decim, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikye(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffr2e(value, decim, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikyg(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffd2f(value, decim, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikyd(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffd2e(value, decim, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikfc(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ strcpy(valstring, "(" );
+ ffr2f(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffr2f(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikyc(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ float *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ strcpy(valstring, "(" );
+ ffr2e(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffr2e(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikfm(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+
+ strcpy(valstring, "(" );
+ ffd2f(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffd2f(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikym(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ double *value, /* I - keyword value */
+ int decim, /* I - no of decimals */
+ char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ strcpy(valstring, "(" );
+ ffd2e(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffd2e(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffikey(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffirec(fitsfile *fptr, /* I - FITS file pointer */
+ int nkey, /* I - position to insert new keyword */
+ char *card, /* I - card string value */
+ int *status) /* IO - error status */
+{
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffmaky(fptr, nkey, status); /* move to insert position */
+ ffikey(fptr, card, status); /* insert the keyword card */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffikey(fitsfile *fptr, /* I - FITS file pointer */
+ char *card, /* I - card string value */
+ int *status) /* IO - error status */
+/*
+ insert a keyword at the position of (fptr->Fptr)->nextkey
+*/
+{
+ int ii, len, nshift;
+ long nblocks;
+ LONGLONG bytepos;
+ char *inbuff, *outbuff, *tmpbuff, buff1[FLEN_CARD], buff2[FLEN_CARD];
+
+ if (*status > 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);
+
+ if ( ((fptr->Fptr)->datastart - (fptr->Fptr)->headend) == 80) /* only room for END card */
+ {
+ nblocks = 1;
+ if (ffiblk(fptr, nblocks, 0, status) > 0) /* add new 2880-byte block*/
+ return(*status);
+ }
+
+ /* no. keywords to shift */
+ nshift= (int) (( (fptr->Fptr)->headend - (fptr->Fptr)->nextkey ) / 80);
+
+ strncpy(buff2, card, 80); /* copy card to output buffer */
+ buff2[80] = '\0';
+
+ len = strlen(buff2);
+
+ /* silently replace any illegal characters with a space */
+ for (ii=0; ii < len; ii++)
+ if (buff2[ii] < ' ' || buff2[ii] > 126) buff2[ii] = ' ';
+
+ for (ii=len; ii < 80; ii++) /* fill buffer with spaces if necessary */
+ buff2[ii] = ' ';
+
+ for (ii=0; ii < 8; ii++) /* make sure keyword name is uppercase */
+ buff2[ii] = toupper(buff2[ii]);
+
+ fftkey(buff2, status); /* test keyword name contains legal chars */
+
+/* no need to do this any more, since any illegal characters have been removed
+ fftrec(buff2, status); */ /* test rest of keyword for legal chars */
+
+ inbuff = buff1;
+ outbuff = buff2;
+
+ bytepos = (fptr->Fptr)->nextkey; /* pointer to next keyword in header */
+ ffmbyt(fptr, bytepos, REPORT_EOF, status);
+
+ for (ii = 0; ii < nshift; ii++) /* shift each keyword down one position */
+ {
+ ffgbyt(fptr, 80, inbuff, status); /* read the current keyword */
+
+ ffmbyt(fptr, bytepos, REPORT_EOF, status); /* move back */
+ ffpbyt(fptr, 80, outbuff, status); /* overwrite with other buffer */
+
+ tmpbuff = inbuff; /* swap input and output buffers */
+ inbuff = outbuff;
+ outbuff = tmpbuff;
+
+ bytepos += 80;
+ }
+
+ ffpbyt(fptr, 80, outbuff, status); /* write the final keyword */
+
+ (fptr->Fptr)->headend += 80; /* increment the position of the END keyword */
+ (fptr->Fptr)->nextkey += 80; /* increment the pointer to next keyword */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdkey(fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - keyword name */
+ int *status) /* IO - error status */
+/*
+ delete a specified header keyword
+*/
+{
+ int keypos, len;
+ char valstring[FLEN_VALUE], comm[FLEN_COMMENT], value[FLEN_VALUE];
+ char message[FLEN_ERRMSG];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgkey(fptr, keyname, valstring, comm, status) > 0) /* read keyword */
+ {
+ sprintf(message, "Could not find the %s keyword to delete (ffdkey)",
+ keyname);
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /* calc position of keyword in header */
+ keypos = (int) ((((fptr->Fptr)->nextkey) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu])) / 80);
+
+ ffdrec(fptr, keypos, status); /* delete the keyword */
+
+ /* check for string value which may be continued over multiple keywords */
+ ffc2s(valstring, value, status); /* remove quotes and trailing spaces */
+ len = strlen(value);
+
+ while (len && value[len - 1] == '&') /* ampersand used as continuation char */
+ {
+ ffgcnt(fptr, value, status);
+ if (*value)
+ {
+ ffdrec(fptr, keypos, status); /* delete the keyword */
+ len = strlen(value);
+ }
+ else /* a null valstring indicates no continuation */
+ len = 0;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffdstr(fitsfile *fptr, /* I - FITS file pointer */
+ const char *string, /* I - keyword name */
+ int *status) /* IO - error status */
+/*
+ delete a specified header keyword containing the input string
+*/
+{
+ int keypos, len;
+ char valstring[FLEN_VALUE], comm[FLEN_COMMENT], value[FLEN_VALUE];
+ char card[FLEN_CARD], message[FLEN_ERRMSG];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (ffgstr(fptr, string, card, status) > 0) /* read keyword */
+ {
+ sprintf(message, "Could not find the %s keyword to delete (ffdkey)",
+ string);
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /* calc position of keyword in header */
+ keypos = (int) ((((fptr->Fptr)->nextkey) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu])) / 80);
+
+ ffdrec(fptr, keypos, status); /* delete the keyword */
+
+ /* check for string value which may be continued over multiple keywords */
+ ffpsvc(card, valstring, comm, status);
+ ffc2s(valstring, value, status); /* remove quotes and trailing spaces */
+ len = strlen(value);
+
+ while (len && value[len - 1] == '&') /* ampersand used as continuation char */
+ {
+ ffgcnt(fptr, value, status);
+ if (*value)
+ {
+ ffdrec(fptr, keypos, status); /* delete the keyword */
+ len = strlen(value);
+ }
+ else /* a null valstring indicates no continuation */
+ len = 0;
+ }
+ return(*status);
+}/*--------------------------------------------------------------------------*/
+int ffdrec(fitsfile *fptr, /* I - FITS file pointer */
+ int keypos, /* I - position in header of keyword to delete */
+ int *status) /* IO - error status */
+/*
+ Delete a header keyword at position keypos. The 1st keyword is at keypos=1.
+*/
+{
+ int ii, nshift;
+ LONGLONG bytepos;
+ char *inbuff, *outbuff, *tmpbuff, buff1[81], buff2[81];
+ char message[FLEN_ERRMSG];
+
+ if (*status > 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);
+
+ if (keypos < 1 ||
+ keypos > (fptr->Fptr)->headend - (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] / 80 )
+ return(*status = KEY_OUT_BOUNDS);
+
+ (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] + (keypos - 1) * 80;
+
+ nshift=(int) (( (fptr->Fptr)->headend - (fptr->Fptr)->nextkey ) / 80); /* no. keywords to shift */
+
+ if (nshift <= 0)
+ {
+ sprintf(message, "Cannot delete keyword number %d. It does not exist.",
+ keypos);
+ ffpmsg(message);
+ return(*status = KEY_OUT_BOUNDS);
+ }
+
+ bytepos = (fptr->Fptr)->headend - 80; /* last keyword in header */
+
+ /* construct a blank keyword */
+ strcpy(buff2, " ");
+ strcat(buff2, " ");
+ inbuff = buff1;
+ outbuff = buff2;
+ for (ii = 0; ii < nshift; ii++) /* shift each keyword up one position */
+ {
+
+ ffmbyt(fptr, bytepos, REPORT_EOF, status);
+ ffgbyt(fptr, 80, inbuff, status); /* read the current keyword */
+
+ ffmbyt(fptr, bytepos, REPORT_EOF, status);
+ ffpbyt(fptr, 80, outbuff, status); /* overwrite with next keyword */
+
+ tmpbuff = inbuff; /* swap input and output buffers */
+ inbuff = outbuff;
+ outbuff = tmpbuff;
+
+ bytepos -= 80;
+ }
+
+ (fptr->Fptr)->headend -= 80; /* decrement the position of the END keyword */
+ return(*status);
+}
+
diff --git a/src/plugins/cfitsio/pliocomp.c b/src/plugins/cfitsio/pliocomp.c
new file mode 100644
index 0000000..682599f
--- /dev/null
+++ b/src/plugins/cfitsio/pliocomp.c
@@ -0,0 +1,331 @@
+/* stdlib is needed for the abs function */
+#include <stdlib.h>
+/*
+ The following prototype code was provided by Doug Tody, NRAO, for
+ performing conversion between pixel arrays and line lists. The
+ compression technique is used in IRAF.
+*/
+int pl_p2li (int *pxsrc, int xs, short *lldst, int npix);
+int pl_l2pi (short *ll_src, int xs, int *px_dst, int npix);
+
+
+/*
+ * PL_P2L -- Convert a pixel array to a line list. The length of the list is
+ * returned as the function value.
+ *
+ * Translated from the SPP version using xc -f, f2c. 8Sep99 DCT.
+ */
+
+#ifndef min
+#define min(a,b) (((a)<(b))?(a):(b))
+#endif
+#ifndef max
+#define max(a,b) (((a)>(b))?(a):(b))
+#endif
+
+int pl_p2li (int *pxsrc, int xs, short *lldst, int npix)
+/* int *pxsrc; input pixel array */
+/* int xs; starting index in pxsrc (?) */
+/* short *lldst; encoded line list */
+/* int npix; number of pixels to convert */
+{
+ /* System generated locals */
+ int ret_val, i__1, i__2, i__3;
+
+ /* Local variables */
+ int zero, v, x1, hi, ip, dv, xe, np, op, iz, nv, pv, nz;
+
+ /* Parameter adjustments */
+ --lldst;
+ --pxsrc;
+
+ /* Function Body */
+ if (! (npix <= 0)) {
+ goto L110;
+ }
+ ret_val = 0;
+ goto L100;
+L110:
+ lldst[3] = -100;
+ lldst[2] = 7;
+ lldst[1] = 0;
+ lldst[6] = 0;
+ lldst[7] = 0;
+ xe = xs + npix - 1;
+ op = 8;
+ zero = 0;
+/* Computing MAX */
+ i__1 = zero, i__2 = pxsrc[xs];
+ pv = max(i__1,i__2);
+ x1 = xs;
+ iz = xs;
+ hi = 1;
+ i__1 = xe;
+ for (ip = xs; ip <= i__1; ++ip) {
+ if (! (ip < xe)) {
+ goto L130;
+ }
+/* Computing MAX */
+ i__2 = zero, i__3 = pxsrc[ip + 1];
+ nv = max(i__2,i__3);
+ if (! (nv == pv)) {
+ goto L140;
+ }
+ goto L120;
+L140:
+ if (! (pv == 0)) {
+ goto L150;
+ }
+ pv = nv;
+ x1 = ip + 1;
+ goto L120;
+L150:
+ goto L131;
+L130:
+ if (! (pv == 0)) {
+ goto L160;
+ }
+ x1 = xe + 1;
+L160:
+L131:
+ np = ip - x1 + 1;
+ nz = x1 - iz;
+ if (! (pv > 0)) {
+ goto L170;
+ }
+ dv = pv - hi;
+ if (! (dv != 0)) {
+ goto L180;
+ }
+ hi = pv;
+ if (! (abs(dv) > 4095)) {
+ goto L190;
+ }
+ lldst[op] = (short) ((pv & 4095) + 4096);
+ ++op;
+ lldst[op] = (short) (pv / 4096);
+ ++op;
+ goto L191;
+L190:
+ if (! (dv < 0)) {
+ goto L200;
+ }
+ lldst[op] = (short) (-dv + 12288);
+ goto L201;
+L200:
+ lldst[op] = (short) (dv + 8192);
+L201:
+ ++op;
+ if (! (np == 1 && nz == 0)) {
+ goto L210;
+ }
+ v = lldst[op - 1];
+ lldst[op - 1] = (short) (v | 16384);
+ goto L91;
+L210:
+L191:
+L180:
+L170:
+ if (! (nz > 0)) {
+ goto L220;
+ }
+L230:
+ if (! (nz > 0)) {
+ goto L232;
+ }
+ lldst[op] = (short) min(4095,nz);
+ ++op;
+/* L231: */
+ nz += -4095;
+ goto L230;
+L232:
+ if (! (np == 1 && pv > 0)) {
+ goto L240;
+ }
+ lldst[op - 1] = (short) (lldst[op - 1] + 20481);
+ goto L91;
+L240:
+L220:
+L250:
+ if (! (np > 0)) {
+ goto L252;
+ }
+ lldst[op] = (short) (min(4095,np) + 16384);
+ ++op;
+/* L251: */
+ np += -4095;
+ goto L250;
+L252:
+L91:
+ x1 = ip + 1;
+ iz = x1;
+ pv = nv;
+L120:
+ ;
+ }
+/* L121: */
+ lldst[4] = (short) ((op - 1) % 32768);
+ lldst[5] = (short) ((op - 1) / 32768);
+ ret_val = op - 1;
+ goto L100;
+L100:
+ return ret_val;
+} /* plp2li_ */
+
+/*
+ * PL_L2PI -- Translate a PLIO line list into an integer pixel array.
+ * The number of pixels output (always npix) is returned as the function
+ * value.
+ *
+ * Translated from the SPP version using xc -f, f2c. 8Sep99 DCT.
+ */
+
+int pl_l2pi (short *ll_src, int xs, int *px_dst, int npix)
+/* short *ll_src; encoded line list */
+/* int xs; starting index in ll_src */
+/* int *px_dst; output pixel array */
+/* int npix; number of pixels to convert */
+{
+ /* System generated locals */
+ int ret_val, i__1, i__2;
+
+ /* Local variables */
+ int data, sw0001, otop, i__, lllen, i1, i2, x1, x2, ip, xe, np,
+ op, pv, opcode, llfirt;
+ int skipwd;
+
+ /* Parameter adjustments */
+ --px_dst;
+ --ll_src;
+
+ /* Function Body */
+ if (! (ll_src[3] > 0)) {
+ goto L110;
+ }
+ lllen = ll_src[3];
+ llfirt = 4;
+ goto L111;
+L110:
+ lllen = (ll_src[5] << 15) + ll_src[4];
+ llfirt = ll_src[2] + 1;
+L111:
+ if (! (npix <= 0 || lllen <= 0)) {
+ goto L120;
+ }
+ ret_val = 0;
+ goto L100;
+L120:
+ xe = xs + npix - 1;
+ skipwd = 0;
+ op = 1;
+ x1 = 1;
+ pv = 1;
+ i__1 = lllen;
+ for (ip = llfirt; ip <= i__1; ++ip) {
+ if (! skipwd) {
+ goto L140;
+ }
+ skipwd = 0;
+ goto L130;
+L140:
+ opcode = ll_src[ip] / 4096;
+ data = ll_src[ip] & 4095;
+ sw0001 = opcode;
+ goto L150;
+L160:
+ x2 = x1 + data - 1;
+ i1 = max(x1,xs);
+ i2 = min(x2,xe);
+ np = i2 - i1 + 1;
+ if (! (np > 0)) {
+ goto L170;
+ }
+ otop = op + np - 1;
+ if (! (opcode == 4)) {
+ goto L180;
+ }
+ i__2 = otop;
+ for (i__ = op; i__ <= i__2; ++i__) {
+ px_dst[i__] = pv;
+/* L190: */
+ }
+/* L191: */
+ goto L181;
+L180:
+ i__2 = otop;
+ for (i__ = op; i__ <= i__2; ++i__) {
+ px_dst[i__] = 0;
+/* L200: */
+ }
+/* L201: */
+ if (! (opcode == 5 && i2 == x2)) {
+ goto L210;
+ }
+ px_dst[otop] = pv;
+L210:
+L181:
+ op = otop + 1;
+L170:
+ x1 = x2 + 1;
+ goto L151;
+L220:
+ pv = (ll_src[ip + 1] << 12) + data;
+ skipwd = 1;
+ goto L151;
+L230:
+ pv += data;
+ goto L151;
+L240:
+ pv -= data;
+ goto L151;
+L250:
+ pv += data;
+ goto L91;
+L260:
+ pv -= data;
+L91:
+ if (! (x1 >= xs && x1 <= xe)) {
+ goto L270;
+ }
+ px_dst[op] = pv;
+ ++op;
+L270:
+ ++x1;
+ goto L151;
+L150:
+ ++sw0001;
+ if (sw0001 < 1 || sw0001 > 8) {
+ goto L151;
+ }
+ switch ((int)sw0001) {
+ case 1: goto L160;
+ case 2: goto L220;
+ case 3: goto L230;
+ case 4: goto L240;
+ case 5: goto L160;
+ case 6: goto L160;
+ case 7: goto L250;
+ case 8: goto L260;
+ }
+L151:
+ if (! (x1 > xe)) {
+ goto L280;
+ }
+ goto L131;
+L280:
+L130:
+ ;
+ }
+L131:
+ i__1 = npix;
+ for (i__ = op; i__ <= i__1; ++i__) {
+ px_dst[i__] = 0;
+/* L290: */
+ }
+/* L291: */
+ ret_val = npix;
+ goto L100;
+L100:
+ return ret_val;
+} /* pll2pi_ */
+
diff --git a/src/plugins/cfitsio/putcol.c b/src/plugins/cfitsio/putcol.c
new file mode 100644
index 0000000..0bfc927
--- /dev/null
+++ b/src/plugins/cfitsio/putcol.c
@@ -0,0 +1,1929 @@
+/* This file, putcol.c, contains routines that write data elements to */
+/* a FITS image or table. These are the generic routines. */
+
+/* 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 <limits.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffppx( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ long *firstpix, /* I - coord of first pixel to write(1 based) */
+ LONGLONG nelem, /* I - number of values to write */
+ void *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of pixels to the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+
+ This routine is simillar to ffppr, except it supports writing to
+ large images with more than 2**31 pixels.
+*/
+{
+ int naxis, ii;
+ long group = 1;
+ LONGLONG firstelem, dimsize = 1, naxes[9];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+ ffgiszll(fptr, 9, naxes, status);
+
+ firstelem = 0;
+ for (ii=0; ii < naxis; ii++)
+ {
+ firstelem += ((firstpix[ii] - 1) * dimsize);
+ dimsize *= naxes[ii];
+ }
+ firstelem++;
+
+ if (datatype == TBYTE)
+ {
+ ffpprb(fptr, group, firstelem, nelem, (unsigned char *) array, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffpprsb(fptr, group, firstelem, nelem, (signed char *) array, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffpprui(fptr, group, firstelem, nelem, (unsigned short *) array,
+ status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffppri(fptr, group, firstelem, nelem, (short *) array, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffppruk(fptr, group, firstelem, nelem, (unsigned int *) array, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffpprk(fptr, group, firstelem, nelem, (int *) array, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffppruj(fptr, group, firstelem, nelem, (unsigned long *) array, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffpprj(fptr, group, firstelem, nelem, (long *) array, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffpprjj(fptr, group, firstelem, nelem, (LONGLONG *) array, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffppre(fptr, group, firstelem, nelem, (float *) array, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffpprd(fptr, group, firstelem, nelem, (double *) array, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppxll( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ LONGLONG *firstpix, /* I - coord of first pixel to write(1 based) */
+ LONGLONG nelem, /* I - number of values to write */
+ void *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of pixels to the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+
+ This routine is simillar to ffppr, except it supports writing to
+ large images with more than 2**31 pixels.
+*/
+{
+ int naxis, ii;
+ long group = 1;
+ LONGLONG firstelem, dimsize = 1, naxes[9];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+ ffgiszll(fptr, 9, naxes, status);
+
+ firstelem = 0;
+ for (ii=0; ii < naxis; ii++)
+ {
+ firstelem += ((firstpix[ii] - 1) * dimsize);
+ dimsize *= naxes[ii];
+ }
+ firstelem++;
+
+ if (datatype == TBYTE)
+ {
+ ffpprb(fptr, group, firstelem, nelem, (unsigned char *) array, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffpprsb(fptr, group, firstelem, nelem, (signed char *) array, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffpprui(fptr, group, firstelem, nelem, (unsigned short *) array,
+ status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffppri(fptr, group, firstelem, nelem, (short *) array, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffppruk(fptr, group, firstelem, nelem, (unsigned int *) array, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffpprk(fptr, group, firstelem, nelem, (int *) array, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffppruj(fptr, group, firstelem, nelem, (unsigned long *) array, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffpprj(fptr, group, firstelem, nelem, (long *) array, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffpprjj(fptr, group, firstelem, nelem, (LONGLONG *) array, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffppre(fptr, group, firstelem, nelem, (float *) array, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffpprd(fptr, group, firstelem, nelem, (double *) array, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppxn( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ long *firstpix, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ void *array, /* I - array of values that are written */
+ void *nulval, /* I - pointer to the null value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+
+ This routine supports writing to large images with
+ more than 2**31 pixels.
+*/
+{
+ int naxis, ii;
+ long group = 1;
+ LONGLONG firstelem, dimsize = 1, naxes[9];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (nulval == NULL) /* null value not defined? */
+ {
+ ffppx(fptr, datatype, firstpix, nelem, array, status);
+ return(*status);
+ }
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+ ffgiszll(fptr, 9, naxes, status);
+
+ firstelem = 0;
+ for (ii=0; ii < naxis; ii++)
+ {
+ firstelem += ((firstpix[ii] - 1) * dimsize);
+ dimsize *= naxes[ii];
+ }
+ firstelem++;
+
+ if (datatype == TBYTE)
+ {
+ ffppnb(fptr, group, firstelem, nelem, (unsigned char *) array,
+ *(unsigned char *) nulval, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffppnsb(fptr, group, firstelem, nelem, (signed char *) array,
+ *(signed char *) nulval, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffppnui(fptr, group, firstelem, nelem, (unsigned short *) array,
+ *(unsigned short *) nulval,status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffppni(fptr, group, firstelem, nelem, (short *) array,
+ *(short *) nulval, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffppnuk(fptr, group, firstelem, nelem, (unsigned int *) array,
+ *(unsigned int *) nulval, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffppnk(fptr, group, firstelem, nelem, (int *) array,
+ *(int *) nulval, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffppnuj(fptr, group, firstelem, nelem, (unsigned long *) array,
+ *(unsigned long *) nulval,status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffppnj(fptr, group, firstelem, nelem, (long *) array,
+ *(long *) nulval, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffppnjj(fptr, group, firstelem, nelem, (LONGLONG *) array,
+ *(LONGLONG *) nulval, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffppne(fptr, group, firstelem, nelem, (float *) array,
+ *(float *) nulval, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffppnd(fptr, group, firstelem, nelem, (double *) array,
+ *(double *) nulval, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppxnll( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ LONGLONG *firstpix, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ void *array, /* I - array of values that are written */
+ void *nulval, /* I - pointer to the null value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+
+ This routine supports writing to large images with
+ more than 2**31 pixels.
+*/
+{
+ int naxis, ii;
+ long group = 1;
+ LONGLONG firstelem, dimsize = 1, naxes[9];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (nulval == NULL) /* null value not defined? */
+ {
+ ffppxll(fptr, datatype, firstpix, nelem, array, status);
+ return(*status);
+ }
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+ ffgiszll(fptr, 9, naxes, status);
+
+ firstelem = 0;
+ for (ii=0; ii < naxis; ii++)
+ {
+ firstelem += ((firstpix[ii] - 1) * dimsize);
+ dimsize *= naxes[ii];
+ }
+ firstelem++;
+
+ if (datatype == TBYTE)
+ {
+ ffppnb(fptr, group, firstelem, nelem, (unsigned char *) array,
+ *(unsigned char *) nulval, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffppnsb(fptr, group, firstelem, nelem, (signed char *) array,
+ *(signed char *) nulval, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffppnui(fptr, group, firstelem, nelem, (unsigned short *) array,
+ *(unsigned short *) nulval,status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffppni(fptr, group, firstelem, nelem, (short *) array,
+ *(short *) nulval, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffppnuk(fptr, group, firstelem, nelem, (unsigned int *) array,
+ *(unsigned int *) nulval, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffppnk(fptr, group, firstelem, nelem, (int *) array,
+ *(int *) nulval, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffppnuj(fptr, group, firstelem, nelem, (unsigned long *) array,
+ *(unsigned long *) nulval,status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffppnj(fptr, group, firstelem, nelem, (long *) array,
+ *(long *) nulval, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffppnjj(fptr, group, firstelem, nelem, (LONGLONG *) array,
+ *(LONGLONG *) nulval, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffppne(fptr, group, firstelem, nelem, (float *) array,
+ *(float *) nulval, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffppnd(fptr, group, firstelem, nelem, (double *) array,
+ *(double *) nulval, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppr( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ void *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+
+*/
+{
+ long group = 1;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (datatype == TBYTE)
+ {
+ ffpprb(fptr, group, firstelem, nelem, (unsigned char *) array, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffpprsb(fptr, group, firstelem, nelem, (signed char *) array, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffpprui(fptr, group, firstelem, nelem, (unsigned short *) array,
+ status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffppri(fptr, group, firstelem, nelem, (short *) array, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffppruk(fptr, group, firstelem, nelem, (unsigned int *) array, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffpprk(fptr, group, firstelem, nelem, (int *) array, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffppruj(fptr, group, firstelem, nelem, (unsigned long *) array, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffpprj(fptr, group, firstelem, nelem, (long *) array, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffpprjj(fptr, group, firstelem, nelem, (LONGLONG *) array, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffppre(fptr, group, firstelem, nelem, (float *) array, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffpprd(fptr, group, firstelem, nelem, (double *) array, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppn( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ void *array, /* I - array of values that are written */
+ void *nulval, /* I - pointer to the null value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+
+*/
+{
+ long group = 1;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (nulval == NULL) /* null value not defined? */
+ {
+ ffppr(fptr, datatype, firstelem, nelem, array, status);
+ return(*status);
+ }
+
+ if (datatype == TBYTE)
+ {
+ ffppnb(fptr, group, firstelem, nelem, (unsigned char *) array,
+ *(unsigned char *) nulval, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffppnsb(fptr, group, firstelem, nelem, (signed char *) array,
+ *(signed char *) nulval, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffppnui(fptr, group, firstelem, nelem, (unsigned short *) array,
+ *(unsigned short *) nulval,status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffppni(fptr, group, firstelem, nelem, (short *) array,
+ *(short *) nulval, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffppnuk(fptr, group, firstelem, nelem, (unsigned int *) array,
+ *(unsigned int *) nulval, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffppnk(fptr, group, firstelem, nelem, (int *) array,
+ *(int *) nulval, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffppnuj(fptr, group, firstelem, nelem, (unsigned long *) array,
+ *(unsigned long *) nulval,status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffppnj(fptr, group, firstelem, nelem, (long *) array,
+ *(long *) nulval, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffppnjj(fptr, group, firstelem, nelem, (LONGLONG *) array,
+ *(LONGLONG *) nulval, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffppne(fptr, group, firstelem, nelem, (float *) array,
+ *(float *) nulval, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffppnd(fptr, group, firstelem, nelem, (double *) array,
+ *(double *) nulval, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpss( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ long *blc, /* I - 'bottom left corner' of the subsection */
+ long *trc , /* I - 'top right corner' of the subsection */
+ void *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write a section of values to the primary array. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+
+ This routine supports writing to large images with
+ more than 2**31 pixels.
+*/
+{
+ int naxis;
+ long naxes[9];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* get the size of the image */
+ ffgidm(fptr, &naxis, status);
+ ffgisz(fptr, 9, naxes, status);
+
+ if (datatype == TBYTE)
+ {
+ ffpssb(fptr, 1, naxis, naxes, blc, trc,
+ (unsigned char *) array, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffpsssb(fptr, 1, naxis, naxes, blc, trc,
+ (signed char *) array, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffpssui(fptr, 1, naxis, naxes, blc, trc,
+ (unsigned short *) array, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffpssi(fptr, 1, naxis, naxes, blc, trc,
+ (short *) array, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffpssuk(fptr, 1, naxis, naxes, blc, trc,
+ (unsigned int *) array, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffpssk(fptr, 1, naxis, naxes, blc, trc,
+ (int *) array, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffpssuj(fptr, 1, naxis, naxes, blc, trc,
+ (unsigned long *) array, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffpssj(fptr, 1, naxis, naxes, blc, trc,
+ (long *) array, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffpssjj(fptr, 1, naxis, naxes, blc, trc,
+ (LONGLONG *) array, status);
+ } else if (datatype == TFLOAT)
+ {
+ ffpsse(fptr, 1, naxis, naxes, blc, trc,
+ (float *) array, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffpssd(fptr, 1, naxis, naxes, blc, trc,
+ (double *) array, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcl( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of elements to write */
+ void *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a table column. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS column is not the same as the array being written).
+
+*/
+{
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (datatype == TBIT)
+ {
+ ffpclx(fptr, colnum, firstrow, (long) firstelem, (long) nelem, (char *) array,
+ status);
+ }
+ else if (datatype == TBYTE)
+ {
+ ffpclb(fptr, colnum, firstrow, firstelem, nelem, (unsigned char *) array,
+ status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffpclsb(fptr, colnum, firstrow, firstelem, nelem, (signed char *) array,
+ status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffpclui(fptr, colnum, firstrow, firstelem, nelem,
+ (unsigned short *) array, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffpcli(fptr, colnum, firstrow, firstelem, nelem, (short *) array,
+ status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffpcluk(fptr, colnum, firstrow, firstelem, nelem, (unsigned int *) array,
+ status);
+ }
+ else if (datatype == TINT)
+ {
+ ffpclk(fptr, colnum, firstrow, firstelem, nelem, (int *) array,
+ status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffpcluj(fptr, colnum, firstrow, firstelem, nelem, (unsigned long *) array,
+ status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffpclj(fptr, colnum, firstrow, firstelem, nelem, (long *) array,
+ status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffpcljj(fptr, colnum, firstrow, firstelem, nelem, (LONGLONG *) array,
+ status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffpcle(fptr, colnum, firstrow, firstelem, nelem, (float *) array,
+ status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffpcld(fptr, colnum, firstrow, firstelem, nelem, (double *) array,
+ status);
+ }
+ else if (datatype == TCOMPLEX)
+ {
+ ffpcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ (float *) array, status);
+ }
+ else if (datatype == TDBLCOMPLEX)
+ {
+ ffpcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ (double *) array, status);
+ }
+ else if (datatype == TLOGICAL)
+ {
+ ffpcll(fptr, colnum, firstrow, firstelem, nelem, (char *) array,
+ status);
+ }
+ else if (datatype == TSTRING)
+ {
+ ffpcls(fptr, colnum, firstrow, firstelem, nelem, (char **) array,
+ status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcn( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of elements to write */
+ void *array, /* I - array of values that are written */
+ void *nulval, /* I - pointer to the null value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a table column. The datatype of the
+ input array is defined by the 2nd argument. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS column is not the same as the array being written).
+
+*/
+{
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (nulval == NULL) /* null value not defined? */
+ {
+ ffpcl(fptr, datatype, colnum, firstrow, firstelem, nelem, array,
+ status);
+ return(*status);
+ }
+
+ if (datatype == TBYTE)
+ {
+ ffpcnb(fptr, colnum, firstrow, firstelem, nelem, (unsigned char *) array,
+ *(unsigned char *) nulval, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffpcnsb(fptr, colnum, firstrow, firstelem, nelem, (signed char *) array,
+ *(signed char *) nulval, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffpcnui(fptr, colnum, firstrow, firstelem, nelem, (unsigned short *) array,
+ *(unsigned short *) nulval, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffpcni(fptr, colnum, firstrow, firstelem, nelem, (short *) array,
+ *(unsigned short *) nulval, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffpcnuk(fptr, colnum, firstrow, firstelem, nelem, (unsigned int *) array,
+ *(unsigned int *) nulval, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffpcnk(fptr, colnum, firstrow, firstelem, nelem, (int *) array,
+ *(int *) nulval, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffpcnuj(fptr, colnum, firstrow, firstelem, nelem, (unsigned long *) array,
+ *(unsigned long *) nulval, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffpcnj(fptr, colnum, firstrow, firstelem, nelem, (long *) array,
+ *(long *) nulval, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffpcnjj(fptr, colnum, firstrow, firstelem, nelem, (LONGLONG *) array,
+ *(LONGLONG *) nulval, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffpcne(fptr, colnum, firstrow, firstelem, nelem, (float *) array,
+ *(float *) nulval, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffpcnd(fptr, colnum, firstrow, firstelem, nelem, (double *) array,
+ *(double *) nulval, status);
+ }
+ else if (datatype == TCOMPLEX)
+ {
+ ffpcne(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ (float *) array, *(float *) nulval, status);
+ }
+ else if (datatype == TDBLCOMPLEX)
+ {
+ ffpcnd(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
+ (double *) array, *(double *) nulval, status);
+ }
+ else if (datatype == TLOGICAL)
+ {
+ ffpcnl(fptr, colnum, firstrow, firstelem, nelem, (char *) array,
+ *(char *) nulval, status);
+ }
+ else if (datatype == TSTRING)
+ {
+ ffpcns(fptr, colnum, firstrow, firstelem, nelem, (char **) array,
+ (char *) nulval, status);
+ }
+ else
+ *status = BAD_DATATYPE;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_set_by_name(iteratorCol *col, /* I - iterator col structure */
+ fitsfile *fptr, /* I - FITS file pointer */
+ char *colname, /* I - column name */
+ int datatype, /* I - column datatype */
+ int iotype) /* I - InputCol, InputOutputCol, or OutputCol */
+/*
+ set all the parameters for an iterator column, by column name
+*/
+{
+ col->fptr = fptr;
+ strcpy(col->colname, colname);
+ col->colnum = 0; /* set column number undefined since name is given */
+ col->datatype = datatype;
+ col->iotype = iotype;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_set_by_num(iteratorCol *col, /* I - iterator column structure */
+ fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ int datatype, /* I - column datatype */
+ int iotype) /* I - InputCol, InputOutputCol, or OutputCol */
+/*
+ set all the parameters for an iterator column, by column number
+*/
+{
+ col->fptr = fptr;
+ col->colnum = colnum;
+ col->datatype = datatype;
+ col->iotype = iotype;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_set_file(iteratorCol *col, /* I - iterator column structure */
+ fitsfile *fptr) /* I - FITS file pointer */
+/*
+ set iterator column parameter
+*/
+{
+ col->fptr = fptr;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_set_colname(iteratorCol *col, /* I - iterator col structure */
+ char *colname) /* I - column name */
+/*
+ set iterator column parameter
+*/
+{
+ strcpy(col->colname, colname);
+ col->colnum = 0; /* set column number undefined since name is given */
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_set_colnum(iteratorCol *col, /* I - iterator column structure */
+ int colnum) /* I - column number */
+/*
+ set iterator column parameter
+*/
+{
+ col->colnum = colnum;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_set_datatype(iteratorCol *col, /* I - iterator col structure */
+ int datatype) /* I - column datatype */
+/*
+ set iterator column parameter
+*/
+{
+ col->datatype = datatype;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_set_iotype(iteratorCol *col, /* I - iterator column structure */
+ int iotype) /* I - InputCol, InputOutputCol, or OutputCol */
+/*
+ set iterator column parameter
+*/
+{
+ col->iotype = iotype;
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+fitsfile * fits_iter_get_file(iteratorCol *col) /* I -iterator col structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->fptr);
+}
+/*--------------------------------------------------------------------------*/
+char * fits_iter_get_colname(iteratorCol *col) /* I -iterator col structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->colname);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_get_colnum(iteratorCol *col) /* I - iterator column structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->colnum);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_get_datatype(iteratorCol *col) /* I - iterator col structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->datatype);
+}
+/*--------------------------------------------------------------------------*/
+int fits_iter_get_iotype(iteratorCol *col) /* I - iterator column structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->iotype);
+}
+/*--------------------------------------------------------------------------*/
+void * fits_iter_get_array(iteratorCol *col) /* I - iterator col structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->array);
+}
+/*--------------------------------------------------------------------------*/
+long fits_iter_get_tlmin(iteratorCol *col) /* I - iterator column structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->tlmin);
+}
+/*--------------------------------------------------------------------------*/
+long fits_iter_get_tlmax(iteratorCol *col) /* I - iterator column structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->tlmax);
+}
+/*--------------------------------------------------------------------------*/
+long fits_iter_get_repeat(iteratorCol *col) /* I - iterator col structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->repeat);
+}
+/*--------------------------------------------------------------------------*/
+char * fits_iter_get_tunit(iteratorCol *col) /* I - iterator col structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->tunit);
+}
+/*--------------------------------------------------------------------------*/
+char * fits_iter_get_tdisp(iteratorCol *col) /* I -iterator col structure */
+/*
+ get iterator column parameter
+*/
+{
+ return(col->tdisp);
+}
+/*--------------------------------------------------------------------------*/
+int ffiter(int n_cols,
+ iteratorCol *cols,
+ long offset,
+ long n_per_loop,
+ int (*work_fn)(long total_n,
+ long offset,
+ long first_n,
+ long n_values,
+ int n_cols,
+ iteratorCol *cols,
+ void *userPointer),
+ void *userPointer,
+ int *status)
+/*
+ The iterator function. This function will pass the specified
+ columns from a FITS table or pixels from a FITS image to the
+ user-supplied function. Depending on the size of the table
+ or image, only a subset of the rows or pixels may be passed to the
+ function on each call, in which case the function will be called
+ multiple times until all the rows or pixels have been processed.
+*/
+{
+ typedef struct /* structure to store the column null value */
+ {
+ int nullsize; /* length of the null value, in bytes */
+ union { /* default null value for the column */
+ char *stringnull;
+ unsigned char charnull;
+ signed char scharnull;
+ int intnull;
+ short shortnull;
+ long longnull;
+ unsigned int uintnull;
+ unsigned short ushortnull;
+ unsigned long ulongnull;
+ float floatnull;
+ double doublenull;
+ LONGLONG longlongnull;
+ } null;
+ } colNulls;
+
+ void *dataptr, *defaultnull;
+ colNulls *col;
+ int ii, jj, tstatus, naxis, bitpix;
+ int typecode, hdutype, jtype, type, anynul, nfiles, nbytes;
+ long totaln, nleft, frow, felement, n_optimum, i_optimum, ntodo;
+ long rept, rowrept, width, tnull, naxes[9] = {1,1,1,1,1,1,1,1,1}, groups;
+ double zeros = 0.;
+ char message[FLEN_ERRMSG], keyname[FLEN_KEYWORD], nullstr[FLEN_VALUE];
+ char **stringptr, *nullptr, *cptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (n_cols < 0 || n_cols > 999 )
+ {
+ ffpmsg("Illegal number of columms (ffiter)");
+ return(*status = BAD_COL_NUM); /* negative number of columns */
+ }
+
+ /*------------------------------------------------------------*/
+ /* Make sure column numbers and datatypes are in legal range */
+ /* and column numbers and datatypes are legal. */
+ /* Also fill in other parameters in the column structure. */
+ /*------------------------------------------------------------*/
+
+ ffghdt(cols[0].fptr, &hdutype, status); /* type of first HDU */
+
+ for (jj = 0; jj < n_cols; jj++)
+ {
+ /* check that output datatype code value is legal */
+ type = cols[jj].datatype;
+
+ /* Allow variable length arrays for InputCol and InputOutputCol columns,
+ but not for OutputCol columns. Variable length arrays have a
+ negative type code value. */
+
+ if ((cols[jj].iotype != OutputCol) && (type<0)) {
+ type*=-1;
+ }
+
+ if (type != 0 && type != TBYTE &&
+ type != TSBYTE && type != TLOGICAL && type != TSTRING &&
+ type != TSHORT && type != TINT && type != TLONG &&
+ type != TFLOAT && type != TDOUBLE && type != TCOMPLEX &&
+ type != TULONG && type != TUSHORT && type != TDBLCOMPLEX &&
+ type != TLONGLONG )
+ {
+ if (type < 0) {
+ sprintf(message,
+ "Variable length array not allowed for output column number %d (ffiter)",
+ jj + 1);
+ } else {
+ sprintf(message,
+ "Illegal datatype for column number %d: %d (ffiter)",
+ jj + 1, cols[jj].datatype);
+ }
+
+ ffpmsg(message);
+ return(*status = BAD_DATATYPE);
+ }
+
+ /* initialize TLMINn, TLMAXn, column name, and display format */
+ cols[jj].tlmin = 0;
+ cols[jj].tlmax = 0;
+ cols[jj].tunit[0] = '\0';
+ cols[jj].tdisp[0] = '\0';
+
+ ffghdt(cols[jj].fptr, &jtype, status); /* get HDU type */
+
+ if (hdutype == IMAGE_HDU) /* operating on FITS images */
+ {
+ if (jtype != IMAGE_HDU)
+ {
+ sprintf(message,
+ "File %d not positioned to an image extension (ffiter)",
+ jj + 1);
+ return(*status = NOT_IMAGE);
+ }
+
+ /* since this is an image, set a dummy column number = 0 */
+ cols[jj].colnum = 0;
+ strcpy(cols[jj].colname, "IMAGE"); /* dummy name for images */
+
+ tstatus = 0;
+ ffgkys(cols[jj].fptr, "BUNIT", cols[jj].tunit, 0, &tstatus);
+ }
+ else /* operating on FITS tables */
+ {
+ if (jtype == IMAGE_HDU)
+ {
+ sprintf(message,
+ "File %d not positioned to a table extension (ffiter)",
+ jj + 1);
+ return(*status = NOT_TABLE);
+ }
+
+ if (cols[jj].colnum < 1)
+ {
+ /* find the column number for the named column */
+ if (ffgcno(cols[jj].fptr, CASEINSEN, cols[jj].colname,
+ &cols[jj].colnum, status) )
+ {
+ sprintf(message,
+ "Column '%s' not found for column number %d (ffiter)",
+ cols[jj].colname, jj + 1);
+ ffpmsg(message);
+ return(*status);
+ }
+ }
+
+ /* check that the column number is valid */
+ if (cols[jj].colnum < 1 ||
+ cols[jj].colnum > ((cols[jj].fptr)->Fptr)->tfield)
+ {
+ sprintf(message,
+ "Column %d has illegal table position number: %d (ffiter)",
+ jj + 1, cols[jj].colnum);
+ ffpmsg(message);
+ return(*status = BAD_COL_NUM);
+ }
+
+ /* look for column description keywords and update structure */
+ tstatus = 0;
+ ffkeyn("TLMIN", cols[jj].colnum, keyname, &tstatus);
+ ffgkyj(cols[jj].fptr, keyname, &cols[jj].tlmin, 0, &tstatus);
+
+ tstatus = 0;
+ ffkeyn("TLMAX", cols[jj].colnum, keyname, &tstatus);
+ ffgkyj(cols[jj].fptr, keyname, &cols[jj].tlmax, 0, &tstatus);
+
+ tstatus = 0;
+ ffkeyn("TTYPE", cols[jj].colnum, keyname, &tstatus);
+ ffgkys(cols[jj].fptr, keyname, cols[jj].colname, 0, &tstatus);
+ if (tstatus)
+ cols[jj].colname[0] = '\0';
+
+ tstatus = 0;
+ ffkeyn("TUNIT", cols[jj].colnum, keyname, &tstatus);
+ ffgkys(cols[jj].fptr, keyname, cols[jj].tunit, 0, &tstatus);
+
+ tstatus = 0;
+ ffkeyn("TDISP", cols[jj].colnum, keyname, &tstatus);
+ ffgkys(cols[jj].fptr, keyname, cols[jj].tdisp, 0, &tstatus);
+ }
+ } /* end of loop over all columns */
+
+ /*-----------------------------------------------------------------*/
+ /* use the first file to set the total number of values to process */
+ /*-----------------------------------------------------------------*/
+
+ offset = maxvalue(offset, 0L); /* make sure offset is legal */
+
+ if (hdutype == IMAGE_HDU) /* get total number of pixels in the image */
+ {
+ fits_get_img_dim(cols[0].fptr, &naxis, status);
+ fits_get_img_size(cols[0].fptr, 9, naxes, status);
+
+ tstatus = 0;
+ ffgkyj(cols[0].fptr, "GROUPS", &groups, NULL, &tstatus);
+ if (!tstatus && groups && (naxis > 1) && (naxes[0] == 0) )
+ {
+ /* this is a random groups file, with NAXIS1 = 0 */
+ /* Use GCOUNT, the number of groups, as the first multiplier */
+ /* to calculate the total number of pixels in all the groups. */
+ ffgkyj(cols[0].fptr, "GCOUNT", &totaln, NULL, status);
+
+ } else {
+ totaln = naxes[0];
+ }
+
+ for (ii = 1; ii < naxis; ii++)
+ totaln *= naxes[ii];
+
+ frow = 1;
+ felement = 1 + offset;
+ }
+ else /* get total number or rows in the table */
+ {
+ ffgkyj(cols[0].fptr, "NAXIS2", &totaln, 0, status);
+ frow = 1 + offset;
+ felement = 1;
+ }
+
+ /* adjust total by the input starting offset value */
+ totaln -= offset;
+ totaln = maxvalue(totaln, 0L); /* don't allow negative number */
+
+ /*------------------------------------------------------------------*/
+ /* Determine number of values to pass to work function on each loop */
+ /*------------------------------------------------------------------*/
+
+ if (n_per_loop == 0)
+ {
+ /* Determine optimum number of values for each iteration. */
+ /* Look at all the fitsfile pointers to determine the number */
+ /* of unique files. */
+
+ nfiles = 1;
+ ffgrsz(cols[0].fptr, &n_optimum, status);
+
+ for (jj = 1; jj < n_cols; jj++)
+ {
+ for (ii = 0; ii < jj; ii++)
+ {
+ if (cols[ii].fptr == cols[jj].fptr)
+ break;
+ }
+
+ if (ii == jj) /* this is a new file */
+ {
+ nfiles++;
+ ffgrsz(cols[jj].fptr, &i_optimum, status);
+ n_optimum = minvalue(n_optimum, i_optimum);
+ }
+ }
+
+ /* divid n_optimum by the number of files that will be processed */
+ n_optimum = n_optimum / nfiles;
+ n_optimum = maxvalue(n_optimum, 1);
+ }
+ else if (n_per_loop < 0) /* must pass all the values at one time */
+ {
+ n_optimum = totaln;
+ }
+ else /* calling routine specified how many values to pass at a time */
+ {
+ n_optimum = minvalue(n_per_loop, totaln);
+ }
+
+ /*--------------------------------------*/
+ /* allocate work arrays for each column */
+ /* and determine the null pixel value */
+ /*--------------------------------------*/
+
+ col = calloc(n_cols, sizeof(colNulls) ); /* memory for the null values */
+ if (!col)
+ {
+ ffpmsg("ffiter failed to allocate memory for null values");
+ *status = MEMORY_ALLOCATION; /* memory allocation failed */
+ return(*status);
+ }
+
+ for (jj = 0; jj < n_cols; jj++)
+ {
+ /* get image or column datatype and vector length */
+ if (hdutype == IMAGE_HDU) /* get total number of pixels in the image */
+ {
+ fits_get_img_type(cols[jj].fptr, &bitpix, status);
+ switch(bitpix) {
+ case BYTE_IMG:
+ typecode = TBYTE;
+ break;
+ case SHORT_IMG:
+ typecode = TSHORT;
+ break;
+ case LONG_IMG:
+ typecode = TLONG;
+ break;
+ case FLOAT_IMG:
+ typecode = TFLOAT;
+ break;
+ case DOUBLE_IMG:
+ typecode = TDOUBLE;
+ break;
+ case LONGLONG_IMG:
+ typecode = TLONGLONG;
+ break;
+ }
+ }
+ else
+ {
+ if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,
+ &width, status) > 0)
+ goto cleanup;
+
+ if (typecode < 0) { /* if any variable length arrays, then the */
+ n_optimum = 1; /* must process the table 1 row at a time */
+
+ /* Allow variable length arrays for InputCol and InputOutputCol columns,
+ but not for OutputCol columns. Variable length arrays have a
+ negative type code value. */
+
+ if (cols[jj].iotype == OutputCol) {
+ sprintf(message,
+ "Variable length array not allowed for output column number %d (ffiter)",
+ jj + 1);
+ ffpmsg(message);
+ return(*status = BAD_DATATYPE);
+ }
+ }
+ }
+
+ /* special case where sizeof(long) = 8: use TINT instead of TLONG */
+ if (abs(typecode) == TLONG && sizeof(long) == 8 && sizeof(int) == 4) {
+ if(typecode<0) {
+ typecode = -TINT;
+ } else {
+ typecode = TINT;
+ }
+ }
+
+ /* Special case: interprete 'X' column as 'B' */
+ if (abs(typecode) == TBIT)
+ {
+ typecode = typecode / TBIT * TBYTE;
+ rept = (rept + 7) / 8;
+ }
+
+ if (cols[jj].datatype == 0) /* output datatype not specified? */
+ {
+ /* special case if sizeof(long) = 8: use TINT instead of TLONG */
+ if (abs(typecode) == TLONG && sizeof(long) == 8 && sizeof(int) == 4)
+ cols[jj].datatype = TINT;
+ else
+ cols[jj].datatype = abs(typecode);
+ }
+
+ /* calc total number of elements to do on each iteration */
+ if (hdutype == IMAGE_HDU || cols[jj].datatype == TSTRING)
+ {
+ ntodo = n_optimum;
+ cols[jj].repeat = 1;
+
+ /* get the BLANK keyword value, if it exists */
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ tstatus = 0;
+ ffgkyj(cols[jj].fptr, "BLANK", &tnull, 0, &tstatus);
+ if (tstatus)
+ {
+ tnull = 0L; /* no null values */
+ }
+ }
+ }
+ else
+ {
+ if (typecode < 0)
+ {
+ /* get max size of the variable length vector; dont't trust the value
+ given by the TFORM keyword */
+ rept = 1;
+ for (ii = 0; ii < totaln; ii++) {
+ ffgdes(cols[jj].fptr, cols[jj].colnum, frow + ii, &rowrept, NULL, status);
+
+ rept = maxvalue(rept, rowrept);
+ }
+ }
+
+ ntodo = n_optimum * rept; /* vector columns */
+ cols[jj].repeat = rept;
+
+ /* get the TNULL keyword value, if it exists */
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ tstatus = 0;
+ if (hdutype == ASCII_TBL) /* TNULLn value is a string */
+ {
+ ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus);
+ ffgkys(cols[jj].fptr, keyname, nullstr, 0, &tstatus);
+ if (tstatus)
+ {
+ tnull = 0L; /* keyword doesn't exist; no null values */
+ }
+ else
+ {
+ cptr = nullstr;
+ while (*cptr == ' ') /* skip over leading blanks */
+ cptr++;
+
+ if (*cptr == '\0') /* TNULLn is all blanks? */
+ tnull = LONG_MIN;
+ else
+ {
+ /* attempt to read TNULLn string as an integer */
+ ffc2ii(nullstr, &tnull, &tstatus);
+
+ if (tstatus)
+ tnull = LONG_MIN; /* choose smallest value */
+ } /* to represent nulls */
+ }
+ }
+ else /* Binary table; TNULLn value is an integer */
+ {
+ ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus);
+ ffgkyj(cols[jj].fptr, keyname, &tnull, 0, &tstatus);
+ if (tstatus)
+ {
+ tnull = 0L; /* keyword doesn't exist; no null values */
+ }
+ else if (tnull == 0)
+ {
+ /* worst possible case: a value of 0 is used to */
+ /* represent nulls in the FITS file. We have to */
+ /* use a non-zero null value here (zero is used to */
+ /* mean there are no null values in the array) so we */
+ /* will use the smallest possible integer instead. */
+
+ tnull = LONG_MIN; /* choose smallest possible value */
+ }
+ }
+ }
+ }
+
+ /* Note that the data array starts with 2nd element; */
+ /* 1st element of the array gives the null data value */
+
+ switch (cols[jj].datatype)
+ {
+ case TBYTE:
+ cols[jj].array = calloc(ntodo + 1, sizeof(char));
+ col[jj].nullsize = sizeof(char); /* number of bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ tnull = minvalue(tnull, 255);
+ tnull = maxvalue(tnull, 0);
+ col[jj].null.charnull = (unsigned char) tnull;
+ }
+ else
+ {
+ col[jj].null.charnull = (unsigned char) 255; /* use 255 as null */
+ }
+ break;
+
+ case TSBYTE:
+ cols[jj].array = calloc(ntodo + 1, sizeof(char));
+ col[jj].nullsize = sizeof(char); /* number of bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ tnull = minvalue(tnull, 127);
+ tnull = maxvalue(tnull, -128);
+ col[jj].null.scharnull = (signed char) tnull;
+ }
+ else
+ {
+ col[jj].null.scharnull = (signed char) -128; /* use -128 null */
+ }
+ break;
+
+ case TSHORT:
+ cols[jj].array = calloc(ntodo + 1, sizeof(short));
+ col[jj].nullsize = sizeof(short); /* number of bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ tnull = minvalue(tnull, SHRT_MAX);
+ tnull = maxvalue(tnull, SHRT_MIN);
+ col[jj].null.shortnull = (short) tnull;
+ }
+ else
+ {
+ col[jj].null.shortnull = SHRT_MIN; /* use minimum as null */
+ }
+ break;
+
+ case TUSHORT:
+ cols[jj].array = calloc(ntodo + 1, sizeof(unsigned short));
+ col[jj].nullsize = sizeof(unsigned short); /* bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ tnull = minvalue(tnull, (long) USHRT_MAX);
+ tnull = maxvalue(tnull, 0); /* don't allow negative value */
+ col[jj].null.ushortnull = (unsigned short) tnull;
+ }
+ else
+ {
+ col[jj].null.ushortnull = USHRT_MAX; /* use maximum null */
+ }
+ break;
+
+ case TINT:
+ cols[jj].array = calloc(sizeof(int), ntodo + 1);
+ col[jj].nullsize = sizeof(int); /* number of bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ tnull = minvalue(tnull, INT_MAX);
+ tnull = maxvalue(tnull, INT_MIN);
+ col[jj].null.intnull = (int) tnull;
+ }
+ else
+ {
+ col[jj].null.intnull = INT_MIN; /* use minimum as null */
+ }
+ break;
+
+ case TUINT:
+ cols[jj].array = calloc(ntodo + 1, sizeof(unsigned int));
+ col[jj].nullsize = sizeof(unsigned int); /* bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ tnull = minvalue(tnull, INT32_MAX);
+ tnull = maxvalue(tnull, 0);
+ col[jj].null.uintnull = (unsigned int) tnull;
+ }
+ else
+ {
+ col[jj].null.intnull = UINT_MAX; /* use maximum as null */
+ }
+ break;
+
+ case TLONG:
+ cols[jj].array = calloc(ntodo + 1, sizeof(long));
+ col[jj].nullsize = sizeof(long); /* number of bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ col[jj].null.longnull = tnull;
+ }
+ else
+ {
+ col[jj].null.longnull = LONG_MIN; /* use minimum as null */
+ }
+ break;
+
+ case TULONG:
+ cols[jj].array = calloc(ntodo + 1, sizeof(unsigned long));
+ col[jj].nullsize = sizeof(unsigned long); /* bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ if (tnull < 0) /* can't use a negative null value */
+ col[jj].null.ulongnull = LONG_MAX;
+ else
+ col[jj].null.ulongnull = (unsigned long) tnull;
+ }
+ else
+ {
+ col[jj].null.ulongnull = LONG_MAX; /* use maximum as null */
+ }
+ break;
+
+ case TFLOAT:
+ cols[jj].array = calloc(ntodo + 1, sizeof(float));
+ col[jj].nullsize = sizeof(float); /* number of bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ col[jj].null.floatnull = (float) tnull;
+ }
+ else
+ {
+ col[jj].null.floatnull = FLOATNULLVALUE; /* special value */
+ }
+ break;
+
+ case TCOMPLEX:
+ cols[jj].array = calloc((ntodo * 2) + 1, sizeof(float));
+ col[jj].nullsize = sizeof(float); /* number of bytes per value */
+ col[jj].null.floatnull = FLOATNULLVALUE; /* special value */
+ break;
+
+ case TDOUBLE:
+ cols[jj].array = calloc(ntodo + 1, sizeof(double));
+ col[jj].nullsize = sizeof(double); /* number of bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG)
+ {
+ col[jj].null.doublenull = (double) tnull;
+ }
+ else
+ {
+ col[jj].null.doublenull = DOUBLENULLVALUE; /* special value */
+ }
+ break;
+
+ case TDBLCOMPLEX:
+ cols[jj].array = calloc((ntodo * 2) + 1, sizeof(double));
+ col[jj].nullsize = sizeof(double); /* number of bytes per value */
+ col[jj].null.doublenull = DOUBLENULLVALUE; /* special value */
+ break;
+
+ case TSTRING:
+ /* allocate array of pointers to all the strings */
+ if( hdutype==ASCII_TBL ) rept = width;
+ stringptr = calloc((ntodo + 1) , sizeof(stringptr));
+ cols[jj].array = stringptr;
+ col[jj].nullsize = rept + 1; /* number of bytes per value */
+
+ if (stringptr)
+ {
+ /* allocate string to store the null string value */
+ col[jj].null.stringnull = calloc(rept + 1, sizeof(char) );
+ col[jj].null.stringnull[1] = 1; /* to make sure string != 0 */
+
+ /* allocate big block for the array of table column strings */
+ stringptr[0] = calloc((ntodo + 1) * (rept + 1), sizeof(char) );
+
+ if (stringptr[0])
+ {
+ for (ii = 1; ii <= ntodo; ii++)
+ { /* pointer to each string */
+ stringptr[ii] = stringptr[ii - 1] + (rept + 1);
+ }
+
+ /* get the TNULL keyword value, if it exists */
+ tstatus = 0;
+ ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus);
+ ffgkys(cols[jj].fptr, keyname, nullstr, 0, &tstatus);
+ if (!tstatus)
+ strncat(col[jj].null.stringnull, nullstr, rept);
+ }
+ else
+ {
+ ffpmsg("ffiter failed to allocate memory arrays");
+ *status = MEMORY_ALLOCATION; /* memory allocation failed */
+ goto cleanup;
+ }
+ }
+ break;
+
+ case TLOGICAL:
+
+ cols[jj].array = calloc(ntodo + 1, sizeof(char));
+ col[jj].nullsize = sizeof(char); /* number of bytes per value */
+
+ /* use value = 2 to flag null values in logical columns */
+ col[jj].null.charnull = 2;
+ break;
+
+ case TLONGLONG:
+ cols[jj].array = calloc(ntodo + 1, sizeof(LONGLONG));
+ col[jj].nullsize = sizeof(LONGLONG); /* number of bytes per value */
+
+ if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG ||
+ abs(typecode) == TLONGLONG)
+ {
+ col[jj].null.longlongnull = tnull;
+ }
+ else
+ {
+ col[jj].null.longlongnull = LONGLONG_MIN; /* use minimum as null */
+ }
+ break;
+
+ default:
+ sprintf(message,
+ "Column %d datatype currently not supported: %d: (ffiter)",
+ jj + 1, cols[jj].datatype);
+ ffpmsg(message);
+ *status = BAD_DATATYPE;
+ goto cleanup;
+
+ } /* end of switch block */
+
+ /* check that all the arrays were allocated successfully */
+ if (!cols[jj].array)
+ {
+ ffpmsg("ffiter failed to allocate memory arrays");
+ *status = MEMORY_ALLOCATION; /* memory allocation failed */
+ goto cleanup;
+ }
+ }
+
+ /*--------------------------------------------------*/
+ /* main loop while there are values left to process */
+ /*--------------------------------------------------*/
+
+ nleft = totaln;
+
+ while (nleft)
+ {
+ ntodo = minvalue(nleft, n_optimum); /* no. of values for this loop */
+
+ /* read input columns from FITS file(s) */
+ for (jj = 0; jj < n_cols; jj++)
+ {
+ if (cols[jj].iotype != OutputCol)
+ {
+ if (cols[jj].datatype == TSTRING)
+ {
+ stringptr = cols[jj].array;
+ dataptr = stringptr + 1;
+ defaultnull = col[jj].null.stringnull; /* ptr to the null value */
+ }
+ else
+ {
+ dataptr = (char *) cols[jj].array + col[jj].nullsize;
+ defaultnull = &col[jj].null.charnull; /* ptr to the null value */
+ }
+
+ if (hdutype == IMAGE_HDU)
+ {
+ if (ffgpv(cols[jj].fptr, cols[jj].datatype,
+ felement, cols[jj].repeat * ntodo, defaultnull,
+ dataptr, &anynul, status) > 0)
+ {
+ break;
+ }
+ }
+ else
+ {
+ if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0)
+ goto cleanup;
+
+ if (typecode<0)
+ {
+ /* get size of the variable length vector */
+ ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status);
+ }
+
+ if (ffgcv(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum,
+ frow, felement, cols[jj].repeat * ntodo, defaultnull,
+ dataptr, &anynul, status) > 0)
+ {
+ break;
+ }
+ }
+
+ /* copy the appropriate null value into first array element */
+
+ if (anynul) /* are there any nulls in the data? */
+ {
+ if (cols[jj].datatype == TSTRING)
+ {
+ stringptr = cols[jj].array;
+ memcpy(*stringptr, col[jj].null.stringnull, col[jj].nullsize);
+ }
+ else
+ {
+ memcpy(cols[jj].array, defaultnull, col[jj].nullsize);
+ }
+ }
+ else /* no null values so copy zero into first element */
+ {
+ if (cols[jj].datatype == TSTRING)
+ {
+ stringptr = cols[jj].array;
+ memset(*stringptr, 0, col[jj].nullsize);
+ }
+ else
+ {
+ memset(cols[jj].array, 0, col[jj].nullsize);
+ }
+ }
+ }
+ }
+
+ if (*status > 0)
+ break; /* looks like an error occurred; quit immediately */
+
+ /* call work function */
+
+ if (hdutype == IMAGE_HDU)
+ *status = work_fn(totaln, offset, felement, ntodo, n_cols, cols,
+ userPointer);
+ else
+ *status = work_fn(totaln, offset, frow, ntodo, n_cols, cols,
+ userPointer);
+
+ if (*status > 0 || *status < -1 )
+ break; /* looks like an error occurred; quit immediately */
+
+ /* write output columns before quiting if status = -1 */
+ tstatus = 0;
+ for (jj = 0; jj < n_cols; jj++)
+ {
+ if (cols[jj].iotype != InputCol)
+ {
+ if (cols[jj].datatype == TSTRING)
+ {
+ stringptr = cols[jj].array;
+ dataptr = stringptr + 1;
+ nullptr = *stringptr;
+ nbytes = 2;
+ }
+ else
+ {
+ dataptr = (char *) cols[jj].array + col[jj].nullsize;
+ nullptr = (char *) cols[jj].array;
+ nbytes = col[jj].nullsize;
+ }
+
+ if (memcmp(nullptr, &zeros, nbytes) )
+ {
+ /* null value flag not zero; must check for and write nulls */
+ if (hdutype == IMAGE_HDU)
+ {
+ if (ffppn(cols[jj].fptr, cols[jj].datatype,
+ felement, cols[jj].repeat * ntodo, dataptr,
+ nullptr, &tstatus) > 0)
+ break;
+ }
+ else
+ {
+ if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0)
+ goto cleanup;
+
+ if (typecode<0) /* variable length array colum */
+ {
+ ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status);
+ }
+
+ if (ffpcn(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum, frow,
+ felement, cols[jj].repeat * ntodo, dataptr,
+ nullptr, &tstatus) > 0)
+ break;
+ }
+ }
+ else
+ {
+ /* no null values; just write the array */
+ if (hdutype == IMAGE_HDU)
+ {
+ if (ffppr(cols[jj].fptr, cols[jj].datatype,
+ felement, cols[jj].repeat * ntodo, dataptr,
+ &tstatus) > 0)
+ break;
+ }
+ else
+ {
+ if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0)
+ goto cleanup;
+
+ if (typecode<0) /* variable length array column */
+ {
+ ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status);
+ }
+
+ if (ffpcl(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum, frow,
+ felement, cols[jj].repeat * ntodo, dataptr,
+ &tstatus) > 0)
+ break;
+ }
+ }
+ }
+ }
+
+ if (*status == 0)
+ *status = tstatus; /* propagate any error status from the writes */
+
+ if (*status)
+ break; /* exit on any error */
+
+ nleft -= ntodo;
+
+ if (hdutype == IMAGE_HDU)
+ felement += ntodo;
+ else
+ frow += ntodo;
+ }
+
+cleanup:
+
+ /*----------------------------------*/
+ /* free work arrays for the columns */
+ /*----------------------------------*/
+
+ for (jj = 0; jj < n_cols; jj++)
+ {
+ if (cols[jj].datatype == TSTRING)
+ {
+ if (cols[jj].array)
+ {
+ stringptr = cols[jj].array;
+ free(*stringptr); /* free the block of strings */
+ free(col[jj].null.stringnull); /* free the null string */
+ }
+ }
+ if (cols[jj].array)
+ free(cols[jj].array); /* memory for the array of values from the col */
+ }
+ free(col); /* the structure containing the null values */
+ return(*status);
+}
+
diff --git a/src/plugins/cfitsio/putcolb.c b/src/plugins/cfitsio/putcolb.c
new file mode 100644
index 0000000..120cca8
--- /dev/null
+++ b/src/plugins/cfitsio/putcolb.c
@@ -0,0 +1,1012 @@
+/* This file, putcolb.c, contains routines that write data elements to */
+/* a FITS image or table with char (byte) 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffpprb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned char *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+ unsigned char nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_pixels(fptr, TBYTE, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpclb(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppnb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned char *array, /* I - array of values that are written */
+ unsigned char nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+ unsigned char nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TBYTE, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcnb(fptr, 2, row, firstelem, nelem, array, nulval, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2db(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ unsigned char *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3db(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3db(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ unsigned char *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ LONGLONG nfits, narray;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TBYTE, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpclb(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpclb(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpssb(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ unsigned char *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TBYTE, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpclb(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ unsigned char *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpclb(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpclb( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned char *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table with
+ 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype, writeraw;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*
+ if there is no scaling
+ then we can simply write the raw data bytes into the FITS file if the
+ datatype of the FITS column is the same as the input values. Otherwise,
+ we must convert the raw values into the scaled and/or machine dependent
+ format in a temporary buffer that has been allocated for this purpose.
+ */
+ if (scale == 1. && zero == 0. && tcode == TBYTE)
+ {
+ writeraw = 1;
+ maxelem = (int) nelem; /* we can write the entire array at one time */
+ }
+ else
+ writeraw = 0;
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TBYTE):
+ if (writeraw)
+ {
+ /* write raw input bytes without conversion */
+ ffpi1b(fptr, ntodo, incre, &array[next], status);
+ }
+ else
+ {
+ /* convert the raw data before writing to FITS file */
+ ffi1fi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ }
+
+ break;
+
+ case (TLONGLONG):
+
+ ffi1fi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TSHORT):
+
+ ffi1fi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TLONG):
+
+ ffi1fi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ break;
+
+ case (TFLOAT):
+
+ ffi1fr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffi1fr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (strchr(tform,'A'))
+ {
+ /* write raw input bytes without conversion */
+ /* This case is a hack to let users write a stream */
+ /* of bytes directly to the 'A' format column */
+
+ if (incre == twidth)
+ ffpbyt(fptr, ntodo, &array[next], status);
+ else
+ ffpbytoff(fptr, twidth, ntodo/twidth, incre - twidth,
+ &array[next], status);
+ break;
+ }
+ else if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffi1fstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpclb).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnb( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned char *array, /* I - array of values to write */
+ unsigned char nulvalue, /* I - flag for undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpclb(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood + 1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpclb(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad + 1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpclb(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpextn( fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG offset, /* I - byte offset from start of extension data */
+ LONGLONG nelem, /* I - number of elements to write */
+ void *buffer, /* I - stream of bytes to write */
+ int *status) /* IO - error status */
+/*
+ Write a stream of bytes to the current FITS HDU. This primative routine is mainly
+ for writing non-standard "conforming" extensions and should not be used
+ for standard IMAGE, TABLE or BINTABLE extensions.
+*/
+{
+ if (*status > 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);
+
+ /* move to write position */
+ ffmbyt(fptr, (fptr->Fptr)->datastart+ offset, IGNORE_EOF, status);
+
+ /* write the buffer */
+ ffpbyt(fptr, nelem, buffer, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi1fi1(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ memcpy(output, input, ntodo); /* just copy input to output */
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = ( ((double) input[ii]) - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi1fi2(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii]; /* just copy input to output */
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (((double) input[ii]) - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi1fi4(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (INT32BIT) input[ii]; /* copy input to output */
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (((double) input[ii]) - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi1fi8(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi1fr4(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) (( ( (double) input[ii] ) - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi1fr8(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ( ( (double) input[ii] ) - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi1fstr(unsigned char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = ((double) input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcold.c b/src/plugins/cfitsio/putcold.c
new file mode 100644
index 0000000..b0c135a
--- /dev/null
+++ b/src/plugins/cfitsio/putcold.c
@@ -0,0 +1,1059 @@
+/* This file, putcold.c, contains routines that write data elements to */
+/* a FITS image or table, with double 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffpprd( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ double *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+ double nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_pixels(fptr, TDOUBLE, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcld(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppnd( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ double *array, /* I - array of values that are written */
+ double nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+ double nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TDOUBLE, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcnd(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2dd(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ double *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3dd(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3dd(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ double *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TDOUBLE, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpcld(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpcld(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpssd(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ double *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TDOUBLE, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpcld(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpd( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ double *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpcld(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcld( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ double *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype, writeraw;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*
+ if there is no scaling and the native machine format is not byteswapped,
+ then we can simply write the raw data bytes into the FITS file if the
+ datatype of the FITS column is the same as the input values. Otherwise,
+ we must convert the raw values into the scaled and/or machine dependent
+ format in a temporary buffer that has been allocated for this purpose.
+ */
+ if (scale == 1. && zero == 0. &&
+ MACHINE == NATIVE && tcode == TDOUBLE)
+ {
+ writeraw = 1;
+ maxelem = (int) nelem; /* we can write the entire array at one time */
+ }
+ else
+ writeraw = 0;
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TDOUBLE):
+ if (writeraw)
+ {
+ /* write raw input bytes without conversion */
+ ffpr8b(fptr, ntodo, incre, &array[next], status);
+ }
+ else
+ {
+ /* convert the raw data before writing to FITS file */
+ ffr8fr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ }
+
+ break;
+
+ case (TLONGLONG):
+
+ ffr8fi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TBYTE):
+
+ ffr8fi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ break;
+
+ case (TSHORT):
+
+ ffr8fi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TLONG):
+
+ ffr8fi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ break;
+
+ case (TFLOAT):
+ ffr8fr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffr8fstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpcld).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpclm( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ double *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of double complex values to a column in the current FITS HDU.
+ Each complex number if interpreted as a pair of float values.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ if necessary, but normally complex values should only be written to a binary
+ table with TFORMn = 'rM' where r is an optional repeat count. The TSCALn and
+ TZERO keywords should not be used with complex numbers because mathmatically
+ the scaling should only be applied to the real (first) component of the
+ complex value.
+*/
+{
+ /* simply multiply the number of elements by 2, and call ffpcld */
+
+ ffpcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1,
+ nelem * 2, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnd( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ double *array, /* I - array of values to write */
+ double nulvalue, /* I - value used to flag undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ if (abs(tcode) >= TCOMPLEX)
+ { /* treat complex columns as pairs of numbers */
+ repeat *= 2;
+ }
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpcld(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ /* call ffpcluc, not ffpclu, in case we are writing to a
+ complex ('C') binary table column */
+ if (ffpcluc(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpcld(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpcld(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+ ffpcluc(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr8fi1(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr8fi2(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr8fi4(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (input[ii] > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ output[ii] = (INT32BIT) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr8fi8(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (input[ii] > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (LONGLONG) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr8fr4(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) ((input[ii] - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr8fr8(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ memcpy(output, input, ntodo * sizeof(double) ); /* copy input to output */
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (input[ii] - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr8fstr(double *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcole.c b/src/plugins/cfitsio/putcole.c
new file mode 100644
index 0000000..c13f04c
--- /dev/null
+++ b/src/plugins/cfitsio/putcole.c
@@ -0,0 +1,1073 @@
+/* This file, putcole.c, contains routines that write data elements to */
+/* a FITS image or table, with float 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffppre( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ float *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+
+ This routine cannot be called directly by users to write to large
+ arrays with > 2**31 pixels (although CFITSIO can do so by passing
+ the firstelem thru a LONGLONG sized global variable)
+*/
+{
+ long row;
+ float nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_pixels(fptr, TFLOAT, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcle(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppne( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ float *array, /* I - array of values that are written */
+ float nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+
+ This routine cannot be called directly by users to write to large
+ arrays with > 2**31 pixels (although CFITSIO can do so by passing
+ the firstelem thru a LONGLONG sized global variable)
+*/
+{
+ long row;
+ float nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TFLOAT, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcne(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2de(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ float *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+
+ This routine does not support writing to large images with
+ more than 2**31 pixels.
+*/
+{
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3de(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3de(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ float *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+
+ This routine does not support writing to large images with
+ more than 2**31 pixels.
+*/
+{
+ long tablerow, ii, jj;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TFLOAT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpcle(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpcle(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpsse(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ float *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TFLOAT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpcle(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpe( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ float *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpcle(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcle( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ float *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype, writeraw;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*
+ if there is no scaling and the native machine format is not byteswapped
+ then we can simply write the raw data bytes into the FITS file if the
+ datatype of the FITS column is the same as the input values. Otherwise,
+ we must convert the raw values into the scaled and/or machine dependent
+ format in a temporary buffer that has been allocated for this purpose.
+ */
+ if (scale == 1. && zero == 0. &&
+ MACHINE == NATIVE && tcode == TFLOAT)
+ {
+ writeraw = 1;
+ maxelem = (int) nelem; /* we can write the entire array at one time */
+ }
+ else
+ writeraw = 0;
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TFLOAT):
+ if (writeraw)
+ {
+ /* write raw input bytes without conversion */
+ ffpr4b(fptr, ntodo, incre, &array[next], status);
+ }
+ else
+ {
+ /* convert the raw data before writing to FITS file */
+ ffr4fr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ }
+
+ break;
+
+ case (TLONGLONG):
+
+ ffr4fi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TBYTE):
+
+ ffr4fi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ break;
+
+ case (TSHORT):
+
+ ffr4fi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TLONG):
+
+ ffr4fi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffr4fr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffr4fstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpcle).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpclc( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ float *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of complex values to a column in the current FITS HDU.
+ Each complex number if interpreted as a pair of float values.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ if necessary, but normally complex values should only be written to a binary
+ table with TFORMn = 'rC' where r is an optional repeat count. The TSCALn and
+ TZERO keywords should not be used with complex numbers because mathmatically
+ the scaling should only be applied to the real (first) component of the
+ complex value.
+*/
+{
+ /* simply multiply the number of elements by 2, and call ffpcle */
+
+ ffpcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1,
+ nelem * 2, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcne( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ float *array, /* I - array of values to write */
+ float nulvalue, /* I - value used to flag undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ if (abs(tcode) >= TCOMPLEX)
+ { /* treat complex columns as pairs of numbers */
+ repeat *= 2;
+ }
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpcle(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ /* call ffpcluc, not ffpclu, in case we are writing to a
+ complex ('C') binary table column */
+ if (ffpcluc(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpcle(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpcle(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+ ffpcluc(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr4fi1(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr4fi2(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr4fi4(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (input[ii] > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ output[ii] = (INT32BIT) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr4fi8(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (input[ii] > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ output[ii] = (long) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr4fr4(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ memcpy(output, input, ntodo * sizeof(float) ); /* copy input to output */
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) ((input[ii] - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr4fr8(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (input[ii] - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr4fstr(float *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcoli.c b/src/plugins/cfitsio/putcoli.c
new file mode 100644
index 0000000..bddc459
--- /dev/null
+++ b/src/plugins/cfitsio/putcoli.c
@@ -0,0 +1,985 @@
+/* This file, putcoli.c, contains routines that write data elements to */
+/* a FITS image or table, with short 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffppri( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ short *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+ short nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+
+ fits_write_compressed_pixels(fptr, TSHORT, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcli(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppni( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ short *array, /* I - array of values that are written */
+ short nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+ short nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TSHORT, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcni(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2di(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ short *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3di(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3di(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ short *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TSHORT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpcli(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpcli(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpssi(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ short *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TSHORT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpcli(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpi( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ short *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpcli(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcli( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ short *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table with
+ 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype, writeraw;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*
+ if there is no scaling and the native machine format is not byteswapped,
+ then we can simply write the raw data bytes into the FITS file if the
+ datatype of the FITS column is the same as the input values. Otherwise,
+ we must convert the raw values into the scaled and/or machine dependent
+ format in a temporary buffer that has been allocated for this purpose.
+ */
+ if (scale == 1. && zero == 0. &&
+ MACHINE == NATIVE && tcode == TSHORT)
+ {
+ writeraw = 1;
+ maxelem = (int) nelem; /* we can write the entire array at one time */
+ }
+ else
+ writeraw = 0;
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TSHORT):
+ if (writeraw)
+ {
+ /* write raw input bytes without conversion */
+ ffpi2b(fptr, ntodo, incre, &array[next], status);
+ }
+ else
+ {
+ /* convert the raw data before writing to FITS file */
+ ffi2fi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ }
+
+ break;
+
+ case (TLONGLONG):
+
+ ffi2fi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TBYTE):
+
+ ffi2fi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ break;
+
+ case (TLONG):
+
+ ffi2fi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ break;
+
+ case (TFLOAT):
+
+ ffi2fr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffi2fr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffi2fstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpcli).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcni( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ short *array, /* I - array of values to write */
+ short nulvalue, /* I - value used to flag undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpcli(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpcli(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpcli(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi2fi1(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi2fi2(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ memcpy(output, input, ntodo * sizeof(short) );
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi2fi4(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (INT32BIT) input[ii]; /* just copy input to output */
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi2fi8(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi2fr4(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) ((input[ii] - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi2fr8(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (input[ii] - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi2fstr(short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr, *tptr;
+
+ cptr = output;
+ tptr = output;
+
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcolj.c b/src/plugins/cfitsio/putcolj.c
new file mode 100644
index 0000000..b7f6713
--- /dev/null
+++ b/src/plugins/cfitsio/putcolj.c
@@ -0,0 +1,1990 @@
+/* This file, putcolj.c, contains routines that write data elements to */
+/* a FITS image or table, with long 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffpprj( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ long *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+ long nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_pixels(fptr, TLONG, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpclj(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppnj( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ long *array, /* I - array of values that are written */
+ long nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+ long nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TLONG, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcnj(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2dj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ long *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3dj(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3dj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ long *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TLONG, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpclj(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpclj(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpssj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ long *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TLONG, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpclj(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpj( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ long *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpclj(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpclj( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ long *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype, writeraw;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*
+ if there is no scaling and the native machine format is not byteswapped
+ then we can simply write the raw data bytes into the FITS file if the
+ datatype of the FITS column is the same as the input values. Otherwise
+ we must convert the raw values into the scaled and/or machine dependent
+ format in a temporary buffer that has been allocated for this purpose.
+ */
+ if (scale == 1. && zero == 0. &&
+ MACHINE == NATIVE && tcode == TLONG && LONGSIZE == 32)
+ {
+ writeraw = 1;
+ maxelem = (int) nelem; /* we can write the entire array at one time */
+ }
+ else
+ writeraw = 0;
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TLONG):
+ if (writeraw)
+ {
+ /* write raw input bytes without conversion */
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) &array[next], status);
+ }
+ else
+ {
+ /* convert the raw data before writing to FITS file */
+ ffi4fi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ }
+
+ break;
+
+ case (TLONGLONG):
+
+ fflongfi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TBYTE):
+
+ ffi4fi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ break;
+
+ case (TSHORT):
+
+ ffi4fi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TFLOAT):
+
+ ffi4fr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffi4fr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffi4fstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpclj).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnj( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ long *array, /* I - array of values to write */
+ long nulvalue, /* I - value used to flag undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpclj(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood + 1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpclj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpclj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi4fi1(long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi4fi2(long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < SHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi4fi4(long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (INT32BIT) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fflongfi8(long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi4fr4(long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) ((input[ii] - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi4fr8(long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (input[ii] - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi4fstr(long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
+
+/* ======================================================================== */
+/* the following routines support the 'long long' data type */
+/* ======================================================================== */
+
+/*--------------------------------------------------------------------------*/
+int ffpprjj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ LONGLONG *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ ffpmsg("writing to compressed image is not supported");
+
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcljj(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppnjj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ LONGLONG *array, /* I - array of values that are written */
+ LONGLONG nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ ffpmsg("writing to compressed image is not supported");
+
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcnjj(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2djj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3djj(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3djj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ LONGLONG *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ ffpmsg("writing to compressed image is not supported");
+
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpcljj(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpcljj(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpssjj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ LONGLONG *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ ffpmsg("writing to compressed image is not supported");
+
+
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpcljj(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpjj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ LONGLONG *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpcljj(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcljj(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ LONGLONG *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype, writeraw;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*
+ if there is no scaling and the native machine format is not byteswapped
+ then we can simply write the raw data bytes into the FITS file if the
+ datatype of the FITS column is the same as the input values. Otherwise
+ we must convert the raw values into the scaled and/or machine dependent
+ format in a temporary buffer that has been allocated for this purpose.
+ */
+ if (scale == 1. && zero == 0. &&
+ MACHINE == NATIVE && tcode == TLONGLONG)
+ {
+ writeraw = 1;
+ maxelem = (int) nelem; /* we can write the entire array at one time */
+ }
+ else
+ writeraw = 0;
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TLONGLONG):
+ if (writeraw)
+ {
+ /* write raw input bytes without conversion */
+ ffpi8b(fptr, ntodo, incre, (long *) &array[next], status);
+ }
+ else
+ {
+ /* convert the raw data before writing to FITS file */
+ ffi8fi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ }
+
+ break;
+
+ case (TLONG):
+
+ ffi8fi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ break;
+
+ case (TBYTE):
+
+ ffi8fi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ break;
+
+ case (TSHORT):
+
+ ffi8fi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TFLOAT):
+
+ ffi8fr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffi8fr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffi8fstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpclj).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnjj(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ LONGLONG *array, /* I - array of values to write */
+ LONGLONG nulvalue, /* I - value used to flag undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpcljj(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpcljj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpcljj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi8fi1(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi8fi2(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < SHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi8fi4(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < INT32_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (input[ii] > INT32_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ output[ii] = (INT32BIT) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi8fi8(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi8fr4(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) ((input[ii] - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi8fr8(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (input[ii] - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi8fstr(LONGLONG *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcolk.c b/src/plugins/cfitsio/putcolk.c
new file mode 100644
index 0000000..005a142
--- /dev/null
+++ b/src/plugins/cfitsio/putcolk.c
@@ -0,0 +1,1012 @@
+/* This file, putcolk.c, contains routines that write data elements to */
+/* a FITS image or table, with 'int' 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffpprk( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ int *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+ int nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_pixels(fptr, TINT, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpclk(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppnk( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ int *array, /* I - array of values that are written */
+ int nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+ int nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TINT, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcnk(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2dk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ int *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3dk(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3dk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ int *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TINT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpclk(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpclk(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpssk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ int *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TINT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpclk(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpk( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ int *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpclk(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpclk( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ int *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype, writeraw;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* call the 'short' or 'long' version of this routine, if possible */
+ if (sizeof(int) == sizeof(short))
+ ffpcli(fptr, colnum, firstrow, firstelem, nelem,
+ (short *) array, status);
+ else if (sizeof(int) == sizeof(long))
+ ffpclj(fptr, colnum, firstrow, firstelem, nelem,
+ (long *) array, status);
+ else
+ {
+ /*
+ This is a special case: sizeof(int) is not equal to sizeof(short) or
+ sizeof(long). This occurs on Alpha OSF systems where short = 2 bytes,
+ int = 4 bytes, and long = 8 bytes.
+ */
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*
+ if there is no scaling and the native machine format is not byteswapped
+ then we can simply write the raw data bytes into the FITS file if the
+ datatype of the FITS column is the same as the input values. Otherwise
+ we must convert the raw values into the scaled and/or machine dependent
+ format in a temporary buffer that has been allocated for this purpose.
+ */
+ if (scale == 1. && zero == 0. &&
+ MACHINE == NATIVE && tcode == TLONG)
+ {
+ writeraw = 1;
+ maxelem = (int) nelem; /* we can write the entire array at one time */
+ }
+ else
+ writeraw = 0;
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TLONG):
+ if (writeraw)
+ {
+ /* write raw input bytes without conversion */
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) &array[next], status);
+ }
+ else
+ {
+ /* convert the raw data before writing to FITS file */
+ ffintfi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ }
+
+ break;
+
+ case (TLONGLONG):
+
+ ffintfi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TBYTE):
+
+ ffintfi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ break;
+
+ case (TSHORT):
+
+ ffintfi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TFLOAT):
+
+ ffintfr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffintfr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffintfstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpclk).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ } /* end of Dec ALPHA special case */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnk( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ int *array, /* I - array of values to write */
+ int nulvalue, /* I - value used to flag undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpclk(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpclk(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpclk(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffintfi1(int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffintfi2(int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < SHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffintfi4(int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ memcpy(output, input, ntodo * sizeof(int) );
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffintfi8(int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffintfr4(int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) ((input[ii] - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffintfr8(int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (input[ii] - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffintfstr(int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcoll.c b/src/plugins/cfitsio/putcoll.c
new file mode 100644
index 0000000..b26e911
--- /dev/null
+++ b/src/plugins/cfitsio/putcoll.c
@@ -0,0 +1,369 @@
+/* This file, putcoll.c, contains routines that write data elements to */
+/* 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 <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffpcll( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ char *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of logical values to a column in the current FITS HDU.
+*/
+{
+ int tcode, maxelem, hdutype;
+ long twidth, incre;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], ctrue = 'T', cfalse = 'F';
+ char message[FLEN_ERRMSG];
+ char snull[20]; /* the FITS null value */
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &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);
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the logical values one at a time to the FITS column. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ wrtptr = startpos + (rowlen * rownum) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ if (array[next])
+ ffpbyt(fptr, 1, &ctrue, status);
+ else
+ ffpbyt(fptr, 1, &cfalse, status);
+
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing element %.0f of input array of logicals (ffpcll).",
+ (double) (next+1));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain--;
+ if (remain)
+ {
+ next++;
+ elemnum++;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+
+ } /* End of main while Loop */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnl( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ char *array, /* I - array of values to write */
+ char nulvalue, /* I - array flagging undefined pixels if true */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels flagged as null will be replaced by the appropriate
+ null value in the output FITS file.
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* first write the whole input vector, then go back and fill in the nulls */
+ if (ffpcll(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0)
+ return(*status);
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+/* good values have already been written
+ if (ffpcll(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0)
+ return(*status);
+*/
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+/* these have already been written
+ ffpcll(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+*/
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpclx( 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) */
+ long fbit, /* I - first bit to write (1 = 1st) */
+ long nbit, /* I - number of bits to write */
+ char *larray, /* I - array of logicals corresponding to bits */
+ int *status) /* IO - error status */
+/*
+ write an array of logical values to a specified bit or byte
+ column of the binary table. If larray is TRUE, then the corresponding
+ bit is set to 1, otherwise it is set to 0.
+ The binary table column being written to must have datatype 'B' or 'X'.
+*/
+{
+ LONGLONG offset, bstart, repeat, rowlen, elemnum, rstart, estart, tnull;
+ long fbyte, lbyte, nbyte, bitloc, ndone;
+ long ii, twidth, incre;
+ int tcode, descrp, maxelem, hdutype;
+ double dummyd;
+ char tform[12], snull[12];
+ unsigned char cbuff;
+ static unsigned char onbit[8] = {128, 64, 32, 16, 8, 4, 2, 1};
+ static unsigned char offbit[8] = {127, 191, 223, 239, 247, 251, 253, 254};
+ 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);
+
+ /* 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);
+
+ fbyte = (fbit + 7) / 8;
+ lbyte = (fbit + nbit + 6) / 8;
+ nbyte = lbyte - fbyte +1;
+
+ /* Save the current heapsize; ffgcprll will increment the value if */
+ /* we are writing to a variable length column. */
+ offset = (fptr->Fptr)->heapsize;
+
+ /* call ffgcprll in case we are writing beyond the current end of */
+ /* the table; it will allocate more space and shift any following */
+ /* HDU's. Otherwise, we have little use for most of the returned */
+ /* parameters, therefore just use dummy parameters. */
+
+ if (ffgcprll( fptr, colnum, frow, fbyte, nbyte, 1, &dummyd, &dummyd,
+ tform, &twidth, &tcode, &maxelem, &bstart, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ bitloc = 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 */
+ repeat = 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. */
+
+ repeat = fbit + nbit -1;
+
+ /* write the number of elements and the starting offset. */
+ /* Note: ffgcprll previous wrote the descripter, but with the */
+ /* wrong repeat value (gave bytes instead of bits). */
+
+ if (tcode == -TBIT)
+ ffpdes(fptr, colnum, frow, (long) repeat, offset, status);
+
+ /* Calc the i/o pointer location to start of sequence of pixels. */
+ /* ffgcprll has already calculated a value for bstart that */
+ /* points to the first element of the vector; we just have to */
+ /* increment it to point to the first element we want to write to. */
+ /* Note: ffgcprll also already updated the size of the heap, so we */
+ /* don't have to do that again here. */
+
+ bstart += estart;
+ }
+
+ /* move the i/o pointer to the start of the pixel sequence */
+ ffmbyt(fptr, bstart, IGNORE_EOF, status);
+
+ /* read the next byte (we may only be modifying some of the bits) */
+ while (1)
+ {
+ if (ffgbyt(fptr, 1, &cbuff, status) == END_OF_FILE)
+ {
+ /* hit end of file trying to read the byte, so just set byte = 0 */
+ *status = 0;
+ cbuff = 0;
+ }
+
+ /* move back, to be able to overwrite the byte */
+ ffmbyt(fptr, bstart, IGNORE_EOF, status);
+
+ for (ii = bitloc; (ii < 8) && (ndone < nbit); ii++, ndone++)
+ {
+ if(larray[ndone])
+ cbuff = cbuff | onbit[ii];
+ else
+ cbuff = cbuff & offbit[ii];
+ }
+
+ ffpbyt(fptr, 1, &cbuff, status); /* write the modified byte */
+
+ if (ndone == nbit) /* finished all the bits */
+ return(*status);
+
+ /* not done, so get the next byte */
+ bstart++;
+ 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, IGNORE_EOF, status);
+ }
+ }
+ bitloc = 0;
+ }
+}
+
diff --git a/src/plugins/cfitsio/putcols.c b/src/plugins/cfitsio/putcols.c
new file mode 100644
index 0000000..86d624e
--- /dev/null
+++ b/src/plugins/cfitsio/putcols.c
@@ -0,0 +1,303 @@
+/* This file, putcols.c, contains routines that write data elements to */
+/* a FITS image or table, of type character string. */
+
+/* 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 ffpcls( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of strings to write */
+ char **array, /* I - array of pointers to strings */
+ int *status) /* IO - error status */
+/*
+ Write an array of string values to a column in the current FITS HDU.
+*/
+{
+ int tcode, maxelem, hdutype, nchar;
+ long twidth, incre;
+ long ii, jj, ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], *blanks;
+ 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) /* 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);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ /*---------------------------------------------------*/
+ /* 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 write a single string; ignore value of firstelem */
+ nchar = maxvalue(1,strlen(array[0])); /* will write at least 1 char */
+ /* even if input string is null */
+
+ if (ffgcprll( fptr, colnum, firstrow, 1, nchar, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ /* simply move to write position, then write the string */
+ ffmbyt(fptr, startpos, IGNORE_EOF, status);
+ ffpbyt(fptr, nchar, array[0], status);
+
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing to variable length string column (ffpcls).");
+ ffpmsg(message);
+ }
+
+ return(*status);
+ }
+ else if (tcode == TSTRING)
+ {
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &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 write 1 string at a time, to force writein by ffpbyt instead of */
+ /* ffpbytoff (ffpbytoff can't handle this case) */
+ if (twidth > IOBUFLEN) {
+ maxelem = 1;
+ incre = twidth;
+ repeat = 1;
+ }
+
+ blanks = (char *) malloc(twidth); /* string for blank fill values */
+ if (!blanks)
+ {
+ ffpmsg("Could not allocate memory for string (ffpcls)");
+ return(*status = ARRAY_TOO_BIG);
+ }
+
+ for (ii = 0; ii < twidth; ii++)
+ blanks[ii] = ' '; /* fill string with blanks */
+
+ remain = nelem; /* remaining number of values to write */
+ }
+ else
+ return(*status = NOT_ASCII_COL);
+
+ /*-------------------------------------------------------*/
+ /* Now write the strings to the FITS column. */
+ /*-------------------------------------------------------*/
+
+ next = 0; /* next element in array to be written */
+ 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));
+
+ wrtptr = startpos + (rownum * rowlen) + (elemnum * incre);
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ buffer = (char *) cbuff;
+
+ /* copy the user's strings into the buffer */
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ arrayptr = array[next];
+
+ for (jj = 0; jj < twidth; jj++) /* copy the string, char by char */
+ {
+ if (*arrayptr)
+ {
+ *buffer = *arrayptr;
+ buffer++;
+ arrayptr++;
+ }
+ else
+ break;
+ }
+
+ for (;jj < twidth; jj++) /* fill field with blanks, if needed */
+ {
+ *buffer = ' ';
+ buffer++;
+ }
+
+ next++;
+ }
+
+ /* write the buffer full of strings to the FITS file */
+ if (incre == twidth)
+ ffpbyt(fptr, ntodo * twidth, cbuff, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, cbuff, status);
+
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpcls).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+
+ if (blanks)
+ free(blanks);
+
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+ if (blanks)
+ free(blanks);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcns( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ char **array, /* I - array of values to write */
+ char *nulvalue, /* I - string representing a null value */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels flagged as null will be replaced by the appropriate
+ null value in the output FITS file.
+*/
+{
+ long repeat, width, ngood = 0, nbad = 0, ii;
+ LONGLONG first, fstelm, fstrow;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ /* get the vector repeat length of the column */
+ ffgtcl(fptr, colnum, NULL, &repeat, &width, status);
+
+ if ((fptr->Fptr)->hdutype == BINARY_TBL)
+ repeat = repeat / width; /* convert from chars to unit strings */
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (strcmp(nulvalue, array[ii])) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpcls(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0)
+ return(*status);
+
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpcls(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcolsb.c b/src/plugins/cfitsio/putcolsb.c
new file mode 100644
index 0000000..25ee5d1
--- /dev/null
+++ b/src/plugins/cfitsio/putcolsb.c
@@ -0,0 +1,974 @@
+/* This file, putcolsb.c, contains routines that write data elements to */
+/* a FITS image or table with signed char (signed byte) 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffpprsb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ signed char *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+ signed char nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_pixels(fptr, TSBYTE, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpclsb(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppnsb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ signed char *array, /* I - array of values that are written */
+ signed char nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+ signed char nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TSBYTE, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcnsb(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2dsb(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ signed char *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3dsb(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3dsb(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ signed char *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TSBYTE, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpclsb(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpclsb(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpsssb(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ signed char *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TSBYTE, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpclsb(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpsb( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ signed char *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpclsb(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpclsb( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ signed char *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table with
+ 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TBYTE):
+
+ /* convert the raw data before writing to FITS file */
+ ffs1fi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+
+ break;
+
+ case (TLONGLONG):
+
+ ffs1fi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TSHORT):
+
+ ffs1fi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TLONG):
+
+ ffs1fi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ break;
+
+ case (TFLOAT):
+
+ ffs1fr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffs1fr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (strchr(tform,'A'))
+ {
+ /* write raw input bytes without conversion */
+ /* This case is a hack to let users write a stream */
+ /* of bytes directly to the 'A' format column */
+
+ if (incre == twidth)
+ ffpbyt(fptr, ntodo, &array[next], status);
+ else
+ ffpbytoff(fptr, twidth, ntodo/twidth, incre - twidth,
+ &array[next], status);
+ break;
+ }
+ else if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffs1fstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpclsb).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnsb( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ signed char *array, /* I - array of values to write */
+ signed char nulvalue, /* I - flag for undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpclsb(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood + 1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpclsb(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad + 1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpclsb(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffs1fi1(signed char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == -128.)
+ {
+ /* Instead of adding 128, it is more efficient */
+ /* to just flip the sign bit with the XOR operator */
+
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ( *(unsigned char *) &input[ii] ) ^ 0x80;
+ }
+ else if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] < 0)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = ( ((double) input[ii]) - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffs1fi2(signed char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii]; /* just copy input to output */
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (((double) input[ii]) - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffs1fi4(signed char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (INT32BIT) input[ii]; /* copy input to output */
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (((double) input[ii]) - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffs1fi8(signed char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffs1fr4(signed char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) (( ( (double) input[ii] ) - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffs1fr8(signed char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ( ( (double) input[ii] ) - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffs1fstr(signed char *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = ((double) input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcolu.c b/src/plugins/cfitsio/putcolu.c
new file mode 100644
index 0000000..90227f0
--- /dev/null
+++ b/src/plugins/cfitsio/putcolu.c
@@ -0,0 +1,629 @@
+/* This file, putcolu.c, contains routines that write data elements to */
+/* a FITS image or table. Writes null values. */
+
+/* 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 ffppru( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ int *status) /* IO - error status */
+/*
+ Write null values to the primary array.
+
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ ffpmsg("writing to compressed image is not supported");
+
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpclu(fptr, 2, row, firstelem, nelem, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpprn( fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ int *status) /* IO - error status */
+/*
+ Write null values to the primary array. (Doesn't support groups).
+
+*/
+{
+ long row = 1;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ ffpmsg("writing to compressed image is not supported");
+
+ return(*status = DATA_COMPRESSION_ERR);
+ }
+
+ ffpclu(fptr, 2, row, firstelem, nelem, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpclu( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelempar, /* I - number of values to write */
+ int *status) /* IO - error status */
+/*
+ Set elements of a table column to the appropriate null value for the column
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ This routine support COMPLEX and DOUBLE COMPLEX binary table columns, and
+ sets both the real and imaginary components of the element to a NaN.
+*/
+{
+ int tcode, maxelem, hdutype, writemode = 2, leng;
+ short i2null;
+ INT32BIT i4null;
+ long twidth, incre;
+ long ii;
+ LONGLONG largeelem, nelem, tnull, i8null;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, ntodo;
+ double scale, zero;
+ unsigned char i1null, lognul = 0;
+ char tform[20], *cstring = 0;
+ char message[FLEN_ERRMSG];
+ char snull[20]; /* the FITS null value */
+ long jbuff[2] = { -1, -1}; /* all bits set is equivalent to a NaN */
+ size_t buffsize;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ nelem = nelempar;
+
+ largeelem = firstelem;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+
+ /* note that writemode = 2 by default (not 1), so that the returned */
+ /* repeat and incre values will be the actual values for this column. */
+
+ /* If writing nulls to a variable length column then dummy data values */
+ /* must have already been written to the heap. */
+ /* We just have to overwrite the previous values with null values. */
+ /* Set writemode = 0 in this case, to test that values have been written */
+
+ fits_get_coltype(fptr, colnum, &tcode, NULL, NULL, status);
+ if (tcode < 0)
+ writemode = 0; /* this is a variable length column */
+
+ if (abs(tcode) >= TCOMPLEX)
+ { /* treat complex columns as pairs of numbers */
+ largeelem = (largeelem - 1) * 2 + 1;
+ nelem *= 2;
+ }
+
+ if (ffgcprll( fptr, colnum, firstrow, largeelem, nelem, writemode, &scale,
+ &zero, tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ {
+ if (snull[0] == ASCII_NULL_UNDEFINED)
+ {
+ ffpmsg(
+ "Null value string for ASCII table column is not defined (FTPCLU).");
+ return(*status = NO_NULL);
+ }
+
+ /* allocate buffer to hold the null string. Must write the entire */
+ /* width of the column (twidth bytes) to avoid possible problems */
+ /* with uninitialized FITS blocks, in case the field spans blocks */
+
+ buffsize = maxvalue(20, twidth);
+ cstring = (char *) malloc(buffsize);
+ if (!cstring)
+ return(*status = MEMORY_ALLOCATION);
+
+ memset(cstring, ' ', buffsize); /* initialize with blanks */
+
+ leng = strlen(snull);
+ if (hdutype == BINARY_TBL)
+ leng++; /* copy the terminator too in binary tables */
+
+ strncpy(cstring, snull, leng); /* copy null string to temp buffer */
+ }
+ else if ( tcode == TBYTE ||
+ tcode == TSHORT ||
+ tcode == TLONG ||
+ tcode == TLONGLONG)
+ {
+ if (tnull == NULL_UNDEFINED)
+ {
+ ffpmsg(
+ "Null value for integer table column is not defined (FTPCLU).");
+ return(*status = NO_NULL);
+ }
+
+ if (tcode == TBYTE)
+ i1null = (unsigned char) tnull;
+ else if (tcode == TSHORT)
+ {
+ i2null = (short) tnull;
+#if BYTESWAPPED
+ ffswap2(&i2null, 1); /* reverse order of bytes */
+#endif
+ }
+ else if (tcode == TLONG)
+ {
+ i4null = (INT32BIT) tnull;
+#if BYTESWAPPED
+ ffswap4(&i4null, 1); /* reverse order of bytes */
+#endif
+ }
+ else
+ {
+ i8null = tnull;
+#if BYTESWAPPED
+ ffswap4( (INT32BIT*) (&i8null), 2); /* reverse order of bytes */
+#endif
+ }
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+ ntodo = remain; /* number of elements to write at one time */
+
+ while (ntodo)
+ {
+ /* 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 = minvalue(ntodo, (repeat - elemnum));
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TBYTE):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 1, &i1null, status);
+ break;
+
+ case (TSHORT):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 2, &i2null, status);
+ break;
+
+ case (TLONG):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 4, &i4null, status);
+ break;
+
+ case (TLONGLONG):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 8, &i8null, status);
+ break;
+
+ case (TFLOAT):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 4, jbuff, status);
+ break;
+
+ case (TDOUBLE):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 8, jbuff, status);
+ break;
+
+ case (TLOGICAL):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 1, &lognul, status);
+ break;
+
+ case (TSTRING): /* an ASCII table column */
+ /* repeat always = 1, so ntodo is also guaranteed to = 1 */
+ ffpbyt(fptr, twidth, cstring, status);
+ break;
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write null value to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ return(*status);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing %.0f thru %.0f of null values (ffpclu).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+
+ if (cstring)
+ free(cstring);
+
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ ntodo = remain; /* this is the maximum number to do in next loop */
+
+ } /* End of main while Loop */
+
+ if (cstring)
+ free(cstring);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcluc( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ int *status) /* IO - error status */
+/*
+ Set elements of a table column to the appropriate null value for the column
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ This routine does not do anything special in the case of COMPLEX table columns
+ (unlike the similar ffpclu routine). This routine is mainly for use by
+ ffpcne which already compensates for the effective doubling of the number of
+ elements in a complex column.
+*/
+{
+ int tcode, maxelem, hdutype, writemode = 2, leng;
+ short i2null;
+ INT32BIT i4null;
+ long twidth, incre;
+ long ii;
+ LONGLONG tnull, i8null;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, ntodo;
+ double scale, zero;
+ unsigned char i1null, lognul = 0;
+ char tform[20], *cstring = 0;
+ char message[FLEN_ERRMSG];
+ char snull[20]; /* the FITS null value */
+ long jbuff[2] = { -1, -1}; /* all bits set is equivalent to a NaN */
+ size_t buffsize;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+
+ /* note that writemode = 2 by default (not 1), so that the returned */
+ /* repeat and incre values will be the actual values for this column. */
+
+ /* If writing nulls to a variable length column then dummy data values */
+ /* must have already been written to the heap. */
+ /* We just have to overwrite the previous values with null values. */
+ /* Set writemode = 0 in this case, to test that values have been written */
+
+ fits_get_coltype(fptr, colnum, &tcode, NULL, NULL, status);
+ if (tcode < 0)
+ writemode = 0; /* this is a variable length column */
+
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, writemode, &scale,
+ &zero, tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ {
+ if (snull[0] == ASCII_NULL_UNDEFINED)
+ {
+ ffpmsg(
+ "Null value string for ASCII table column is not defined (FTPCLU).");
+ return(*status = NO_NULL);
+ }
+
+ /* allocate buffer to hold the null string. Must write the entire */
+ /* width of the column (twidth bytes) to avoid possible problems */
+ /* with uninitialized FITS blocks, in case the field spans blocks */
+
+ buffsize = maxvalue(20, twidth);
+ cstring = (char *) malloc(buffsize);
+ if (!cstring)
+ return(*status = MEMORY_ALLOCATION);
+
+ memset(cstring, ' ', buffsize); /* initialize with blanks */
+
+ leng = strlen(snull);
+ if (hdutype == BINARY_TBL)
+ leng++; /* copy the terminator too in binary tables */
+
+ strncpy(cstring, snull, leng); /* copy null string to temp buffer */
+
+ }
+ else if ( tcode == TBYTE ||
+ tcode == TSHORT ||
+ tcode == TLONG ||
+ tcode == TLONGLONG)
+ {
+ if (tnull == NULL_UNDEFINED)
+ {
+ ffpmsg(
+ "Null value for integer table column is not defined (FTPCLU).");
+ return(*status = NO_NULL);
+ }
+
+ if (tcode == TBYTE)
+ i1null = (unsigned char) tnull;
+ else if (tcode == TSHORT)
+ {
+ i2null = (short) tnull;
+#if BYTESWAPPED
+ ffswap2(&i2null, 1); /* reverse order of bytes */
+#endif
+ }
+ else if (tcode == TLONG)
+ {
+ i4null = (INT32BIT) tnull;
+#if BYTESWAPPED
+ ffswap4(&i4null, 1); /* reverse order of bytes */
+#endif
+ }
+ else
+ {
+ i8null = tnull;
+#if BYTESWAPPED
+ ffswap4( (INT32BIT*) &i8null, 2); /* reverse order of bytes */
+#endif
+ }
+ }
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+ ntodo = remain; /* number of elements to write at one time */
+
+ while (ntodo)
+ {
+ /* 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 = minvalue(ntodo, (repeat - elemnum));
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TBYTE):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 1, &i1null, status);
+ break;
+
+ case (TSHORT):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 2, &i2null, status);
+ break;
+
+ case (TLONG):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 4, &i4null, status);
+ break;
+
+ case (TLONGLONG):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 8, &i8null, status);
+ break;
+
+ case (TFLOAT):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 4, jbuff, status);
+ break;
+
+ case (TDOUBLE):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 8, jbuff, status);
+ break;
+
+ case (TLOGICAL):
+
+ for (ii = 0; ii < ntodo; ii++)
+ ffpbyt(fptr, 1, &lognul, status);
+ break;
+
+ case (TSTRING): /* an ASCII table column */
+ /* repeat always = 1, so ntodo is also guaranteed to = 1 */
+ ffpbyt(fptr, twidth, cstring, status);
+ break;
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write null value to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ return(*status);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing %.0f thru %.0f of null values (ffpclu).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+
+ if (cstring)
+ free(cstring);
+
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ ntodo = remain; /* this is the maximum number to do in next loop */
+
+ } /* End of main while Loop */
+
+ if (cstring)
+ free(cstring);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffprwu(fitsfile *fptr,
+ LONGLONG firstrow,
+ LONGLONG nrows,
+ int *status)
+
+/*
+ * fits_write_nullrows / ffprwu - write TNULLs to all columns in one or more rows
+ *
+ * fitsfile *fptr - pointer to FITS HDU opened for read/write
+ * long int firstrow - first table row to set to null. (firstrow >= 1)
+ * long int nrows - total number or rows to set to null. (nrows >= 1)
+ * int *status - upon return, *status contains CFITSIO status code
+ *
+ * RETURNS: CFITSIO status code
+ *
+ * written by Craig Markwardt, GSFC
+ */
+{
+ LONGLONG ntotrows;
+ int ncols, i;
+ int typecode = 0;
+ LONGLONG repeat = 0, width = 0;
+ int nullstatus;
+
+ if (*status > 0) return *status;
+
+ if ((firstrow <= 0) || (nrows <= 0)) return (*status = BAD_ROW_NUM);
+
+ fits_get_num_rowsll(fptr, &ntotrows, status);
+
+ if (firstrow + nrows - 1 > ntotrows) return (*status = BAD_ROW_NUM);
+
+ fits_get_num_cols(fptr, &ncols, status);
+ if (*status) return *status;
+
+
+ /* Loop through each column and write nulls */
+ for (i=1; i <= ncols; i++) {
+ repeat = 0; typecode = 0; width = 0;
+ fits_get_coltypell(fptr, i, &typecode, &repeat, &width, status);
+ if (*status) break;
+
+ /* NOTE: data of TSTRING type must not write the total repeat
+ count, since the repeat count is the *character* count, not the
+ nstring count. Divide by string width to get number of
+ strings. */
+
+ if (typecode == TSTRING) repeat /= width;
+
+ /* Write NULLs */
+ nullstatus = 0;
+ fits_write_col_null(fptr, i, firstrow, 1, repeat*nrows, &nullstatus);
+
+ /* ignore error if no null value is defined for the column */
+ if (nullstatus && nullstatus != NO_NULL) return (*status = nullstatus);
+
+ }
+
+ return *status;
+}
+
diff --git a/src/plugins/cfitsio/putcolui.c b/src/plugins/cfitsio/putcolui.c
new file mode 100644
index 0000000..e52b176
--- /dev/null
+++ b/src/plugins/cfitsio/putcolui.c
@@ -0,0 +1,969 @@
+/* This file, putcolui.c, contains routines that write data elements to */
+/* a FITS image or table, with unsigned short 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffpprui(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write (1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned short *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+ unsigned short nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_pixels(fptr, TUSHORT, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpclui(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppnui(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned short *array, /* I - array of values that are written */
+ unsigned short nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+ unsigned short nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TUSHORT, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcnui(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2dui(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ unsigned short *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3dui(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3dui(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ unsigned short *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TUSHORT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpclui(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpclui(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpssui(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ unsigned short *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TUSHORT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpclui(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpui( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ unsigned short *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpclui(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpclui( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned short *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table with
+ 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TSHORT):
+
+ ffu2fi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TLONGLONG):
+
+ ffu2fi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TBYTE):
+
+ ffu2fi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ break;
+
+ case (TLONG):
+
+ ffu2fi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ break;
+
+ case (TFLOAT):
+
+ ffu2fr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffu2fr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffu2fstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpclui).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnui(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned short *array, /* I - array of values to write */
+ unsigned short nulvalue, /* I - value used to flag undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpclui(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpclui(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpclui(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu2fi1(unsigned short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = ((double) input[ii] - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu2fi2(unsigned short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 32768.)
+ {
+ /* Instead of subtracting 32768, it is more efficient */
+ /* to just flip the sign bit with the XOR operator */
+
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ( *(short *) &input[ii] ) ^ 0x8000;
+ }
+ else if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = ((double) input[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu2fi4(unsigned short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (INT32BIT) input[ii]; /* copy input to output */
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = ((double) input[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu2fi8(unsigned short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu2fr4(unsigned short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) (((double) input[ii] - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu2fr8(unsigned short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ((double) input[ii] - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu2fstr(unsigned short *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = ((double) input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcoluj.c b/src/plugins/cfitsio/putcoluj.c
new file mode 100644
index 0000000..9f89f10
--- /dev/null
+++ b/src/plugins/cfitsio/putcoluj.c
@@ -0,0 +1,977 @@
+/* This file, putcoluj.c, contains routines that write data elements to */
+/* a FITS image or table, with unsigned long 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffppruj( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned long *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+ unsigned long nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_pixels(fptr, TULONG, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcluj(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppnuj( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned long *array, /* I - array of values that are written */
+ unsigned long nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+ unsigned long nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TULONG, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcnuj(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2duj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ unsigned long *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3duj(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3duj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ unsigned long *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TULONG, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpcluj(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpcluj(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpssuj(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ unsigned long *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TULONG, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpcluj(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpuj( fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ unsigned long *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpcluj(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcluj( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned long *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TLONG):
+
+ ffu4fi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ break;
+
+ case (TLONGLONG):
+
+ ffu4fi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TBYTE):
+
+ ffu4fi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ break;
+
+ case (TSHORT):
+
+ ffu4fi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TFLOAT):
+
+ ffu4fr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffu4fr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffu4fstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpcluj).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnuj( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned long *array, /* I - array of values to write */
+ unsigned long nulvalue, /* I - value used to flag undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpcluj(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpcluj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpcluj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu4fi1(unsigned long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu4fi2(unsigned long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = (short) input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu4fi4(unsigned long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 2147483648. && sizeof(long) == 4)
+ {
+ /* Instead of subtracting 2147483648, it is more efficient */
+ /* to just flip the sign bit with the XOR operator */
+
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ( *(long *) &input[ii] ) ^ 0x80000000;
+ }
+ else if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] > INT32_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu4fi8(unsigned long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu4fr4(unsigned long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) ((input[ii] - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu4fr8(unsigned long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (input[ii] - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffu4fstr(unsigned long *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putcoluk.c b/src/plugins/cfitsio/putcoluk.c
new file mode 100644
index 0000000..dd92fe3
--- /dev/null
+++ b/src/plugins/cfitsio/putcoluk.c
@@ -0,0 +1,993 @@
+/* This file, putcolk.c, contains routines that write data elements to */
+/* a FITS image or table, with 'unsigned int' 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 <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffppruk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned int *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+ unsigned int nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_pixels(fptr, TUINT, firstelem, nelem,
+ 0, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcluk(fptr, 2, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffppnuk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned int *array, /* I - array of values that are written */
+ unsigned int nulval, /* I - undefined pixel value */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written). Any array values
+ that are equal to the value of nulval will be replaced with the null
+ pixel value that is appropriate for this column.
+*/
+{
+ long row;
+ unsigned int nullvalue;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ nullvalue = nulval; /* set local variable */
+ fits_write_compressed_pixels(fptr, TUINT, firstelem, nelem,
+ 1, array, &nullvalue, status);
+ return(*status);
+ }
+
+ row=maxvalue(1,group);
+
+ ffpcnuk(fptr, 2, row, firstelem, nelem, array, nulval, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp2duk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ unsigned int *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 2-D array of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ /* call the 3D writing routine, with the 3rd dimension = 1 */
+
+ ffp3duk(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffp3duk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ LONGLONG ncols, /* I - number of pixels in each row of array */
+ LONGLONG nrows, /* I - number of rows in each plane of array */
+ LONGLONG naxis1, /* I - FITS image NAXIS1 value */
+ LONGLONG naxis2, /* I - FITS image NAXIS2 value */
+ LONGLONG naxis3, /* I - FITS image NAXIS3 value */
+ unsigned int *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write an entire 3-D cube of values to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of the
+ FITS array is not the same as the array being written).
+*/
+{
+ long tablerow, ii, jj;
+ long fpixel[3]= {1,1,1}, lpixel[3];
+ LONGLONG nfits, narray;
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+ lpixel[0] = (long) ncols;
+ lpixel[1] = (long) nrows;
+ lpixel[2] = (long) naxis3;
+
+ fits_write_compressed_img(fptr, TUINT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ tablerow=maxvalue(1,group);
+
+ if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
+ {
+ /* all the image pixels are contiguous, so write all at once */
+ ffpcluk(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
+ return(*status);
+ }
+
+ if (ncols < naxis1 || nrows < naxis2)
+ return(*status = BAD_DIMEN);
+
+ nfits = 1; /* next pixel in FITS image to write to */
+ narray = 0; /* next pixel in input array to be written */
+
+ /* loop over naxis3 planes in the data cube */
+ for (jj = 0; jj < naxis3; jj++)
+ {
+ /* loop over the naxis2 rows in the FITS image, */
+ /* writing naxis1 pixels to each row */
+
+ for (ii = 0; ii < naxis2; ii++)
+ {
+ if (ffpcluk(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
+ return(*status);
+
+ nfits += naxis1;
+ narray += ncols;
+ }
+ narray += (nrows - naxis2) * ncols;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpssuk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long naxis, /* I - number of data axes in array */
+ long *naxes, /* I - size of each FITS axis */
+ long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
+ long *lpixel, /* I - last pixel in each axis to write */
+ unsigned int *array, /* I - array to be written */
+ int *status) /* IO - error status */
+/*
+ Write a subsection of pixels to the primary array or image.
+ A subsection is defined to be any contiguous rectangular
+ array of pixels within the n-dimensional FITS data file.
+ Data conversion and scaling will be performed if necessary
+ (e.g, if the datatype of the FITS array is not the same as
+ the array being written).
+*/
+{
+ long tablerow;
+ LONGLONG fpix[7], dimen[7], astart, pstart;
+ LONGLONG off2, off3, off4, off5, off6, off7;
+ LONGLONG st10, st20, st30, st40, st50, st60, st70;
+ LONGLONG st1, st2, st3, st4, st5, st6, st7;
+ long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fits_is_compressed_image(fptr, status))
+ {
+ /* this is a compressed image in a binary table */
+
+ fits_write_compressed_img(fptr, TUINT, fpixel, lpixel,
+ 0, array, NULL, status);
+
+ return(*status);
+ }
+
+ if (naxis < 1 || naxis > 7)
+ return(*status = BAD_DIMEN);
+
+ tablerow=maxvalue(1,group);
+
+ /* calculate the size and number of loops to perform in each dimension */
+ for (ii = 0; ii < 7; ii++)
+ {
+ fpix[ii]=1;
+ irange[ii]=1;
+ dimen[ii]=1;
+ }
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ fpix[ii]=fpixel[ii];
+ irange[ii]=lpixel[ii]-fpixel[ii]+1;
+ dimen[ii]=naxes[ii];
+ }
+
+ i1=irange[0];
+
+ /* compute the pixel offset between each dimension */
+ off2 = dimen[0];
+ off3 = off2 * dimen[1];
+ off4 = off3 * dimen[2];
+ off5 = off4 * dimen[3];
+ off6 = off5 * dimen[4];
+ off7 = off6 * dimen[5];
+
+ st10 = fpix[0];
+ st20 = (fpix[1] - 1) * off2;
+ st30 = (fpix[2] - 1) * off3;
+ st40 = (fpix[3] - 1) * off4;
+ st50 = (fpix[4] - 1) * off5;
+ st60 = (fpix[5] - 1) * off6;
+ st70 = (fpix[6] - 1) * off7;
+
+ /* store the initial offset in each dimension */
+ st1 = st10;
+ st2 = st20;
+ st3 = st30;
+ st4 = st40;
+ st5 = st50;
+ st6 = st60;
+ st7 = st70;
+
+ astart = 0;
+
+ for (i7 = 0; i7 < irange[6]; i7++)
+ {
+ for (i6 = 0; i6 < irange[5]; i6++)
+ {
+ for (i5 = 0; i5 < irange[4]; i5++)
+ {
+ for (i4 = 0; i4 < irange[3]; i4++)
+ {
+ for (i3 = 0; i3 < irange[2]; i3++)
+ {
+ pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
+
+ for (i2 = 0; i2 < irange[1]; i2++)
+ {
+ if (ffpcluk(fptr, 2, tablerow, pstart, i1, &array[astart],
+ status) > 0)
+ return(*status);
+
+ astart += i1;
+ pstart += off2;
+ }
+ st2 = st20;
+ st3 = st3+off3;
+ }
+ st3 = st30;
+ st4 = st4+off4;
+ }
+ st4 = st40;
+ st5 = st5+off5;
+ }
+ st5 = st50;
+ st6 = st6+off6;
+ }
+ st6 = st60;
+ st7 = st7+off7;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpgpuk(fitsfile *fptr, /* I - FITS file pointer */
+ long group, /* I - group to write(1 = 1st group) */
+ long firstelem, /* I - first vector element to write(1 = 1st) */
+ long nelem, /* I - number of values to write */
+ unsigned int *array, /* I - array of values that are written */
+ int *status) /* IO - error status */
+/*
+ Write an array of group parameters to the primary array. Data conversion
+ and scaling will be performed if necessary (e.g, if the datatype of
+ the FITS array is not the same as the array being written).
+*/
+{
+ long row;
+
+ /*
+ the primary array is represented as a binary table:
+ each group of the primary array is a row in the table,
+ where the first column contains the group parameters
+ and the second column contains the image itself.
+ */
+
+ row=maxvalue(1,group);
+
+ ffpcluk(fptr, 1L, row, firstelem, nelem, array, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcluk(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned int *array, /* I - array of values to write */
+ int *status) /* IO - error status */
+/*
+ Write an array of values to a column in the current FITS HDU.
+ The column number may refer to a real column in an ASCII or binary table,
+ or it may refer to a virtual column in a 1 or more grouped FITS primary
+ array. FITSIO treats a primary array as a binary table
+ with 2 vector columns: the first column contains the group parameters (often
+ with length = 0) and the second column contains the array of image pixels.
+ Each row of the table represents a group in the case of multigroup FITS
+ images.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
+*/
+{
+ int tcode, maxelem, hdutype;
+ long twidth, incre;
+ long ntodo;
+ LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull;
+ double scale, zero;
+ char tform[20], cform[20];
+ char message[FLEN_ERRMSG];
+
+ char snull[20]; /* the FITS null value */
+
+ double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
+ void *buffer;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* call the 'short' or 'long' version of this routine, if possible */
+ if (sizeof(int) == sizeof(short))
+ ffpclui(fptr, colnum, firstrow, firstelem, nelem,
+ (unsigned short *) array, status);
+ else if (sizeof(int) == sizeof(long))
+ ffpcluj(fptr, colnum, firstrow, firstelem, nelem,
+ (unsigned long *) array, status);
+ else
+ {
+ /*
+ This is a special case: sizeof(int) is not equal to sizeof(short) or
+ sizeof(long). This occurs on Alpha OSF systems where short = 2 bytes,
+ int = 4 bytes, and long = 8 bytes.
+ */
+
+ buffer = cbuff;
+
+ /*---------------------------------------------------*/
+ /* Check input and get parameters about the column: */
+ /*---------------------------------------------------*/
+ if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
+ tform, &twidth, &tcode, &maxelem, &startpos, &elemnum, &incre,
+ &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
+ return(*status);
+
+ if (tcode == TSTRING)
+ ffcfmt(tform, cform); /* derive C format for writing strings */
+
+ /*---------------------------------------------------------------------*/
+ /* Now write the pixels to the FITS column. */
+ /* First call the ffXXfYY routine to (1) convert the datatype */
+ /* if necessary, and (2) scale the values by the FITS TSCALn and */
+ /* TZEROn linear scaling parameters into a temporary buffer. */
+ /*---------------------------------------------------------------------*/
+ remain = nelem; /* remaining number of values to write */
+ next = 0; /* next element in array to be written */
+ rownum = 0; /* row number, relative to firstrow */
+
+ while (remain)
+ {
+ /* limit the number of pixels to process a 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));
+
+ wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
+
+ ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
+
+ switch (tcode)
+ {
+ case (TLONG):
+ /* convert the raw data before writing to FITS file */
+ ffuintfi4(&array[next], ntodo, scale, zero,
+ (INT32BIT *) buffer, status);
+ ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
+ break;
+
+ case (TLONGLONG):
+
+ ffuintfi8(&array[next], ntodo, scale, zero,
+ (LONGLONG *) buffer, status);
+ ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
+ break;
+
+ case (TBYTE):
+
+ ffuintfi1(&array[next], ntodo, scale, zero,
+ (unsigned char *) buffer, status);
+ ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
+ break;
+
+ case (TSHORT):
+
+ ffuintfi2(&array[next], ntodo, scale, zero,
+ (short *) buffer, status);
+ ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
+ break;
+
+ case (TFLOAT):
+
+ ffuintfr4(&array[next], ntodo, scale, zero,
+ (float *) buffer, status);
+ ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
+ break;
+
+ case (TDOUBLE):
+ ffuintfr8(&array[next], ntodo, scale, zero,
+ (double *) buffer, status);
+ ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
+ break;
+
+ case (TSTRING): /* numerical column in an ASCII table */
+
+ if (cform[1] != 's') /* "%s" format is a string */
+ {
+ ffuintfstr(&array[next], ntodo, scale, zero, cform,
+ twidth, (char *) buffer, status);
+
+ if (incre == twidth) /* contiguous bytes */
+ ffpbyt(fptr, ntodo * twidth, buffer, status);
+ else
+ ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
+ status);
+
+ break;
+ }
+ /* can't write to string column, so fall thru to default: */
+
+ default: /* error trap */
+ sprintf(message,
+ "Cannot write numbers to column %d which has format %s",
+ colnum,tform);
+ ffpmsg(message);
+ if (hdutype == ASCII_TBL)
+ return(*status = BAD_ATABLE_FORMAT);
+ else
+ return(*status = BAD_BTABLE_FORMAT);
+
+ } /* End of switch block */
+
+ /*-------------------------*/
+ /* Check for fatal error */
+ /*-------------------------*/
+ if (*status > 0) /* test for error during previous write operation */
+ {
+ sprintf(message,
+ "Error writing elements %.0f thru %.0f of input data array (ffpcluk).",
+ (double) (next+1), (double) (next+ntodo));
+ ffpmsg(message);
+ return(*status);
+ }
+
+ /*--------------------------------------------*/
+ /* increment the counters for the next loop */
+ /*--------------------------------------------*/
+ remain -= ntodo;
+ if (remain)
+ {
+ next += ntodo;
+ elemnum += ntodo;
+ if (elemnum == repeat) /* completed a row; start on next row */
+ {
+ elemnum = 0;
+ rownum++;
+ }
+ }
+ } /* End of main while Loop */
+
+
+ /*--------------------------------*/
+ /* check for numerical overflow */
+ /*--------------------------------*/
+ if (*status == OVERFLOW_ERR)
+ {
+ ffpmsg(
+ "Numerical overflow during type conversion while writing FITS data.");
+ *status = NUM_OVERFLOW;
+ }
+
+ } /* end of Dec ALPHA special case */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpcnuk(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - number of column to write (1 = 1st col) */
+ LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
+ LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
+ LONGLONG nelem, /* I - number of values to write */
+ unsigned int *array, /* I - array of values to write */
+ unsigned int nulvalue, /* I - value used to flag undefined pixels */
+ int *status) /* IO - error status */
+/*
+ Write an array of elements to the specified column of a table. Any input
+ pixels equal to the value of nulvalue will be replaced by the appropriate
+ null value in the output FITS file.
+
+ The input array of values will be converted to the datatype of the column
+ and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
+*/
+{
+ tcolumn *colptr;
+ long ngood = 0, nbad = 0, ii;
+ LONGLONG repeat, first, fstelm, fstrow;
+ int tcode, overflow = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ {
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ }
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ {
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column */
+ colptr += (colnum - 1); /* offset to correct column structure */
+
+ tcode = colptr->tdatatype;
+
+ if (tcode > 0)
+ repeat = colptr->trepeat; /* repeat count for this column */
+ else
+ repeat = firstelem -1 + nelem; /* variable length arrays */
+
+ /* if variable length array, first write the whole input vector,
+ then go back and fill in the nulls */
+ if (tcode < 0) {
+ if (ffpcluk(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ /* ignore overflows, which are possibly the null pixel values */
+ /* overflow = 1; */
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+
+ /* absolute element number in the column */
+ first = (firstrow - 1) * repeat + firstelem;
+
+ for (ii = 0; ii < nelem; ii++)
+ {
+ if (array[ii] != nulvalue) /* is this a good pixel? */
+ {
+ if (nbad) /* write previous string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
+ return(*status);
+
+ nbad=0;
+ }
+
+ ngood = ngood +1; /* the consecutive number of good pixels */
+ }
+ else
+ {
+ if (ngood) /* write previous string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ if (ffpcluk(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
+ status) > 0) {
+ if (*status == NUM_OVERFLOW)
+ {
+ overflow = 1;
+ *status = 0;
+ } else {
+ return(*status);
+ }
+ }
+ }
+ ngood=0;
+ }
+
+ nbad = nbad +1; /* the consecutive number of bad pixels */
+ }
+ }
+
+ /* finished loop; now just write the last set of pixels */
+
+ if (ngood) /* write last string of good pixels */
+ {
+ fstelm = ii - ngood + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ if (tcode > 0) { /* variable length arrays have already been written */
+ ffpcluk(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
+ }
+ }
+ else if (nbad) /* write last string of bad pixels */
+ {
+ fstelm = ii - nbad + first; /* absolute element number */
+ fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
+ fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
+
+ ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
+ }
+
+ if (*status <= 0) {
+ if (overflow) {
+ *status = NUM_OVERFLOW;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffuintfi1(unsigned int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ unsigned char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] > UCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DUCHAR_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = 0;
+ }
+ else if (dvalue > DUCHAR_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = UCHAR_MAX;
+ }
+ else
+ output[ii] = (unsigned char) (dvalue + .5);
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffuintfi2(unsigned int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ short *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] > SHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DSHRT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MIN;
+ }
+ else if (dvalue > DSHRT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = SHRT_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (short) (dvalue + .5);
+ else
+ output[ii] = (short) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffuintfi4(unsigned int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ INT32BIT *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 2147483648.)
+ {
+ /* Instead of subtracting 2147483648, it is more efficient */
+ /* to just flip the sign bit with the XOR operator */
+
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = ( *(int *) &input[ii] ) ^ 0x80000000;
+ }
+ else if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ if (input[ii] > INT32_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ output[ii] = input[ii];
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DINT_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MIN;
+ }
+ else if (dvalue > DINT_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = INT32_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (INT32BIT) (dvalue + .5);
+ else
+ output[ii] = (INT32BIT) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffuintfi8(unsigned int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ LONGLONG *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required
+*/
+{
+ long ii;
+ double dvalue;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+
+ if (dvalue < DLONGLONG_MIN)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MIN;
+ }
+ else if (dvalue > DLONGLONG_MAX)
+ {
+ *status = OVERFLOW_ERR;
+ output[ii] = LONGLONG_MAX;
+ }
+ else
+ {
+ if (dvalue >= 0)
+ output[ii] = (LONGLONG) (dvalue + .5);
+ else
+ output[ii] = (LONGLONG) (dvalue - .5);
+ }
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffuintfr4(unsigned int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ float *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (float) ((input[ii] - zero) / scale);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffuintfr8(unsigned int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ double *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do datatype conversion and scaling if required.
+*/
+{
+ long ii;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (double) input[ii];
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ output[ii] = (input[ii] - zero) / scale;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffuintfstr(unsigned int *input, /* I - array of values to be converted */
+ long ntodo, /* I - number of elements in the array */
+ double scale, /* I - FITS TSCALn or BSCALE value */
+ double zero, /* I - FITS TZEROn or BZERO value */
+ char *cform, /* I - format for output string values */
+ long twidth, /* I - width of each field, in chars */
+ char *output, /* O - output array of converted values */
+ int *status) /* IO - error status */
+/*
+ Copy input to output prior to writing output to a FITS file.
+ Do scaling if required.
+*/
+{
+ long ii;
+ double dvalue;
+ char *cptr;
+
+ cptr = output;
+
+ if (scale == 1. && zero == 0.)
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ sprintf(output, cform, (double) input[ii]);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+ else
+ {
+ for (ii = 0; ii < ntodo; ii++)
+ {
+ dvalue = (input[ii] - zero) / scale;
+ sprintf(output, cform, dvalue);
+ output += twidth;
+
+ if (*output) /* if this char != \0, then overflow occurred */
+ *status = OVERFLOW_ERR;
+ }
+ }
+
+ /* replace any commas with periods (e.g., in French locale) */
+ while ((cptr = strchr(cptr, ','))) *cptr = '.';
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/putkey.c b/src/plugins/cfitsio/putkey.c
new file mode 100644
index 0000000..2a88096
--- /dev/null
+++ b/src/plugins/cfitsio/putkey.c
@@ -0,0 +1,3085 @@
+/* This file, putkey.c, contains routines that write keywords to */
+/* a FITS header. */
+
+/* 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 <ctype.h>
+#include <time.h>
+/* stddef.h is apparently needed to define size_t */
+#include <stddef.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int ffcrim(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 */
+/*
+ create an IMAGE extension following the current HDU. If the
+ current HDU is empty (contains no header keywords), then simply
+ write the required image (or primary array) keywords to the current
+ HDU.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ /* create new extension if current header is not empty */
+ if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+ ffcrhd(fptr, status);
+
+ /* write the required header keywords */
+ ffphpr(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcrimll(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 */
+/*
+ create an IMAGE extension following the current HDU. If the
+ current HDU is empty (contains no header keywords), then simply
+ write the required image (or primary array) keywords to the current
+ HDU.
+*/
+{
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ /* create new extension if current header is not empty */
+ if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+ ffcrhd(fptr, status);
+
+ /* write the required header keywords */
+ ffphprll(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffcrtb(fitsfile *fptr, /* I - FITS file pointer */
+ int tbltype, /* I - type of table to create */
+ 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 *extnm, /* I - value of EXTNAME keyword, if any */
+ int *status) /* IO - error status */
+/*
+ Create a table extension in a FITS file.
+*/
+{
+ LONGLONG naxis1 = 0;
+ long *tbcol = 0;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ /* create new extension if current header is not empty */
+ if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+ ffcrhd(fptr, status);
+
+ if ((fptr->Fptr)->curhdu == 0) /* have to create dummy primary array */
+ {
+ ffcrim(fptr, 16, 0, tbcol, status);
+ ffcrhd(fptr, status);
+ }
+
+ if (tbltype == BINARY_TBL)
+ {
+ /* write the required header keywords. This will write PCOUNT = 0 */
+ ffphbn(fptr, naxis2, tfields, ttype, tform, tunit, extnm, 0, status);
+ }
+ else if (tbltype == ASCII_TBL)
+ {
+ /* write the required header keywords */
+ /* default values for naxis1 and tbcol will be calculated */
+ ffphtb(fptr, naxis1, naxis2, tfields, ttype, tbcol, tform, tunit,
+ extnm, status);
+ }
+ else
+ *status = NOT_TABLE;
+
+ return(*status);
+}
+/*-------------------------------------------------------------------------*/
+int ffpktp(fitsfile *fptr, /* I - FITS file pointer */
+ const char *filename, /* I - name of template file */
+ int *status) /* IO - error status */
+/*
+ read keywords from template file and append to the FITS file
+*/
+{
+ FILE *diskfile;
+ char card[FLEN_CARD], template[161];
+ char keyname[FLEN_KEYWORD], newname[FLEN_KEYWORD];
+ int keytype;
+ size_t slen;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ diskfile = fopen(filename,"r");
+ if (!diskfile) /* couldn't open file */
+ {
+ ffpmsg("ffpktp could not open the following template file:");
+ ffpmsg(filename);
+ return(*status = FILE_NOT_OPENED);
+ }
+
+ while (fgets(template, 160, diskfile) ) /* get next template line */
+ {
+ template[160] = '\0'; /* make sure string is terminated */
+ slen = strlen(template); /* get string length */
+ template[slen - 1] = '\0'; /* over write the 'newline' char */
+
+ if (ffgthd(template, card, &keytype, status) > 0) /* parse template */
+ break;
+
+ strncpy(keyname, card, 8);
+ keyname[8] = '\0';
+
+ if (keytype == -2) /* rename the card */
+ {
+ strncpy(newname, &card[40], 8);
+ newname[8] = '\0';
+
+ ffmnam(fptr, keyname, newname, status);
+ }
+ else if (keytype == -1) /* delete the card */
+ {
+ ffdkey(fptr, keyname, status);
+ }
+ else if (keytype == 0) /* update the card */
+ {
+ ffucrd(fptr, keyname, card, status);
+ }
+ else if (keytype == 1) /* append the card */
+ {
+ ffprec(fptr, card, status);
+ }
+ else /* END card; stop here */
+ {
+ break;
+ }
+ }
+
+ fclose(diskfile); /* close the template file */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpky( fitsfile *fptr, /* I - FITS file pointer */
+ int datatype, /* I - datatype of the value */
+ const char *keyname, /* I - name of keyword to write */
+ void *value, /* I - keyword value */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes a keyword value with the datatype specified by the 2nd argument.
+*/
+{
+ char errmsg[81];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (datatype == TSTRING)
+ {
+ ffpkys(fptr, keyname, (char *) value, comm, status);
+ }
+ else if (datatype == TBYTE)
+ {
+ ffpkyj(fptr, keyname, (LONGLONG) *(unsigned char *) value, comm, status);
+ }
+ else if (datatype == TSBYTE)
+ {
+ ffpkyj(fptr, keyname, (LONGLONG) *(signed char *) value, comm, status);
+ }
+ else if (datatype == TUSHORT)
+ {
+ ffpkyj(fptr, keyname, (LONGLONG) *(unsigned short *) value, comm, status);
+ }
+ else if (datatype == TSHORT)
+ {
+ ffpkyj(fptr, keyname, (LONGLONG) *(short *) value, comm, status);
+ }
+ else if (datatype == TUINT)
+ {
+ ffpkyg(fptr, keyname, (double) *(unsigned int *) value, 0,
+ comm, status);
+ }
+ else if (datatype == TINT)
+ {
+ ffpkyj(fptr, keyname, (LONGLONG) *(int *) value, comm, status);
+ }
+ else if (datatype == TLOGICAL)
+ {
+ ffpkyl(fptr, keyname, *(int *) value, comm, status);
+ }
+ else if (datatype == TULONG)
+ {
+ ffpkyg(fptr, keyname, (double) *(unsigned long *) value, 0,
+ comm, status);
+ }
+ else if (datatype == TLONG)
+ {
+ ffpkyj(fptr, keyname, (LONGLONG) *(long *) value, comm, status);
+ }
+ else if (datatype == TLONGLONG)
+ {
+ ffpkyj(fptr, keyname, *(LONGLONG *) value, comm, status);
+ }
+ else if (datatype == TFLOAT)
+ {
+ ffpkye(fptr, keyname, *(float *) value, -7, comm, status);
+ }
+ else if (datatype == TDOUBLE)
+ {
+ ffpkyd(fptr, keyname, *(double *) value, -15, comm, status);
+ }
+ else if (datatype == TCOMPLEX)
+ {
+ ffpkyc(fptr, keyname, (float *) value, -7, comm, status);
+ }
+ else if (datatype == TDBLCOMPLEX)
+ {
+ ffpkym(fptr, keyname, (double *) value, -15, comm, status);
+ }
+ else
+ {
+ sprintf(errmsg, "Bad keyword datatype code: %d (ffpky)", datatype);
+ ffpmsg(errmsg);
+ *status = BAD_DATATYPE;
+ }
+
+ return(*status);
+}
+/*-------------------------------------------------------------------------*/
+int ffprec(fitsfile *fptr, /* I - FITS file pointer */
+ const char *card, /* I - string to be written */
+ int *status) /* IO - error status */
+/*
+ write a keyword record (80 bytes long) to the end of the header
+*/
+{
+ char tcard[FLEN_CARD];
+ size_t len, ii;
+ long nblocks;
+
+ 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 ( ((fptr->Fptr)->datastart - (fptr->Fptr)->headend) == 80) /* no room */
+ {
+ nblocks = 1;
+ if (ffiblk(fptr, nblocks, 0, status) > 0) /* insert 2880-byte block */
+ return(*status);
+ }
+
+ strncpy(tcard,card,80);
+ tcard[80] = '\0';
+
+ len = strlen(tcard);
+
+ /* silently replace any illegal characters with a space */
+ for (ii=0; ii < len; ii++)
+ if (tcard[ii] < ' ' || tcard[ii] > 126) tcard[ii] = ' ';
+
+ for (ii=len; ii < 80; ii++) /* fill card with spaces if necessary */
+ tcard[ii] = ' ';
+
+ for (ii=0; ii < 8; ii++) /* make sure keyword name is uppercase */
+ tcard[ii] = toupper(tcard[ii]);
+
+ fftkey(tcard, status); /* test keyword name contains legal chars */
+
+/* no need to do this any more, since any illegal characters have been removed
+ fftrec(tcard, status); */ /* test rest of keyword for legal chars */
+
+ ffmbyt(fptr, (fptr->Fptr)->headend, IGNORE_EOF, status); /* move to end */
+
+ ffpbyt(fptr, 80, tcard, status); /* write the 80 byte card */
+
+ if (*status <= 0)
+ (fptr->Fptr)->headend += 80; /* update end-of-header position */
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkyu( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) a null-valued keyword and comment into the FITS header.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ strcpy(valstring," "); /* create a dummy value string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword */
+ ffprec(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkys( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ char *value, /* I - keyword value */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ The value string will be truncated at 68 characters which is the
+ maximum length that will fit on a single FITS keyword.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffs2c(value, valstring, status); /* put quotes around the string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword */
+ ffprec(fptr, card, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkls( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ const char *value, /* I - keyword value */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ This routine is a modified version of ffpkys which supports the
+ HEASARC long string convention and can write arbitrarily long string
+ keyword values. The value is continued over multiple keywords that
+ have the name COMTINUE without an equal sign in column 9 of the card.
+ This routine also supports simple string keywords which are less than
+ 69 characters in length.
+*/
+{
+ char valstring[FLEN_CARD];
+ char card[FLEN_CARD], tmpkeyname[FLEN_CARD];
+ char tstring[FLEN_CARD], *cptr;
+ int next, remain, vlen, nquote, nchar, namelen, contin, tstatus = -1;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ remain = maxvalue(strlen(value), 1); /* no. of chars to write (at least 1) */
+ /* count the number of single quote characters are in the string */
+ tstring[0] = '\0';
+ strncat(tstring, value, 68); /* copy 1st part of string to temp buff */
+ nquote = 0;
+ cptr = strchr(tstring, '\''); /* search for quote character */
+ while (cptr) /* search for quote character */
+ {
+ nquote++; /* increment no. of quote characters */
+ cptr++; /* increment pointer to next character */
+ cptr = strchr(cptr, '\''); /* search for another quote char */
+ }
+
+ strncpy(tmpkeyname, keyname, 80);
+ tmpkeyname[80] = '\0';
+
+ cptr = tmpkeyname;
+ while(*cptr == ' ') /* skip over leading spaces in name */
+ cptr++;
+
+ /* determine the number of characters that will fit on the line */
+ /* Note: each quote character is expanded to 2 quotes */
+
+ namelen = strlen(cptr);
+ if (namelen <= 8 && (fftkey(cptr, &tstatus) <= 0) )
+ {
+ /* This a normal 8-character FITS keyword */
+ nchar = 68 - nquote; /* max of 68 chars fit in a FITS string value */
+ }
+ else
+ {
+ /* This a HIERARCH keyword */
+ if (FSTRNCMP(cptr, "HIERARCH ", 9) &&
+ FSTRNCMP(cptr, "hierarch ", 9))
+ nchar = 66 - nquote - namelen;
+ else
+ nchar = 75 - nquote - namelen; /* don't count 'HIERARCH' twice */
+
+ }
+
+ contin = 0;
+ next = 0; /* pointer to next character to write */
+
+ while (remain > 0)
+ {
+ tstring[0] = '\0';
+ strncat(tstring, &value[next], nchar); /* copy string to temp buff */
+ ffs2c(tstring, valstring, status); /* put quotes around the string */
+
+ if (remain > nchar) /* if string is continued, put & as last char */
+ {
+ vlen = strlen(valstring);
+ nchar -= 1; /* outputting one less character now */
+
+ if (valstring[vlen-2] != '\'')
+ valstring[vlen-2] = '&'; /* over write last char with & */
+ else
+ { /* last char was a pair of single quotes, so over write both */
+ valstring[vlen-3] = '&';
+ valstring[vlen-1] = '\0';
+ }
+ }
+
+ if (contin) /* This is a CONTINUEd keyword */
+ {
+ ffmkky("CONTINUE", valstring, comm, card, status); /* make keyword */
+ strncpy(&card[8], " ", 2); /* overwrite the '=' */
+ }
+ else
+ {
+ ffmkky(keyname, valstring, comm, card, status); /* make keyword */
+ }
+
+ ffprec(fptr, card, status); /* write the keyword */
+
+ contin = 1;
+ remain -= nchar;
+ next += nchar;
+
+ if (remain > 0)
+ {
+ /* count the number of single quote characters in next section */
+ tstring[0] = '\0';
+ strncat(tstring, &value[next], 68); /* copy next part of string */
+ nquote = 0;
+ cptr = strchr(tstring, '\''); /* search for quote character */
+ while (cptr) /* search for quote character */
+ {
+ nquote++; /* increment no. of quote characters */
+ cptr++; /* increment pointer to next character */
+ cptr = strchr(cptr, '\''); /* search for another quote char */
+ }
+ nchar = 68 - nquote; /* max number of chars to write this time */
+ }
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffplsw( fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ Write the LONGSTRN keyword and a series of related COMMENT keywords
+ which document that this FITS header may contain long string keyword
+ values which are continued over multiple keywords using the HEASARC
+ long string keyword convention. If the LONGSTRN keyword already exists
+ then this routine simple returns without doing anything.
+*/
+{
+ char valstring[FLEN_VALUE], comm[FLEN_COMMENT];
+ int tstatus;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ tstatus = 0;
+ if (ffgkys(fptr, "LONGSTRN", valstring, comm, &tstatus) == 0)
+ return(*status); /* keyword already exists, so just return */
+
+ ffpkys(fptr, "LONGSTRN", "OGIP 1.0",
+ "The HEASARC Long String Convention may be used.", status);
+
+ ffpcom(fptr,
+ " This FITS file may contain long string keyword values that are", status);
+
+ ffpcom(fptr,
+ " continued over multiple keywords. The HEASARC convention uses the &",
+ status);
+
+ ffpcom(fptr,
+ " character at the end of each substring which is then continued", status);
+
+ ffpcom(fptr,
+ " on the next keyword which has the name CONTINUE.", status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkyl( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ int value, /* I - keyword value */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Values equal to 0 will result in a False FITS keyword; any other
+ non-zero value will result in a True FITS keyword.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffl2c(value, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkyj( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ LONGLONG value, /* I - keyword value */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes an integer keyword value.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffi2c(value, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkyf( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ float value, /* I - keyword value */
+ int decim, /* I - number of decimal places to display */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes a fixed float keyword value.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffr2f(value, decim, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkye( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ float value, /* I - keyword value */
+ int decim, /* I - number of decimal places to display */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes an exponential float keyword value.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffr2e(value, decim, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkyg( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ double value, /* I - keyword value */
+ int decim, /* I - number of decimal places to display */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes a fixed double keyword value.*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffd2f(value, decim, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkyd( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ double value, /* I - keyword value */
+ int decim, /* I - number of decimal places to display */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes an exponential double keyword value.*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffd2e(value, decim, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkyc( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ float *value, /* I - keyword value (real, imaginary) */
+ int decim, /* I - number of decimal places to display */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes an complex float keyword value. Format = (realvalue, imagvalue)
+*/
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ strcpy(valstring, "(" );
+ ffr2e(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffr2e(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkym( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ double *value, /* I - keyword value (real, imaginary) */
+ int decim, /* I - number of decimal places to display */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes an complex double keyword value. Format = (realvalue, imagvalue)
+*/
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ strcpy(valstring, "(" );
+ ffd2e(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffd2e(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkfc( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ float *value, /* I - keyword value (real, imaginary) */
+ int decim, /* I - number of decimal places to display */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes an complex float keyword value. Format = (realvalue, imagvalue)
+*/
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ strcpy(valstring, "(" );
+ ffr2f(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffr2f(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkfm( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ double *value, /* I - keyword value (real, imaginary) */
+ int decim, /* I - number of decimal places to display */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) the keyword, value and comment into the FITS header.
+ Writes an complex double keyword value. Format = (realvalue, imagvalue)
+*/
+{
+ char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ strcpy(valstring, "(" );
+ ffd2f(value[0], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ", ");
+ ffd2f(value[1], decim, tmpstring, status); /* convert to string */
+ strcat(valstring, tmpstring);
+ strcat(valstring, ")");
+
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkyt( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyname, /* I - name of keyword to write */
+ long intval, /* I - integer part of value */
+ double fraction, /* I - fractional part of value */
+ const char *comm, /* I - keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) a 'triple' precision keyword where the integer and
+ fractional parts of the value are passed in separate parameters to
+ increase the total amount of numerical precision.
+*/
+{
+ char valstring[FLEN_VALUE];
+ char card[FLEN_CARD];
+ char fstring[20], *cptr;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (fraction > 1. || fraction < 0.)
+ {
+ ffpmsg("fraction must be between 0. and 1. (ffpkyt)");
+ return(*status = BAD_F2C);
+ }
+
+ ffi2c(intval, valstring, status); /* convert integer to string */
+ ffd2f(fraction, 16, fstring, status); /* convert to 16 decimal string */
+
+ cptr = strchr(fstring, '.'); /* find the decimal point */
+ strcat(valstring, cptr); /* append the fraction to the integer */
+
+ ffmkky(keyname, valstring, comm, card, status); /* construct the keyword*/
+ ffprec(fptr, card, status); /* write the keyword*/
+
+ return(*status);
+}
+/*-----------------------------------------------------------------*/
+int ffpcom( fitsfile *fptr, /* I - FITS file pointer */
+ const char *comm, /* I - comment string */
+ int *status) /* IO - error status */
+/*
+ Write 1 or more COMMENT keywords. If the comment string is too
+ long to fit on a single keyword (72 chars) then it will automatically
+ be continued on multiple CONTINUE keywords.
+*/
+{
+ char card[FLEN_CARD];
+ int len, ii;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ len = strlen(comm);
+ ii = 0;
+
+ for (; len > 0; len -= 72)
+ {
+ strcpy(card, "COMMENT ");
+ strncat(card, &comm[ii], 72);
+ ffprec(fptr, card, status);
+ ii += 72;
+ }
+
+ return(*status);
+}
+/*-----------------------------------------------------------------*/
+int ffphis( fitsfile *fptr, /* I - FITS file pointer */
+ const char *history, /* I - history string */
+ int *status) /* IO - error status */
+/*
+ Write 1 or more HISTORY keywords. If the history string is too
+ long to fit on a single keyword (72 chars) then it will automatically
+ be continued on multiple HISTORY keywords.
+*/
+{
+ char card[FLEN_CARD];
+ int len, ii;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ len = strlen(history);
+ ii = 0;
+
+ for (; len > 0; len -= 72)
+ {
+ strcpy(card, "HISTORY ");
+ strncat(card, &history[ii], 72);
+ ffprec(fptr, card, status);
+ ii += 72;
+ }
+
+ return(*status);
+}
+/*-----------------------------------------------------------------*/
+int ffpdat( fitsfile *fptr, /* I - FITS file pointer */
+ int *status) /* IO - error status */
+/*
+ Write the DATE keyword into the FITS header. If the keyword already
+ exists then the date will simply be updated in the existing keyword.
+*/
+{
+ int timeref;
+ char date[30], tmzone[10], card[FLEN_CARD];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ ffgstm(date, &timeref, status);
+
+ if (timeref) /* GMT not available on this machine */
+ strcpy(tmzone, " Local");
+ else
+ strcpy(tmzone, " UT");
+
+ strcpy(card, "DATE = '");
+ strcat(card, date);
+ strcat(card, "' / file creation date (YYYY-MM-DDThh:mm:ss");
+ strcat(card, tmzone);
+ strcat(card, ")");
+
+ ffucrd(fptr, "DATE", card, status);
+
+ return(*status);
+}
+/*-------------------------------------------------------------------*/
+int ffverifydate(int year, /* I - year (0 - 9999) */
+ int month, /* I - month (1 - 12) */
+ int day, /* I - day (1 - 31) */
+ int *status) /* IO - error status */
+/*
+ Verify that the date is valid
+*/
+{
+ int ndays[] = {0,31,28,31,30,31,30,31,31,30,31,30,31};
+ char errmsg[81];
+
+
+ if (year < 0 || year > 9999)
+ {
+ sprintf(errmsg,
+ "input year value = %d is out of range 0 - 9999", year);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+ else if (month < 1 || month > 12)
+ {
+ sprintf(errmsg,
+ "input month value = %d is out of range 1 - 12", month);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+
+ if (ndays[month] == 31) {
+ if (day < 1 || day > 31)
+ {
+ sprintf(errmsg,
+ "input day value = %d is out of range 1 - 31 for month %d", day, month);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+ } else if (ndays[month] == 30) {
+ if (day < 1 || day > 30)
+ {
+ sprintf(errmsg,
+ "input day value = %d is out of range 1 - 30 for month %d", day, month);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+ } else {
+ if (day < 1 || day > 28)
+ {
+ if (day == 29)
+ {
+ /* year is a leap year if it is divisible by 4 but not by 100,
+ except years divisible by 400 are leap years
+ */
+ if ((year % 4 == 0 && year % 100 != 0 ) || year % 400 == 0)
+ return (*status);
+
+ sprintf(errmsg,
+ "input day value = %d is out of range 1 - 28 for February %d (not leap year)", day, year);
+ ffpmsg(errmsg);
+ } else {
+ sprintf(errmsg,
+ "input day value = %d is out of range 1 - 28 (or 29) for February", day);
+ ffpmsg(errmsg);
+ }
+
+ return(*status = BAD_DATE);
+ }
+ }
+ return(*status);
+}
+/*-----------------------------------------------------------------*/
+int ffgstm( char *timestr, /* O - returned system date and time string */
+ int *timeref, /* O - GMT = 0, Local time = 1 */
+ int *status) /* IO - error status */
+/*
+ Returns the current date and time in format 'yyyy-mm-ddThh:mm:ss'.
+*/
+{
+ time_t tp;
+ struct tm *ptr;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ time(&tp);
+ ptr = gmtime(&tp); /* get GMT (= UTC) time */
+
+ if (timeref)
+ {
+ if (ptr)
+ *timeref = 0; /* returning GMT */
+ else
+ *timeref = 1; /* returning local time */
+ }
+
+ if (!ptr) /* GMT not available on this machine */
+ ptr = localtime(&tp);
+
+ strftime(timestr, 25, "%Y-%m-%dT%H:%M:%S", ptr);
+
+ return(*status);
+}
+/*-----------------------------------------------------------------*/
+int ffdt2s(int year, /* I - year (0 - 9999) */
+ int month, /* I - month (1 - 12) */
+ int day, /* I - day (1 - 31) */
+ char *datestr, /* O - date string: "YYYY-MM-DD" */
+ int *status) /* IO - error status */
+/*
+ Construct a date character string
+*/
+{
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ *datestr = '\0';
+
+ if (ffverifydate(year, month, day, status) > 0)
+ {
+ ffpmsg("invalid date (ffdt2s)");
+ return(*status);
+ }
+
+ if (year >= 1900 && year <= 1998) /* use old 'dd/mm/yy' format */
+ sprintf(datestr, "%.2d/%.2d/%.2d", day, month, year - 1900);
+
+ else /* use the new 'YYYY-MM-DD' format */
+ sprintf(datestr, "%.4d-%.2d-%.2d", year, month, day);
+
+ return(*status);
+}
+/*-----------------------------------------------------------------*/
+int ffs2dt(char *datestr, /* I - date string: "YYYY-MM-DD" or "dd/mm/yy" */
+ int *year, /* O - year (0 - 9999) */
+ int *month, /* O - month (1 - 12) */
+ int *day, /* O - day (1 - 31) */
+ int *status) /* IO - error status */
+/*
+ Parse a date character string into year, month, and day values
+*/
+{
+ int slen, lyear, lmonth, lday;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (year)
+ *year = 0;
+ if (month)
+ *month = 0;
+ if (day)
+ *day = 0;
+
+ if (!datestr)
+ {
+ ffpmsg("error: null input date string (ffs2dt)");
+ return(*status = BAD_DATE); /* Null datestr pointer ??? */
+ }
+
+ slen = strlen(datestr);
+
+ if (slen == 8 && datestr[2] == '/' && datestr[5] == '/')
+ {
+ if (isdigit((int) datestr[0]) && isdigit((int) datestr[1])
+ && isdigit((int) datestr[3]) && isdigit((int) datestr[4])
+ && isdigit((int) datestr[6]) && isdigit((int) datestr[7]) )
+ {
+ /* this is an old format string: "dd/mm/yy" */
+ lyear = atoi(&datestr[6]) + 1900;
+ lmonth = atoi(&datestr[3]);
+ lday = atoi(datestr);
+
+ if (year)
+ *year = lyear;
+ if (month)
+ *month = lmonth;
+ if (day)
+ *day = lday;
+ }
+ else
+ {
+ ffpmsg("input date string has illegal format (ffs2dt):");
+ ffpmsg(datestr);
+ return(*status = BAD_DATE);
+ }
+ }
+ else if (slen >= 10 && datestr[4] == '-' && datestr[7] == '-')
+ {
+ if (isdigit((int) datestr[0]) && isdigit((int) datestr[1])
+ && isdigit((int) datestr[2]) && isdigit((int) datestr[3])
+ && isdigit((int) datestr[5]) && isdigit((int) datestr[6])
+ && isdigit((int) datestr[8]) && isdigit((int) datestr[9]) )
+ {
+ if (slen > 10 && datestr[10] != 'T')
+ {
+ ffpmsg("input date string has illegal format (ffs2dt):");
+ ffpmsg(datestr);
+ return(*status = BAD_DATE);
+ }
+
+ /* this is a new format string: "yyyy-mm-dd" */
+ lyear = atoi(datestr);
+ lmonth = atoi(&datestr[5]);
+ lday = atoi(&datestr[8]);
+
+ if (year)
+ *year = lyear;
+ if (month)
+ *month = lmonth;
+ if (day)
+ *day = lday;
+ }
+ else
+ {
+ ffpmsg("input date string has illegal format (ffs2dt):");
+ ffpmsg(datestr);
+ return(*status = BAD_DATE);
+ }
+ }
+ else
+ {
+ ffpmsg("input date string has illegal format (ffs2dt):");
+ ffpmsg(datestr);
+ return(*status = BAD_DATE);
+ }
+
+
+ if (ffverifydate(lyear, lmonth, lday, status) > 0)
+ {
+ ffpmsg("invalid date (ffs2dt)");
+ }
+
+ return(*status);
+}
+/*-----------------------------------------------------------------*/
+int fftm2s(int year, /* I - year (0 - 9999) */
+ int month, /* I - month (1 - 12) */
+ int day, /* I - day (1 - 31) */
+ int hour, /* I - hour (0 - 23) */
+ int minute, /* I - minute (0 - 59) */
+ double second, /* I - second (0. - 60.9999999) */
+ int decimals, /* I - number of decimal points to write */
+ char *datestr, /* O - date string: "YYYY-MM-DDThh:mm:ss.ddd" */
+ /* or "hh:mm:ss.ddd" if year, month day = 0 */
+ int *status) /* IO - error status */
+/*
+ Construct a date and time character string
+*/
+{
+ int width;
+ char errmsg[81];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ *datestr='\0';
+
+ if (year != 0 || month != 0 || day !=0)
+ {
+ if (ffverifydate(year, month, day, status) > 0)
+ {
+ ffpmsg("invalid date (fftm2s)");
+ return(*status);
+ }
+ }
+
+ if (hour < 0 || hour > 23)
+ {
+ sprintf(errmsg,
+ "input hour value is out of range 0 - 23: %d (fftm2s)", hour);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+ else if (minute < 0 || minute > 59)
+ {
+ sprintf(errmsg,
+ "input minute value is out of range 0 - 59: %d (fftm2s)", minute);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+ else if (second < 0. || second >= 61)
+ {
+ sprintf(errmsg,
+ "input second value is out of range 0 - 60.999: %f (fftm2s)", second);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+ else if (decimals > 25)
+ {
+ sprintf(errmsg,
+ "input decimals value is out of range 0 - 25: %d (fftm2s)", decimals);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+
+ if (decimals == 0)
+ width = 2;
+ else
+ width = decimals + 3;
+
+ if (decimals < 0)
+ {
+ /* a negative decimals value means return only the date, not time */
+ sprintf(datestr, "%.4d-%.2d-%.2d", year, month, day);
+ }
+ else if (year == 0 && month == 0 && day == 0)
+ {
+ /* return only the time, not the date */
+ sprintf(datestr, "%.2d:%.2d:%0*.*f",
+ hour, minute, width, decimals, second);
+ }
+ else
+ {
+ /* return both the time and date */
+ sprintf(datestr, "%.4d-%.2d-%.2dT%.2d:%.2d:%0*.*f",
+ year, month, day, hour, minute, width, decimals, second);
+ }
+ return(*status);
+}
+/*-----------------------------------------------------------------*/
+int ffs2tm(char *datestr, /* I - date string: "YYYY-MM-DD" */
+ /* or "YYYY-MM-DDThh:mm:ss.ddd" */
+ /* or "dd/mm/yy" */
+ int *year, /* O - year (0 - 9999) */
+ int *month, /* O - month (1 - 12) */
+ int *day, /* O - day (1 - 31) */
+ int *hour, /* I - hour (0 - 23) */
+ int *minute, /* I - minute (0 - 59) */
+ double *second, /* I - second (0. - 60.9999999) */
+ int *status) /* IO - error status */
+/*
+ Parse a date character string into date and time values
+*/
+{
+ int slen;
+ char errmsg[81];
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (year)
+ *year = 0;
+ if (month)
+ *month = 0;
+ if (day)
+ *day = 0;
+ if (hour)
+ *hour = 0;
+ if (minute)
+ *minute = 0;
+ if (second)
+ *second = 0.;
+
+ if (!datestr)
+ {
+ ffpmsg("error: null input date string (ffs2tm)");
+ return(*status = BAD_DATE); /* Null datestr pointer ??? */
+ }
+
+ if (datestr[2] == '/' || datestr[4] == '-')
+ {
+ /* Parse the year, month, and date */
+ if (ffs2dt(datestr, year, month, day, status) > 0)
+ return(*status);
+
+ slen = strlen(datestr);
+ if (slen == 8 || slen == 10)
+ return(*status); /* OK, no time fields */
+ else if (slen < 19)
+ {
+ ffpmsg("input date string has illegal format:");
+ ffpmsg(datestr);
+ return(*status = BAD_DATE);
+ }
+
+ else if (datestr[10] == 'T' && datestr[13] == ':' && datestr[16] == ':')
+ {
+ if (isdigit((int) datestr[11]) && isdigit((int) datestr[12])
+ && isdigit((int) datestr[14]) && isdigit((int) datestr[15])
+ && isdigit((int) datestr[17]) && isdigit((int) datestr[18]) )
+ {
+ if (slen > 19 && datestr[19] != '.')
+ {
+ ffpmsg("input date string has illegal format:");
+ ffpmsg(datestr);
+ return(*status = BAD_DATE);
+ }
+
+ /* this is a new format string: "yyyy-mm-ddThh:mm:ss.dddd" */
+ if (hour)
+ *hour = atoi(&datestr[11]);
+
+ if (minute)
+ *minute = atoi(&datestr[14]);
+
+ if (second)
+ *second = atof(&datestr[17]);
+ }
+ else
+ {
+ ffpmsg("input date string has illegal format:");
+ ffpmsg(datestr);
+ return(*status = BAD_DATE);
+ }
+
+ }
+ }
+ else /* no date fields */
+ {
+ if (datestr[2] == ':' && datestr[5] == ':') /* time string */
+ {
+ if (isdigit((int) datestr[0]) && isdigit((int) datestr[1])
+ && isdigit((int) datestr[3]) && isdigit((int) datestr[4])
+ && isdigit((int) datestr[6]) && isdigit((int) datestr[7]) )
+ {
+ /* this is a time string: "hh:mm:ss.dddd" */
+ if (hour)
+ *hour = atoi(&datestr[0]);
+
+ if (minute)
+ *minute = atoi(&datestr[3]);
+
+ if (second)
+ *second = atof(&datestr[6]);
+ }
+ else
+ {
+ ffpmsg("input date string has illegal format:");
+ ffpmsg(datestr);
+ return(*status = BAD_DATE);
+ }
+
+ }
+ else
+ {
+ ffpmsg("input date string has illegal format:");
+ ffpmsg(datestr);
+ return(*status = BAD_DATE);
+ }
+
+ }
+
+ if (hour)
+ if (*hour < 0 || *hour > 23)
+ {
+ sprintf(errmsg,
+ "hour value is out of range 0 - 23: %d (ffs2tm)", *hour);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+
+ if (minute)
+ if (*minute < 0 || *minute > 59)
+ {
+ sprintf(errmsg,
+ "minute value is out of range 0 - 59: %d (ffs2tm)", *minute);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+
+ if (second)
+ if (*second < 0 || *second >= 61.)
+ {
+ sprintf(errmsg,
+ "second value is out of range 0 - 60.9999: %f (ffs2tm)", *second);
+ ffpmsg(errmsg);
+ return(*status = BAD_DATE);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgsdt( int *day, int *month, int *year, int *status )
+{
+/*
+ This routine is included for backward compatibility
+ with the Fortran FITSIO library.
+
+ ffgsdt : Get current System DaTe (GMT if available)
+
+ Return integer values of the day, month, and year
+
+ Function parameters:
+ day Day of the month
+ month Numerical month (1=Jan, etc.)
+ year Year (1999, 2000, etc.)
+ status output error status
+
+*/
+ time_t now;
+ struct tm *date;
+
+ now = time( NULL );
+ date = gmtime(&now); /* get GMT (= UTC) time */
+
+ if (!date) /* GMT not available on this machine */
+ {
+ date = localtime(&now);
+ }
+
+ *day = date->tm_mday;
+ *month = date->tm_mon + 1;
+ *year = date->tm_year + 1900; /* tm_year is defined as years since 1900 */
+ return( *status );
+}
+/*--------------------------------------------------------------------------*/
+int ffpkns( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyroot, /* I - root name of keywords to write */
+ int nstart, /* I - starting index number */
+ int nkey, /* I - number of keywords to write */
+ char *value[], /* I - array of pointers to keyword values */
+ char *comm[], /* I - array of pointers to keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NKEY -1) inclusive. Writes string keywords.
+ The value strings will be truncated at 68 characters, and the HEASARC
+ long string keyword convention is not supported by this routine.
+*/
+{
+ char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
+ int ii, jj, repeat, len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* check if first comment string is to be repeated for all the keywords */
+ /* by looking to see if the last non-blank character is a '&' char */
+
+ repeat = 0;
+
+ if (comm)
+ {
+ len = strlen(comm[0]);
+
+ while (len > 0 && comm[0][len - 1] == ' ')
+ len--; /* ignore trailing blanks */
+
+ if (comm[0][len - 1] == '&')
+ {
+ len = minvalue(len, FLEN_COMMENT);
+ tcomment[0] = '\0';
+ strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
+ repeat = 1;
+ }
+ }
+ else
+ {
+ repeat = 1;
+ tcomment[0] = '\0';
+ }
+
+ for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
+ {
+ ffkeyn(keyroot, jj, keyname, status);
+ if (repeat)
+ ffpkys(fptr, keyname, value[ii], tcomment, status);
+ else
+ ffpkys(fptr, keyname, value[ii], comm[ii], status);
+
+ if (*status > 0)
+ return(*status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpknl( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyroot, /* I - root name of keywords to write */
+ int nstart, /* I - starting index number */
+ int nkey, /* I - number of keywords to write */
+ int *value, /* I - array of keyword values */
+ char *comm[], /* I - array of pointers to keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NKEY -1) inclusive. Writes logical keywords
+ Values equal to zero will be written as a False FITS keyword value; any
+ other non-zero value will result in a True FITS keyword.
+*/
+{
+ char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
+ int ii, jj, repeat, len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* check if first comment string is to be repeated for all the keywords */
+ /* by looking to see if the last non-blank character is a '&' char */
+
+ repeat = 0;
+ if (comm)
+ {
+ len = strlen(comm[0]);
+
+ while (len > 0 && comm[0][len - 1] == ' ')
+ len--; /* ignore trailing blanks */
+
+ if (comm[0][len - 1] == '&')
+ {
+ len = minvalue(len, FLEN_COMMENT);
+ tcomment[0] = '\0';
+ strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
+ repeat = 1;
+ }
+ }
+ else
+ {
+ repeat = 1;
+ tcomment[0] = '\0';
+ }
+
+
+ for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
+ {
+ ffkeyn(keyroot, jj, keyname, status);
+
+ if (repeat)
+ ffpkyl(fptr, keyname, value[ii], tcomment, status);
+ else
+ ffpkyl(fptr, keyname, value[ii], comm[ii], status);
+
+ if (*status > 0)
+ return(*status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpknj( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyroot, /* I - root name of keywords to write */
+ int nstart, /* I - starting index number */
+ int nkey, /* I - number of keywords to write */
+ long *value, /* I - array of keyword values */
+ char *comm[], /* I - array of pointers to keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NKEY -1) inclusive. Write integer keywords
+*/
+{
+ char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
+ int ii, jj, repeat, len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* check if first comment string is to be repeated for all the keywords */
+ /* by looking to see if the last non-blank character is a '&' char */
+
+ repeat = 0;
+
+ if (comm)
+ {
+ len = strlen(comm[0]);
+
+ while (len > 0 && comm[0][len - 1] == ' ')
+ len--; /* ignore trailing blanks */
+
+ if (comm[0][len - 1] == '&')
+ {
+ len = minvalue(len, FLEN_COMMENT);
+ tcomment[0] = '\0';
+ strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
+ repeat = 1;
+ }
+ }
+ else
+ {
+ repeat = 1;
+ tcomment[0] = '\0';
+ }
+
+ for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
+ {
+ ffkeyn(keyroot, jj, keyname, status);
+ if (repeat)
+ ffpkyj(fptr, keyname, value[ii], tcomment, status);
+ else
+ ffpkyj(fptr, keyname, value[ii], comm[ii], status);
+
+ if (*status > 0)
+ return(*status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpknjj( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyroot, /* I - root name of keywords to write */
+ int nstart, /* I - starting index number */
+ int nkey, /* I - number of keywords to write */
+ LONGLONG *value, /* I - array of keyword values */
+ char *comm[], /* I - array of pointers to keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NKEY -1) inclusive. Write integer keywords
+*/
+{
+ char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
+ int ii, jj, repeat, len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* check if first comment string is to be repeated for all the keywords */
+ /* by looking to see if the last non-blank character is a '&' char */
+
+ repeat = 0;
+
+ if (comm)
+ {
+ len = strlen(comm[0]);
+
+ while (len > 0 && comm[0][len - 1] == ' ')
+ len--; /* ignore trailing blanks */
+
+ if (comm[0][len - 1] == '&')
+ {
+ len = minvalue(len, FLEN_COMMENT);
+ tcomment[0] = '\0';
+ strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
+ repeat = 1;
+ }
+ }
+ else
+ {
+ repeat = 1;
+ tcomment[0] = '\0';
+ }
+
+ for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
+ {
+ ffkeyn(keyroot, jj, keyname, status);
+ if (repeat)
+ ffpkyj(fptr, keyname, value[ii], tcomment, status);
+ else
+ ffpkyj(fptr, keyname, value[ii], comm[ii], status);
+
+ if (*status > 0)
+ return(*status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpknf( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyroot, /* I - root name of keywords to write */
+ int nstart, /* I - starting index number */
+ int nkey, /* I - number of keywords to write */
+ float *value, /* I - array of keyword values */
+ int decim, /* I - number of decimals to display */
+ char *comm[], /* I - array of pointers to keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NKEY -1) inclusive. Writes fixed float values.
+*/
+{
+ char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
+ int ii, jj, repeat, len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* check if first comment string is to be repeated for all the keywords */
+ /* by looking to see if the last non-blank character is a '&' char */
+
+ repeat = 0;
+
+ if (comm)
+ {
+ len = strlen(comm[0]);
+
+ while (len > 0 && comm[0][len - 1] == ' ')
+ len--; /* ignore trailing blanks */
+
+ if (comm[0][len - 1] == '&')
+ {
+ len = minvalue(len, FLEN_COMMENT);
+ tcomment[0] = '\0';
+ strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
+ repeat = 1;
+ }
+ }
+ else
+ {
+ repeat = 1;
+ tcomment[0] = '\0';
+ }
+
+ for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
+ {
+ ffkeyn(keyroot, jj, keyname, status);
+ if (repeat)
+ ffpkyf(fptr, keyname, value[ii], decim, tcomment, status);
+ else
+ ffpkyf(fptr, keyname, value[ii], decim, comm[ii], status);
+
+ if (*status > 0)
+ return(*status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkne( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyroot, /* I - root name of keywords to write */
+ int nstart, /* I - starting index number */
+ int nkey, /* I - number of keywords to write */
+ float *value, /* I - array of keyword values */
+ int decim, /* I - number of decimals to display */
+ char *comm[], /* I - array of pointers to keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NKEY -1) inclusive. Writes exponential float values.
+*/
+{
+ char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
+ int ii, jj, repeat, len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* check if first comment string is to be repeated for all the keywords */
+ /* by looking to see if the last non-blank character is a '&' char */
+
+ repeat = 0;
+
+ if (comm)
+ {
+ len = strlen(comm[0]);
+
+ while (len > 0 && comm[0][len - 1] == ' ')
+ len--; /* ignore trailing blanks */
+
+ if (comm[0][len - 1] == '&')
+ {
+ len = minvalue(len, FLEN_COMMENT);
+ tcomment[0] = '\0';
+ strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
+ repeat = 1;
+ }
+ }
+ else
+ {
+ repeat = 1;
+ tcomment[0] = '\0';
+ }
+
+ for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
+ {
+ ffkeyn(keyroot, jj, keyname, status);
+ if (repeat)
+ ffpkye(fptr, keyname, value[ii], decim, tcomment, status);
+ else
+ ffpkye(fptr, keyname, value[ii], decim, comm[ii], status);
+
+ if (*status > 0)
+ return(*status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpkng( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyroot, /* I - root name of keywords to write */
+ int nstart, /* I - starting index number */
+ int nkey, /* I - number of keywords to write */
+ double *value, /* I - array of keyword values */
+ int decim, /* I - number of decimals to display */
+ char *comm[], /* I - array of pointers to keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NKEY -1) inclusive. Writes fixed double values.
+*/
+{
+ char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
+ int ii, jj, repeat, len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* check if first comment string is to be repeated for all the keywords */
+ /* by looking to see if the last non-blank character is a '&' char */
+
+ repeat = 0;
+
+ if (comm)
+ {
+ len = strlen(comm[0]);
+
+ while (len > 0 && comm[0][len - 1] == ' ')
+ len--; /* ignore trailing blanks */
+
+ if (comm[0][len - 1] == '&')
+ {
+ len = minvalue(len, FLEN_COMMENT);
+ tcomment[0] = '\0';
+ strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
+ repeat = 1;
+ }
+ }
+ else
+ {
+ repeat = 1;
+ tcomment[0] = '\0';
+ }
+
+ for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
+ {
+ ffkeyn(keyroot, jj, keyname, status);
+ if (repeat)
+ ffpkyg(fptr, keyname, value[ii], decim, tcomment, status);
+ else
+ ffpkyg(fptr, keyname, value[ii], decim, comm[ii], status);
+
+ if (*status > 0)
+ return(*status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpknd( fitsfile *fptr, /* I - FITS file pointer */
+ const char *keyroot, /* I - root name of keywords to write */
+ int nstart, /* I - starting index number */
+ int nkey, /* I - number of keywords to write */
+ double *value, /* I - array of keyword values */
+ int decim, /* I - number of decimals to display */
+ char *comm[], /* I - array of pointers to keyword comment */
+ int *status) /* IO - error status */
+/*
+ Write (put) an indexed array of keywords with index numbers between
+ NSTART and (NSTART + NKEY -1) inclusive. Writes exponential double values.
+*/
+{
+ char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
+ int ii, jj, repeat, len;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ /* check if first comment string is to be repeated for all the keywords */
+ /* by looking to see if the last non-blank character is a '&' char */
+
+ repeat = 0;
+
+ if (comm)
+ {
+ len = strlen(comm[0]);
+
+ while (len > 0 && comm[0][len - 1] == ' ')
+ len--; /* ignore trailing blanks */
+
+ if (comm[0][len - 1] == '&')
+ {
+ len = minvalue(len, FLEN_COMMENT);
+ tcomment[0] = '\0';
+ strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
+ repeat = 1;
+ }
+ }
+ else
+ {
+ repeat = 1;
+ tcomment[0] = '\0';
+ }
+
+ for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
+ {
+ ffkeyn(keyroot, jj, keyname, status);
+ if (repeat)
+ ffpkyd(fptr, keyname, value[ii], decim, tcomment, status);
+ else
+ ffpkyd(fptr, keyname, value[ii], decim, comm[ii], status);
+
+ if (*status > 0)
+ return(*status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffptdm( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ int naxis, /* I - number of axes in the data array */
+ long naxes[], /* I - length of each data axis */
+ int *status) /* IO - error status */
+/*
+ write the TDIMnnn keyword describing the dimensionality of a column
+*/
+{
+ char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE], comm[FLEN_COMMENT];
+ char value[80], message[81];
+ int ii;
+ long totalpix = 1, repeat;
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (colnum < 1 || colnum > 999)
+ {
+ ffpmsg("column number is out of range 1 - 999 (ffptdm)");
+ return(*status = BAD_COL_NUM);
+ }
+
+ if (naxis < 1)
+ {
+ ffpmsg("naxis is less than 1 (ffptdm)");
+ return(*status = BAD_DIMEN);
+ }
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if ( (fptr->Fptr)->hdutype != BINARY_TBL)
+ {
+ ffpmsg(
+ "Error: The TDIMn keyword is only allowed in BINTABLE extensions (ffptdm)");
+ return(*status = NOT_BTABLE);
+ }
+
+ strcpy(tdimstr, "("); /* start constructing the TDIM value */
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (ii > 0)
+ strcat(tdimstr, ","); /* append the comma separator */
+
+ if (naxes[ii] < 0)
+ {
+ ffpmsg("one or more TDIM values are less than 0 (ffptdm)");
+ return(*status = BAD_TDIM);
+ }
+
+ sprintf(value, "%ld", naxes[ii]);
+ strcat(tdimstr, value); /* append the axis size */
+
+ totalpix *= naxes[ii];
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column structure */
+ colptr += (colnum - 1); /* point to the specified column number */
+
+ if ((long) colptr->trepeat != totalpix)
+ {
+ /* There is an apparent inconsistency between TDIMn and TFORMn. */
+ /* The colptr->trepeat value may be out of date, so re-read */
+ /* the TFORMn keyword to be sure. */
+
+ ffkeyn("TFORM", colnum, keyname, status); /* construct TFORMn name */
+ ffgkys(fptr, keyname, value, NULL, status); /* read TFORMn keyword */
+ ffbnfm(value, NULL, &repeat, NULL, status); /* parse the repeat count */
+
+ if (*status > 0 || repeat != totalpix)
+ {
+ sprintf(message,
+ "column vector length, %ld, does not equal TDIMn array size, %ld",
+ (long) colptr->trepeat, totalpix);
+ ffpmsg(message);
+ return(*status = BAD_TDIM);
+ }
+ }
+
+ strcat(tdimstr, ")" ); /* append the closing parenthesis */
+
+ strcpy(comm, "size of the multidimensional array");
+ ffkeyn("TDIM", colnum, keyname, status); /* construct TDIMn name */
+ ffpkys(fptr, keyname, tdimstr, comm, status); /* write the keyword */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffptdmll( fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number */
+ int naxis, /* I - number of axes in the data array */
+ LONGLONG naxes[], /* I - length of each data axis */
+ int *status) /* IO - error status */
+/*
+ write the TDIMnnn keyword describing the dimensionality of a column
+*/
+{
+ char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE], comm[FLEN_COMMENT];
+ char value[80], message[81];
+ int ii;
+ LONGLONG totalpix = 1, repeat;
+ tcolumn *colptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (colnum < 1 || colnum > 999)
+ {
+ ffpmsg("column number is out of range 1 - 999 (ffptdm)");
+ return(*status = BAD_COL_NUM);
+ }
+
+ if (naxis < 1)
+ {
+ ffpmsg("naxis is less than 1 (ffptdm)");
+ return(*status = BAD_DIMEN);
+ }
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+ else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
+ if ( ffrdef(fptr, status) > 0) /* rescan header */
+ return(*status);
+
+ if ( (fptr->Fptr)->hdutype != BINARY_TBL)
+ {
+ ffpmsg(
+ "Error: The TDIMn keyword is only allowed in BINTABLE extensions (ffptdm)");
+ return(*status = NOT_BTABLE);
+ }
+
+ strcpy(tdimstr, "("); /* start constructing the TDIM value */
+
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (ii > 0)
+ strcat(tdimstr, ","); /* append the comma separator */
+
+ if (naxes[ii] < 0)
+ {
+ ffpmsg("one or more TDIM values are less than 0 (ffptdm)");
+ return(*status = BAD_TDIM);
+ }
+
+ /* cast to double because the 64-bit int conversion character in */
+ /* sprintf is platform dependent ( %lld, %ld, %I64d ) */
+
+ sprintf(value, "%.0f", (double) naxes[ii]);
+
+ strcat(tdimstr, value); /* append the axis size */
+
+ totalpix *= naxes[ii];
+ }
+
+ colptr = (fptr->Fptr)->tableptr; /* point to first column structure */
+ colptr += (colnum - 1); /* point to the specified column number */
+
+ if ( colptr->trepeat != totalpix)
+ {
+ /* There is an apparent inconsistency between TDIMn and TFORMn. */
+ /* The colptr->trepeat value may be out of date, so re-read */
+ /* the TFORMn keyword to be sure. */
+
+ ffkeyn("TFORM", colnum, keyname, status); /* construct TFORMn name */
+ ffgkys(fptr, keyname, value, NULL, status); /* read TFORMn keyword */
+ ffbnfmll(value, NULL, &repeat, NULL, status); /* parse the repeat count */
+
+ if (*status > 0 || repeat != totalpix)
+ {
+ sprintf(message,
+ "column vector length, %.0f, does not equal TDIMn array size, %.0f",
+ (double) (colptr->trepeat), (double) totalpix);
+ ffpmsg(message);
+ return(*status = BAD_TDIM);
+ }
+ }
+
+ strcat(tdimstr, ")" ); /* append the closing parenthesis */
+
+ strcpy(comm, "size of the multidimensional array");
+ ffkeyn("TDIM", colnum, keyname, status); /* construct TDIMn name */
+ ffpkys(fptr, keyname, tdimstr, comm, status); /* write the keyword */
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffphps( fitsfile *fptr, /* I - FITS file pointer */
+ int bitpix, /* I - number of bits per data value pixel */
+ int naxis, /* I - number of axes in the data array */
+ long naxes[], /* I - length of each data axis */
+ int *status) /* IO - error status */
+/*
+ write STANDARD set of required primary header keywords
+*/
+{
+ int simple = 1; /* does file conform to FITS standard? 1/0 */
+ long pcount = 0; /* number of group parameters (usually 0) */
+ long gcount = 1; /* number of random groups (usually 1 or 0) */
+ int extend = 1; /* may FITS file have extensions? */
+
+ ffphpr(fptr, simple, bitpix, naxis, naxes, pcount, gcount, extend, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffphpsll( fitsfile *fptr, /* I - FITS file pointer */
+ int bitpix, /* I - number of bits per data value pixel */
+ int naxis, /* I - number of axes in the data array */
+ LONGLONG naxes[], /* I - length of each data axis */
+ int *status) /* IO - error status */
+/*
+ write STANDARD set of required primary header keywords
+*/
+{
+ int simple = 1; /* does file conform to FITS standard? 1/0 */
+ LONGLONG pcount = 0; /* number of group parameters (usually 0) */
+ LONGLONG gcount = 1; /* number of random groups (usually 1 or 0) */
+ int extend = 1; /* may FITS file have extensions? */
+
+ ffphprll(fptr, simple, bitpix, naxis, naxes, pcount, gcount, extend, status);
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffphpr( fitsfile *fptr, /* I - FITS file pointer */
+ int simple, /* I - does file conform to FITS standard? 1/0 */
+ int bitpix, /* I - number of bits per data value pixel */
+ int naxis, /* I - number of axes in the data array */
+ long naxes[], /* I - length of each data axis */
+ LONGLONG pcount, /* I - number of group parameters (usually 0) */
+ LONGLONG gcount, /* I - number of random groups (usually 1 or 0) */
+ int extend, /* I - may FITS file have extensions? */
+ int *status) /* IO - error status */
+/*
+ write required primary header keywords
+*/
+{
+ int ii;
+ LONGLONG naxesll[20];
+
+ for (ii = 0; (ii < naxis) && (ii < 20); ii++)
+ naxesll[ii] = naxes[ii];
+
+ ffphprll(fptr, simple, bitpix, naxis, naxesll, pcount, gcount,
+ extend, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffphprll( fitsfile *fptr, /* I - FITS file pointer */
+ int simple, /* I - does file conform to FITS standard? 1/0 */
+ int bitpix, /* I - number of bits per data value pixel */
+ int naxis, /* I - number of axes in the data array */
+ LONGLONG naxes[], /* I - length of each data axis */
+ LONGLONG pcount, /* I - number of group parameters (usually 0) */
+ LONGLONG gcount, /* I - number of random groups (usually 1 or 0) */
+ int extend, /* I - may FITS file have extensions? */
+ int *status) /* IO - error status */
+/*
+ write required primary header keywords
+*/
+{
+ int ii;
+ long longbitpix, tnaxes[20];
+ char name[FLEN_KEYWORD], comm[FLEN_COMMENT], message[FLEN_ERRMSG];
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+ return(*status = HEADER_NOT_EMPTY);
+
+ if (naxis != 0) /* never try to compress a null image */
+ {
+ if ( (fptr->Fptr)->request_compress_type )
+ {
+
+ for (ii = 0; ii < naxis; ii++)
+ tnaxes[ii] = (long) naxes[ii];
+
+ /* write header for a compressed image */
+ imcomp_init_table(fptr, bitpix, naxis, tnaxes, 1, status);
+ return(*status);
+ }
+ }
+
+ if ((fptr->Fptr)->curhdu == 0)
+ { /* write primary array header */
+ if (simple)
+ strcpy(comm, "file does conform to FITS standard");
+ else
+ strcpy(comm, "file does not conform to FITS standard");
+
+ ffpkyl(fptr, "SIMPLE", simple, comm, status);
+ }
+ else
+ { /* write IMAGE extension header */
+ strcpy(comm, "IMAGE extension");
+ ffpkys(fptr, "XTENSION", "IMAGE", comm, status);
+ }
+
+ longbitpix = bitpix;
+
+ /* test for the 3 special cases that represent unsigned integers */
+ if (longbitpix == USHORT_IMG)
+ longbitpix = SHORT_IMG;
+ else if (longbitpix == ULONG_IMG)
+ longbitpix = LONG_IMG;
+ else if (longbitpix == SBYTE_IMG)
+ longbitpix = BYTE_IMG;
+
+ if (longbitpix != BYTE_IMG && longbitpix != SHORT_IMG &&
+ longbitpix != LONG_IMG && longbitpix != LONGLONG_IMG &&
+ longbitpix != FLOAT_IMG && longbitpix != DOUBLE_IMG)
+ {
+ sprintf(message,
+ "Illegal value for BITPIX keyword: %d", bitpix);
+ ffpmsg(message);
+ return(*status = BAD_BITPIX);
+ }
+
+ strcpy(comm, "number of bits per data pixel");
+ if (ffpkyj(fptr, "BITPIX", longbitpix, comm, status) > 0)
+ return(*status);
+
+ if (naxis < 0 || naxis > 999)
+ {
+ sprintf(message,
+ "Illegal value for NAXIS keyword: %d", naxis);
+ ffpmsg(message);
+ return(*status = BAD_NAXIS);
+ }
+
+ strcpy(comm, "number of data axes");
+ ffpkyj(fptr, "NAXIS", naxis, comm, status);
+
+ strcpy(comm, "length of data axis ");
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (naxes[ii] < 0)
+ {
+ sprintf(message,
+ "Illegal negative value for NAXIS%d keyword: %.0f", ii + 1, (double) (naxes[ii]));
+ ffpmsg(message);
+ return(*status = BAD_NAXES);
+ }
+
+ sprintf(&comm[20], "%d", ii + 1);
+ ffkeyn("NAXIS", ii + 1, name, status);
+ ffpkyj(fptr, name, naxes[ii], comm, status);
+ }
+
+ if ((fptr->Fptr)->curhdu == 0) /* the primary array */
+ {
+ if (extend)
+ {
+ /* only write EXTEND keyword if value = true */
+ strcpy(comm, "FITS dataset may contain extensions");
+ ffpkyl(fptr, "EXTEND", extend, comm, status);
+ }
+
+ if (pcount < 0)
+ {
+ ffpmsg("pcount value is less than 0");
+ return(*status = BAD_PCOUNT);
+ }
+
+ else if (gcount < 1)
+ {
+ ffpmsg("gcount value is less than 1");
+ return(*status = BAD_GCOUNT);
+ }
+
+ else if (pcount > 0 || gcount > 1)
+ {
+ /* only write these keyword if non-standard values */
+ strcpy(comm, "random group records are present");
+ ffpkyl(fptr, "GROUPS", 1, comm, status);
+
+ strcpy(comm, "number of random group parameters");
+ ffpkyj(fptr, "PCOUNT", pcount, comm, status);
+
+ strcpy(comm, "number of random groups");
+ ffpkyj(fptr, "GCOUNT", gcount, comm, status);
+ }
+
+ /* write standard block of self-documentating comments */
+ ffprec(fptr,
+ "COMMENT FITS (Flexible Image Transport System) format is defined in 'Astronomy",
+ status);
+ ffprec(fptr,
+ "COMMENT and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H",
+ status);
+ }
+
+ else /* an IMAGE extension */
+
+ { /* image extension; cannot have random groups */
+ if (pcount != 0)
+ {
+ ffpmsg("image extensions must have pcount = 0");
+ *status = BAD_PCOUNT;
+ }
+
+ else if (gcount != 1)
+ {
+ ffpmsg("image extensions must have gcount = 1");
+ *status = BAD_GCOUNT;
+ }
+
+ else
+ {
+ strcpy(comm, "required keyword; must = 0");
+ ffpkyj(fptr, "PCOUNT", 0, comm, status);
+
+ strcpy(comm, "required keyword; must = 1");
+ ffpkyj(fptr, "GCOUNT", 1, comm, status);
+ }
+ }
+
+ /* Write the BSCALE and BZERO keywords, if an unsigned integer image */
+ if (bitpix == USHORT_IMG)
+ {
+ strcpy(comm, "offset data range to that of unsigned short");
+ ffpkyg(fptr, "BZERO", 32768., 0, comm, status);
+ strcpy(comm, "default scaling factor");
+ ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
+ }
+ else if (bitpix == ULONG_IMG)
+ {
+ strcpy(comm, "offset data range to that of unsigned long");
+ ffpkyg(fptr, "BZERO", 2147483648., 0, comm, status);
+ strcpy(comm, "default scaling factor");
+ ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
+ }
+ else if (bitpix == SBYTE_IMG)
+ {
+ strcpy(comm, "offset data range to that of signed byte");
+ ffpkyg(fptr, "BZERO", -128., 0, comm, status);
+ strcpy(comm, "default scaling factor");
+ ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffphtb(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 */
+/*
+ Put required Header keywords into the ASCII TaBle:
+*/
+{
+ int ii, ncols, gotmem = 0;
+ long rowlen; /* must be 'long' because it is passed to ffgabc */
+ char tfmt[30], name[FLEN_KEYWORD], comm[FLEN_COMMENT], extnm[FLEN_VALUE];
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if (*status > 0)
+ return(*status);
+ else if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+ return(*status = HEADER_NOT_EMPTY);
+ else if (naxis1 < 0)
+ return(*status = NEG_WIDTH);
+ else if (naxis2 < 0)
+ return(*status = NEG_ROWS);
+ else if (tfields < 0 || tfields > 999)
+ return(*status = BAD_TFIELDS);
+
+ extnm[0] = '\0';
+ if (extnmx)
+ strncat(extnm, extnmx, FLEN_VALUE-1);
+
+ rowlen = (long) naxis1;
+
+ if (!tbcol || !tbcol[0] || (!naxis1 && tfields)) /* spacing not defined? */
+ {
+ /* allocate mem for tbcol; malloc can 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);
+ }
+ }
+ ffpkys(fptr, "XTENSION", "TABLE", "ASCII table extension", status);
+ ffpkyj(fptr, "BITPIX", 8, "8-bit ASCII characters", status);
+ ffpkyj(fptr, "NAXIS", 2, "2-dimensional ASCII table", status);
+ ffpkyj(fptr, "NAXIS1", rowlen, "width of table in characters", status);
+ ffpkyj(fptr, "NAXIS2", naxis2, "number of rows in table", status);
+ ffpkyj(fptr, "PCOUNT", 0, "no group parameters (required keyword)", status);
+ ffpkyj(fptr, "GCOUNT", 1, "one data group (required keyword)", status);
+ ffpkyj(fptr, "TFIELDS", tfields, "number of fields in each row", status);
+
+ for (ii = 0; ii < tfields; ii++) /* loop over every column */
+ {
+ if ( *(ttype[ii]) ) /* optional TTYPEn keyword */
+ {
+ sprintf(comm, "label for field %3d", ii + 1);
+ ffkeyn("TTYPE", ii + 1, name, status);
+ ffpkys(fptr, name, ttype[ii], comm, status);
+ }
+
+ if (tbcol[ii] < 1 || tbcol[ii] > rowlen)
+ *status = BAD_TBCOL;
+
+ sprintf(comm, "beginning column of field %3d", ii + 1);
+ ffkeyn("TBCOL", ii + 1, name, status);
+ ffpkyj(fptr, name, tbcol[ii], comm, status);
+
+ strcpy(tfmt, tform[ii]); /* required TFORMn keyword */
+ ffupch(tfmt);
+ ffkeyn("TFORM", ii + 1, name, status);
+ ffpkys(fptr, name, tfmt, "Fortran-77 format of field", status);
+
+ if (tunit)
+ {
+ if (tunit[ii] && *(tunit[ii]) ) /* optional TUNITn keyword */
+ {
+ ffkeyn("TUNIT", ii + 1, name, status);
+ ffpkys(fptr, name, tunit[ii], "physical unit of field", status) ;
+ }
+ }
+
+ if (*status > 0)
+ break; /* abort loop on error */
+ }
+
+ if (extnm)
+ {
+ if (extnm[0]) /* optional EXTNAME keyword */
+ ffpkys(fptr, "EXTNAME", extnm,
+ "name of this ASCII table extension", status);
+ }
+
+ if (*status > 0)
+ ffpmsg("Failed to write ASCII table header keywords (ffphtb)");
+
+ if (gotmem)
+ free(tbcol);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffphbn(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 the variable length heap area */
+ int *status) /* IO - error status */
+/*
+ Put required Header keywords into the Binary Table:
+*/
+{
+ int ii, datatype, iread = 0;
+ long repeat, width;
+ LONGLONG naxis1;
+
+ char tfmt[30], name[FLEN_KEYWORD], comm[FLEN_COMMENT], extnm[FLEN_VALUE];
+ char *cptr;
+
+ if (*status > 0)
+ return(*status);
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+ return(*status = HEADER_NOT_EMPTY);
+ else if (naxis2 < 0)
+ return(*status = NEG_ROWS);
+ else if (pcount < 0)
+ return(*status = BAD_PCOUNT);
+ else if (tfields < 0 || tfields > 999)
+ return(*status = BAD_TFIELDS);
+
+ extnm[0] = '\0';
+ if (extnmx)
+ strncat(extnm, extnmx, FLEN_VALUE-1);
+
+ ffpkys(fptr, "XTENSION", "BINTABLE", "binary table extension", status);
+ ffpkyj(fptr, "BITPIX", 8, "8-bit bytes", status);
+ ffpkyj(fptr, "NAXIS", 2, "2-dimensional binary table", status);
+
+ naxis1 = 0;
+ for (ii = 0; ii < tfields; ii++) /* sum the width of each field */
+ {
+ ffbnfm(tform[ii], &datatype, &repeat, &width, status);
+
+ if (datatype == TSTRING)
+ naxis1 += repeat; /* one byte per char */
+ else if (datatype == TBIT)
+ naxis1 += (repeat + 7) / 8;
+ else if (datatype > 0)
+ naxis1 += repeat * (datatype / 10);
+ else if (tform[ii][0] == 'P' || tform[ii][1] == 'P')
+ /* this is a 'P' variable length descriptor (neg. datatype) */
+ naxis1 += 8;
+ else
+ /* this is a 'Q' variable length descriptor (neg. datatype) */
+ naxis1 += 16;
+
+ if (*status > 0)
+ break; /* abort loop on error */
+ }
+
+ ffpkyj(fptr, "NAXIS1", naxis1, "width of table in bytes", status);
+ ffpkyj(fptr, "NAXIS2", naxis2, "number of rows in table", status);
+
+ /*
+ the initial value of PCOUNT (= size of the variable length array heap)
+ should always be zero. If any variable length data is written, then
+ the value of PCOUNT will be updated when the HDU is closed
+ */
+ ffpkyj(fptr, "PCOUNT", 0, "size of special data area", status);
+ ffpkyj(fptr, "GCOUNT", 1, "one data group (required keyword)", status);
+ ffpkyj(fptr, "TFIELDS", tfields, "number of fields in each row", status);
+
+ for (ii = 0; ii < tfields; ii++) /* loop over every column */
+ {
+ if ( *(ttype[ii]) ) /* optional TTYPEn keyword */
+ {
+ sprintf(comm, "label for field %3d", ii + 1);
+ ffkeyn("TTYPE", ii + 1, name, status);
+ ffpkys(fptr, name, ttype[ii], comm, status);
+ }
+
+ strcpy(tfmt, tform[ii]); /* required TFORMn keyword */
+ ffupch(tfmt);
+
+ ffkeyn("TFORM", ii + 1, name, status);
+ strcpy(comm, "data format of field");
+
+ ffbnfm(tfmt, &datatype, &repeat, &width, status);
+
+ if (datatype == TSTRING)
+ {
+ strcat(comm, ": ASCII Character");
+
+ /* Do sanity check to see if an ASCII table format was used, */
+ /* e.g., 'A8' instead of '8A', or a bad unit width eg '8A9'. */
+ /* Don't want to return an error status, so write error into */
+ /* the keyword comment. */
+
+ cptr = strchr(tfmt,'A');
+ cptr++;
+
+ if (cptr)
+ iread = sscanf(cptr,"%ld", &width);
+
+ if (iread == 1 && (width > repeat))
+ {
+ if (repeat == 1)
+ strcpy(comm, "ERROR?? USING ASCII TABLE SYNTAX BY MISTAKE??");
+ else
+ strcpy(comm, "rAw FORMAT ERROR! UNIT WIDTH w > COLUMN WIDTH r");
+ }
+ }
+ else if (datatype == TBIT)
+ strcat(comm, ": BIT");
+ else if (datatype == TBYTE)
+ strcat(comm, ": BYTE");
+ else if (datatype == TLOGICAL)
+ strcat(comm, ": 1-byte LOGICAL");
+ else if (datatype == TSHORT)
+ strcat(comm, ": 2-byte INTEGER");
+ else if (datatype == TUSHORT)
+ strcat(comm, ": 2-byte INTEGER");
+ else if (datatype == TLONG)
+ strcat(comm, ": 4-byte INTEGER");
+ else if (datatype == TLONGLONG)
+ strcat(comm, ": 8-byte INTEGER");
+ else if (datatype == TULONG)
+ strcat(comm, ": 4-byte INTEGER");
+ else if (datatype == TFLOAT)
+ strcat(comm, ": 4-byte REAL");
+ else if (datatype == TDOUBLE)
+ strcat(comm, ": 8-byte DOUBLE");
+ else if (datatype == TCOMPLEX)
+ strcat(comm, ": COMPLEX");
+ else if (datatype == TDBLCOMPLEX)
+ strcat(comm, ": DOUBLE COMPLEX");
+ else if (datatype < 0)
+ strcat(comm, ": variable length array");
+
+ if (abs(datatype) == TSBYTE) /* signed bytes */
+ {
+ /* Replace the 'S' with an 'B' in the TFORMn code */
+ cptr = tfmt;
+ while (*cptr != 'S')
+ cptr++;
+
+ *cptr = 'B';
+ ffpkys(fptr, name, tfmt, comm, status);
+
+ /* write the TZEROn and TSCALn keywords */
+ ffkeyn("TZERO", ii + 1, name, status);
+ strcpy(comm, "offset for signed bytes");
+
+ ffpkyg(fptr, name, -128., 0, comm, status);
+
+ ffkeyn("TSCAL", ii + 1, name, status);
+ strcpy(comm, "data are not scaled");
+ ffpkyg(fptr, name, 1., 0, comm, status);
+ }
+ else if (abs(datatype) == TUSHORT)
+ {
+ /* Replace the 'U' with an 'I' in the TFORMn code */
+ cptr = tfmt;
+ while (*cptr != 'U')
+ cptr++;
+
+ *cptr = 'I';
+ ffpkys(fptr, name, tfmt, comm, status);
+
+ /* write the TZEROn and TSCALn keywords */
+ ffkeyn("TZERO", ii + 1, name, status);
+ strcpy(comm, "offset for unsigned integers");
+
+ ffpkyg(fptr, name, 32768., 0, comm, status);
+
+ ffkeyn("TSCAL", ii + 1, name, status);
+ strcpy(comm, "data are not scaled");
+ ffpkyg(fptr, name, 1., 0, comm, status);
+ }
+ else if (abs(datatype) == TULONG)
+ {
+ /* Replace the 'V' with an 'J' in the TFORMn code */
+ cptr = tfmt;
+ while (*cptr != 'V')
+ cptr++;
+
+ *cptr = 'J';
+ ffpkys(fptr, name, tfmt, comm, status);
+
+ /* write the TZEROn and TSCALn keywords */
+ ffkeyn("TZERO", ii + 1, name, status);
+ strcpy(comm, "offset for unsigned integers");
+
+ ffpkyg(fptr, name, 2147483648., 0, comm, status);
+
+ ffkeyn("TSCAL", ii + 1, name, status);
+ strcpy(comm, "data are not scaled");
+ ffpkyg(fptr, name, 1., 0, comm, status);
+ }
+ else
+ {
+ ffpkys(fptr, name, tfmt, comm, status);
+ }
+
+ if (tunit)
+ {
+ if (tunit[ii] && *(tunit[ii]) ) /* optional TUNITn keyword */
+ {
+ ffkeyn("TUNIT", ii + 1, name, status);
+ ffpkys(fptr, name, tunit[ii],
+ "physical unit of field", status);
+ }
+ }
+
+ if (*status > 0)
+ break; /* abort loop on error */
+ }
+
+ if (extnm)
+ {
+ if (extnm[0]) /* optional EXTNAME keyword */
+ ffpkys(fptr, "EXTNAME", extnm,
+ "name of this binary table extension", status);
+ }
+
+ if (*status > 0)
+ ffpmsg("Failed to write binary table header keywords (ffphbn)");
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffphext(fitsfile *fptr, /* I - FITS file pointer */
+ const char *xtensionx, /* I - value for the XTENSION keyword */
+ int bitpix, /* I - value for the BIXPIX keyword */
+ int naxis, /* I - value for the NAXIS keyword */
+ long naxes[], /* I - value for the NAXISn keywords */
+ LONGLONG pcount, /* I - value for the PCOUNT keyword */
+ LONGLONG gcount, /* I - value for the GCOUNT keyword */
+ int *status) /* IO - error status */
+/*
+ Put required Header keywords into a conforming extension:
+*/
+{
+ char message[FLEN_ERRMSG],comm[81], name[20], xtension[FLEN_VALUE];
+ int ii;
+
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ if (*status > 0)
+ return(*status);
+ else if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
+ return(*status = HEADER_NOT_EMPTY);
+
+ if (naxis < 0 || naxis > 999)
+ {
+ sprintf(message,
+ "Illegal value for NAXIS keyword: %d", naxis);
+ ffpmsg(message);
+ return(*status = BAD_NAXIS);
+ }
+
+ xtension[0] = '\0';
+ strncat(xtension, xtensionx, FLEN_VALUE-1);
+
+ ffpkys(fptr, "XTENSION", xtension, "extension type", status);
+ ffpkyj(fptr, "BITPIX", bitpix, "number of bits per data pixel", status);
+ ffpkyj(fptr, "NAXIS", naxis, "number of data axes", status);
+
+ strcpy(comm, "length of data axis ");
+ for (ii = 0; ii < naxis; ii++)
+ {
+ if (naxes[ii] < 0)
+ {
+ sprintf(message,
+ "Illegal negative value for NAXIS%d keyword: %.0f", ii + 1, (double) (naxes[ii]));
+ ffpmsg(message);
+ return(*status = BAD_NAXES);
+ }
+
+ sprintf(&comm[20], "%d", ii + 1);
+ ffkeyn("NAXIS", ii + 1, name, status);
+ ffpkyj(fptr, name, naxes[ii], comm, status);
+ }
+
+
+ ffpkyj(fptr, "PCOUNT", pcount, " ", status);
+ ffpkyj(fptr, "GCOUNT", gcount, " ", status);
+
+ if (*status > 0)
+ ffpmsg("Failed to write extension header keywords (ffphext)");
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffi2c(LONGLONG ival, /* I - value to be converted to a string */
+ char *cval, /* O - character string representation of the value */
+ int *status) /* IO - error status */
+/*
+ convert value to a null-terminated formatted string.
+*/
+{
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ cval[0] = '\0';
+
+#if defined(_MSC_VER)
+ /* Microsoft Visual C++ 6.0 uses '%I64d' syntax for 8-byte integers */
+ if (sprintf(cval, "%I64d", ival) < 0)
+
+#elif (USE_LL_SUFFIX == 1)
+ if (sprintf(cval, "%lld", ival) < 0)
+#else
+ if (sprintf(cval, "%ld", ival) < 0)
+#endif
+ {
+ ffpmsg("Error in ffi2c converting integer to string");
+ *status = BAD_I2C;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffl2c(int lval, /* I - value to be converted to a string */
+ char *cval, /* O - character string representation of the value */
+ int *status) /* IO - error status ) */
+/*
+ convert logical value to a null-terminated formatted string. If the
+ input value == 0, then the output character is the letter F, else
+ the output character is the letter T. The output string is null terminated.
+*/
+{
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (lval)
+ strcpy(cval,"T");
+ else
+ strcpy(cval,"F");
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffs2c(char *instr, /* I - null terminated input string */
+ char *outstr, /* O - null terminated quoted output string */
+ int *status) /* IO - error status */
+/*
+ convert an input string to a quoted string. Leading spaces
+ are significant. FITS string keyword values must be at least
+ 8 chars long so pad out string with spaces if necessary.
+ Example: km/s ==> 'km/s '
+ Single quote characters in the input string will be replace by
+ two single quote characters. e.g., o'brian ==> 'o''brian'
+*/
+{
+ size_t len, ii, jj;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ if (!instr) /* a null input pointer?? */
+ {
+ strcpy(outstr, "''"); /* a null FITS string */
+ return(*status);
+ }
+
+ outstr[0] = '\''; /* start output string with a quote */
+
+ len = strlen(instr);
+ if (len > 68)
+ len = 68; /* limit input string to 68 chars */
+
+ for (ii=0, jj=1; ii < len && jj < 69; ii++, jj++)
+ {
+ outstr[jj] = instr[ii]; /* copy each char from input to output */
+ if (instr[ii] == '\'')
+ {
+ jj++;
+ outstr[jj]='\''; /* duplicate any apostrophies in the input */
+ }
+ }
+
+ for (; jj < 9; jj++) /* pad string so it is at least 8 chars long */
+ outstr[jj] = ' ';
+
+ if (jj == 70) /* only occurs if the last char of string was a quote */
+ outstr[69] = '\0';
+ else
+ {
+ outstr[jj] = '\''; /* append closing quote character */
+ outstr[jj+1] = '\0'; /* terminate the string */
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr2f(float fval, /* I - value to be converted to a string */
+ int decim, /* I - number of decimal places to display */
+ char *cval, /* O - character string representation of the value */
+ int *status) /* IO - error status */
+/*
+ convert float value to a null-terminated F format string
+*/
+{
+ char *cptr;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ cval[0] = '\0';
+
+ if (decim < 0)
+ {
+ ffpmsg("Error in ffr2f: no. of decimal places < 0");
+ return(*status = BAD_DECIM);
+ }
+
+ if (sprintf(cval, "%.*f", decim, fval) < 0)
+ {
+ ffpmsg("Error in ffr2f converting float to string");
+ *status = BAD_F2C;
+ }
+
+ /* replace comma with a period (e.g. in French locale) */
+ if ( (cptr = strchr(cval, ','))) *cptr = '.';
+
+ /* test if output string is 'NaN', 'INDEF', or 'INF' */
+ if (strchr(cval, 'N'))
+ {
+ ffpmsg("Error in ffr2f: float value is a NaN or INDEF");
+ *status = BAD_F2C;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffr2e(float fval, /* I - value to be converted to a string */
+ int decim, /* I - number of decimal places to display */
+ char *cval, /* O - character string representation of the value */
+ int *status) /* IO - error status */
+/*
+ convert float value to a null-terminated exponential format string
+*/
+{
+ char *cptr;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ cval[0] = '\0';
+
+ if (decim < 0)
+ { /* use G format if decim is negative */
+ if ( sprintf(cval, "%.*G", -decim, fval) < 0)
+ {
+ ffpmsg("Error in ffr2e converting float to string");
+ *status = BAD_F2C;
+ }
+ else
+ {
+ /* test if E format was used, and there is no displayed decimal */
+ if ( !strchr(cval, '.') && strchr(cval,'E') )
+ {
+ /* reformat value with a decimal point and single zero */
+ if ( sprintf(cval, "%.1E", fval) < 0)
+ {
+ ffpmsg("Error in ffr2e converting float to string");
+ *status = BAD_F2C;
+ }
+
+ return(*status);
+ }
+ }
+ }
+ else
+ {
+ if ( sprintf(cval, "%.*E", decim, fval) < 0)
+ {
+ ffpmsg("Error in ffr2e converting float to string");
+ *status = BAD_F2C;
+ }
+ }
+
+ if (*status <= 0)
+ {
+ /* replace comma with a period (e.g. in French locale) */
+ if ( (cptr = strchr(cval, ','))) *cptr = '.';
+
+ /* test if output string is 'NaN', 'INDEF', or 'INF' */
+ if (strchr(cval, 'N'))
+ {
+ ffpmsg("Error in ffr2e: float value is a NaN or INDEF");
+ *status = BAD_F2C;
+ }
+ else if ( !strchr(cval, '.') && !strchr(cval,'E') )
+ {
+ /* add decimal point if necessary to distinquish from integer */
+ strcat(cval, ".");
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffd2f(double dval, /* I - value to be converted to a string */
+ int decim, /* I - number of decimal places to display */
+ char *cval, /* O - character string representation of the value */
+ int *status) /* IO - error status */
+/*
+ convert double value to a null-terminated F format string
+*/
+{
+ char *cptr;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ cval[0] = '\0';
+
+ if (decim < 0)
+ {
+ ffpmsg("Error in ffd2f: no. of decimal places < 0");
+ return(*status = BAD_DECIM);
+ }
+
+ if (sprintf(cval, "%.*f", decim, dval) < 0)
+ {
+ ffpmsg("Error in ffd2f converting double to string");
+ *status = BAD_F2C;
+ }
+
+ /* replace comma with a period (e.g. in French locale) */
+ if ( (cptr = strchr(cval, ','))) *cptr = '.';
+
+ /* test if output string is 'NaN', 'INDEF', or 'INF' */
+ if (strchr(cval, 'N'))
+ {
+ ffpmsg("Error in ffd2f: double value is a NaN or INDEF");
+ *status = BAD_F2C;
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffd2e(double dval, /* I - value to be converted to a string */
+ int decim, /* I - number of decimal places to display */
+ char *cval, /* O - character string representation of the value */
+ int *status) /* IO - error status */
+/*
+ convert double value to a null-terminated exponential format string.
+*/
+{
+ char *cptr;
+
+ if (*status > 0) /* inherit input status value if > 0 */
+ return(*status);
+
+ cval[0] = '\0';
+
+ if (decim < 0)
+ { /* use G format if decim is negative */
+ if ( sprintf(cval, "%.*G", -decim, dval) < 0)
+ {
+ ffpmsg("Error in ffd2e converting float to string");
+ *status = BAD_F2C;
+ }
+ else
+ {
+ /* test if E format was used, and there is no displayed decimal */
+ if ( !strchr(cval, '.') && strchr(cval,'E') )
+ {
+ /* reformat value with a decimal point and single zero */
+ if ( sprintf(cval, "%.1E", dval) < 0)
+ {
+ ffpmsg("Error in ffd2e converting float to string");
+ *status = BAD_F2C;
+ }
+
+ return(*status);
+ }
+ }
+ }
+ else
+ {
+ if ( sprintf(cval, "%.*E", decim, dval) < 0)
+ {
+ ffpmsg("Error in ffd2e converting float to string");
+ *status = BAD_F2C;
+ }
+ }
+
+ if (*status <= 0)
+ {
+ /* replace comma with a period (e.g. in French locale) */
+ if ( (cptr = strchr(cval, ','))) *cptr = '.';
+
+ /* test if output string is 'NaN', 'INDEF', or 'INF' */
+ if (strchr(cval, 'N'))
+ {
+ ffpmsg("Error in ffd2e: double value is a NaN or INDEF");
+ *status = BAD_F2C;
+ }
+ else if ( !strchr(cval, '.') && !strchr(cval,'E') )
+ {
+ /* add decimal point if necessary to distinquish from integer */
+ strcat(cval, ".");
+ }
+ }
+
+ return(*status);
+}
+
diff --git a/src/plugins/cfitsio/quantize.c b/src/plugins/cfitsio/quantize.c
new file mode 100644
index 0000000..8fe6acc
--- /dev/null
+++ b/src/plugins/cfitsio/quantize.c
@@ -0,0 +1,3888 @@
+/*
+ The following code is based on algorithms written by Richard White at STScI and made
+ available for use in CFITSIO in July 1999 and updated in January 2008.
+*/
+
+# include <stdio.h>
+# include <stdlib.h>
+# include <math.h>
+# include <limits.h>
+# include <float.h>
+
+#include "fitsio2.h"
+
+/* nearest integer function */
+# define NINT(x) ((x >= 0.) ? (int) (x + 0.5) : (int) (x - 0.5))
+
+#define NULL_VALUE -2147483647 /* value used to represent undefined pixels */
+#define N_RESERVED_VALUES 10 /* number of reserved values, starting with */
+ /* and including NULL_VALUE. These values */
+ /* may not be used to represent the quantized */
+ /* and scaled floating point pixel values */
+ /* If lossy Hcompression is used, and the */
+ /* array contains null values, then it is also */
+ /* possible for the compressed values to slightly */
+ /* exceed the range of the actual (lossless) values */
+ /* so we must reserve a little more space */
+
+/* more than this many standard deviations from the mean is an outlier */
+# define SIGMA_CLIP 5.
+# define NITER 3 /* number of sigma-clipping iterations */
+
+static int FnMeanSigma_short(short *array, long npix, int nullcheck,
+ short nullvalue, long *ngoodpix, double *mean, double *sigma, int *status);
+static int FnMeanSigma_int(int *array, long npix, int nullcheck,
+ int nullvalue, long *ngoodpix, double *mean, double *sigma, int *status);
+static int FnMeanSigma_float(float *array, long npix, int nullcheck,
+ float nullvalue, long *ngoodpix, double *mean, double *sigma, int *status);
+static int FnMeanSigma_double(double *array, long npix, int nullcheck,
+ double nullvalue, long *ngoodpix, double *mean, double *sigma, int *status);
+
+static int FnNoise5_short(short *array, long nx, long ny, int nullcheck,
+ short nullvalue, long *ngood, short *minval, short *maxval,
+ double *n2, double *n3, double *n5, int *status);
+static int FnNoise5_int(int *array, long nx, long ny, int nullcheck,
+ int nullvalue, long *ngood, int *minval, int *maxval,
+ double *n2, double *n3, double *n5, int *status);
+static int FnNoise5_float(float *array, long nx, long ny, int nullcheck,
+ float nullvalue, long *ngood, float *minval, float *maxval,
+ double *n2, double *n3, double *n5, int *status);
+static int FnNoise5_double(double *array, long nx, long ny, int nullcheck,
+ double nullvalue, long *ngood, double *minval, double *maxval,
+ double *n2, double *n3, double *n5, int *status);
+
+static int FnNoise3_short(short *array, long nx, long ny, int nullcheck,
+ short nullvalue, long *ngood, short *minval, short *maxval, double *noise, int *status);
+static int FnNoise3_int(int *array, long nx, long ny, int nullcheck,
+ int nullvalue, long *ngood, int *minval, int *maxval, double *noise, int *status);
+static int FnNoise3_float(float *array, long nx, long ny, int nullcheck,
+ float nullvalue, long *ngood, float *minval, float *maxval, double *noise, int *status);
+static int FnNoise3_double(double *array, long nx, long ny, int nullcheck,
+ double nullvalue, long *ngood, double *minval, double *maxval, double *noise, int *status);
+
+static int FnNoise1_short(short *array, long nx, long ny,
+ int nullcheck, short nullvalue, double *noise, int *status);
+static int FnNoise1_int(int *array, long nx, long ny,
+ int nullcheck, int nullvalue, double *noise, int *status);
+static int FnNoise1_float(float *array, long nx, long ny,
+ int nullcheck, float nullvalue, double *noise, int *status);
+static int FnNoise1_double(double *array, long nx, long ny,
+ int nullcheck, double nullvalue, double *noise, int *status);
+
+static int FnCompare_short (const void *, const void *);
+static int FnCompare_int (const void *, const void *);
+static int FnCompare_float (const void *, const void *);
+static int FnCompare_double (const void *, const void *);
+static float quick_select_float(float arr[], int n);
+static short quick_select_short(short arr[], int n);
+static int quick_select_int(int arr[], int n);
+static LONGLONG quick_select_longlong(LONGLONG arr[], int n);
+static double quick_select_double(double arr[], int n);
+
+/*---------------------------------------------------------------------------*/
+int fits_quantize_float (long row, float fdata[], long nxpix, long nypix, int nullcheck,
+ float in_null_value, float qlevel, int idata[], double *bscale,
+ double *bzero, int *iminval, int *imaxval) {
+
+/* arguments:
+long row i: if positive, tile number = row number in the binary table
+ (this is only used when dithering the quantized values)
+float fdata[] i: array of image pixels to be compressed
+long nxpix i: number of pixels in each row of fdata
+long nypix i: number of rows in fdata
+nullcheck i: check for nullvalues in fdata?
+float in_null_value i: value used to represent undefined pixels in fdata
+float qlevel i: quantization level
+int idata[] o: values of fdata after applying bzero and bscale
+double bscale o: scale factor
+double bzero o: zero offset
+int iminval o: minimum quantized value that is returned
+int imaxval o: maximum quantized value that is returned
+
+The function value will be one if the input fdata were copied to idata;
+in this case the parameters bscale and bzero can be used to convert back to
+nearly the original floating point values: fdata ~= idata * bscale + bzero.
+If the function value is zero, the data were not copied to idata.
+*/
+
+ int status, anynulls = 0, iseed;
+ long i, nx, ngood = 0;
+ double stdev, noise2, noise3, noise5; /* MAD 2nd, 3rd, and 5th order noise values */
+ float minval = 0., maxval = 0.; /* min & max of fdata */
+ double delta; /* bscale, 1 in idata = delta in fdata */
+ double zeropt; /* bzero */
+ double temp;
+ int nextrand = 0;
+ extern float *fits_rand_value; /* this is defined in imcompress.c */
+ LONGLONG iqfactor;
+
+ nx = nxpix * nypix;
+ if (nx <= 1) {
+ *bscale = 1.;
+ *bzero = 0.;
+ return (0);
+ }
+
+ if (qlevel >= 0.) {
+
+ /* estimate background noise using MAD pixel differences */
+ FnNoise5_float(fdata, nxpix, nypix, nullcheck, in_null_value, &ngood,
+ &minval, &maxval, &noise2, &noise3, &noise5, &status);
+
+ if (nullcheck && ngood == 0) { /* special case of an image filled with Nulls */
+ /* set parameters to dummy values, which are not used */
+ minval = 0.;
+ maxval = 1.;
+ stdev = 1;
+ } else {
+
+ /* use the minimum of noise2, noise3, and noise5 as the best noise value */
+ stdev = noise3;
+ if (noise2 != 0. && noise2 < stdev) stdev = noise2;
+ if (noise5 != 0. && noise5 < stdev) stdev = noise5;
+ }
+
+ if (qlevel == 0.)
+ delta = stdev / 4.; /* default quantization */
+ else
+ delta = stdev / qlevel;
+
+ if (delta == 0.)
+ return (0); /* don't quantize */
+
+ } else {
+ /* negative value represents the absolute quantization level */
+ delta = -qlevel;
+
+ /* only nned to calculate the min and max values */
+ FnNoise3_float(fdata, nxpix, nypix, nullcheck, in_null_value, &ngood,
+ &minval, &maxval, 0, &status);
+ }
+
+ /* check that the range of quantized levels is not > range of int */
+ if ((maxval - minval) / delta > 2. * 2147483647. - N_RESERVED_VALUES )
+ return (0); /* don't quantize */
+
+ if (row > 0) { /* we need to dither the quantized values */
+ if (!fits_rand_value)
+ if (fits_init_randoms()) return(MEMORY_ALLOCATION);
+
+ /* initialize the index to the next random number in the list */
+ iseed = (int) ((row - 1) % N_RANDOM);
+ nextrand = (int) (fits_rand_value[iseed] * 500.);
+ }
+
+ if (ngood == nx) { /* don't have to check for nulls */
+ /* return all positive values, if possible since some */
+ /* compression algorithms either only work for positive integers, */
+ /* or are more efficient. */
+
+ if ((maxval - minval) / delta < 2147483647. - N_RESERVED_VALUES )
+ {
+ zeropt = minval;
+ /* fudge the zero point so it is an integer multiple of delta */
+ /* This helps to ensure the same scaling will be performed if the */
+ /* file undergoes multiple fpack/funpack cycles */
+ iqfactor = (LONGLONG) (zeropt/delta + 0.5);
+ zeropt = iqfactor * delta;
+ }
+ else
+ {
+ /* center the quantized levels around zero */
+ zeropt = (minval + maxval) / 2.;
+ }
+
+ if (row > 0) { /* dither the values when quantizing */
+ for (i = 0; i < nx; i++) {
+
+ idata[i] = NINT((((double) fdata[i] - zeropt) / delta) + fits_rand_value[nextrand] - 0.5);
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ } else { /* do not dither the values */
+
+ for (i = 0; i < nx; i++) {
+ idata[i] = NINT ((fdata[i] - zeropt) / delta);
+ }
+ }
+ }
+ else {
+ /* data contains null values; shift the range to be */
+ /* close to the value used to represent null values */
+ zeropt = minval - delta * (NULL_VALUE + N_RESERVED_VALUES);
+
+ if (row > 0) { /* dither the values */
+ for (i = 0; i < nx; i++) {
+ if (fdata[i] != in_null_value) {
+ idata[i] = NINT((((double) fdata[i] - zeropt) / delta) + fits_rand_value[nextrand] - 0.5);
+ } else {
+ idata[i] = NULL_VALUE;
+ }
+
+ /* increment the random number index, regardless */
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ if (iseed == N_RANDOM) iseed = 0;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ } else { /* do not dither the values */
+ for (i = 0; i < nx; i++) {
+ if (fdata[i] != in_null_value)
+ idata[i] = NINT((fdata[i] - zeropt) / delta);
+ else
+ idata[i] = NULL_VALUE;
+ }
+ }
+ }
+
+ /* calc min and max values */
+ temp = (minval - zeropt) / delta;
+ *iminval = NINT (temp);
+ temp = (maxval - zeropt) / delta;
+ *imaxval = NINT (temp);
+
+ *bscale = delta;
+ *bzero = zeropt;
+ return (1); /* yes, data have been quantized */
+}
+/*---------------------------------------------------------------------------*/
+int fits_quantize_double (long row, double fdata[], long nxpix, long nypix, int nullcheck,
+ double in_null_value, float qlevel, int idata[], double *bscale,
+ double *bzero, int *iminval, int *imaxval) {
+
+/* arguments:
+long row i: tile number = row number in the binary table
+double fdata[] i: array of image pixels to be compressed
+long nxpix i: number of pixels in each row of fdata
+long nypix i: number of rows in fdata
+nullcheck i: check for nullvalues in fdata?
+double in_null_value i: value used to represent undefined pixels in fdata
+int noise_bits i: quantization level (number of bits)
+int idata[] o: values of fdata after applying bzero and bscale
+double bscale o: scale factor
+double bzero o: zero offset
+int iminval o: minimum quantized value that is returned
+int imaxval o: maximum quantized value that is returned
+
+The function value will be one if the input fdata were copied to idata;
+in this case the parameters bscale and bzero can be used to convert back to
+nearly the original floating point values: fdata ~= idata * bscale + bzero.
+If the function value is zero, the data were not copied to idata.
+*/
+
+ int status, anynulls = 0, iseed;
+ long i, nx, ngood = 0;
+ double stdev, noise2, noise3, noise5; /* MAD 2nd, 3rd, and 5th order noise values */
+ double minval = 0., maxval = 0.; /* min & max of fdata */
+ double delta; /* bscale, 1 in idata = delta in fdata */
+ double zeropt; /* bzero */
+ double temp;
+ int nextrand = 0;
+ extern float *fits_rand_value;
+ LONGLONG iqfactor;
+
+ nx = nxpix * nypix;
+ if (nx <= 1) {
+ *bscale = 1.;
+ *bzero = 0.;
+ return (0);
+ }
+
+ if (qlevel >= 0.) {
+
+ /* estimate background noise using MAD pixel differences */
+ FnNoise5_double(fdata, nxpix, nypix, nullcheck, in_null_value, &ngood,
+ &minval, &maxval, &noise2, &noise3, &noise5, &status);
+
+ if (nullcheck && ngood == 0) { /* special case of an image filled with Nulls */
+ /* set parameters to dummy values, which are not used */
+ minval = 0.;
+ maxval = 1.;
+ stdev = 1;
+ } else {
+
+ /* use the minimum of noise2, noise3, and noise5 as the best noise value */
+ stdev = noise3;
+ if (noise2 != 0. && noise2 < stdev) stdev = noise2;
+ if (noise5 != 0. && noise5 < stdev) stdev = noise5;
+ }
+
+ if (qlevel == 0.)
+ delta = stdev / 4.; /* default quantization */
+ else
+ delta = stdev / qlevel;
+
+ if (delta == 0.)
+ return (0); /* don't quantize */
+
+ } else {
+ /* negative value represents the absolute quantization level */
+ delta = -qlevel;
+
+ /* only nned to calculate the min and max values */
+ FnNoise3_double(fdata, nxpix, nypix, nullcheck, in_null_value, &ngood,
+ &minval, &maxval, 0, &status);
+ }
+
+ /* check that the range of quantized levels is not > range of int */
+ if ((maxval - minval) / delta > 2. * 2147483647. - N_RESERVED_VALUES )
+ return (0); /* don't quantize */
+
+ if (row > 0) { /* we need to dither the quantized values */
+ if (!fits_rand_value)
+ if (fits_init_randoms()) return(MEMORY_ALLOCATION);
+
+ /* initialize the index to the next random number in the list */
+ iseed = (int) ((row - 1) % N_RANDOM);
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+
+ if (ngood == nx) { /* don't have to check for nulls */
+ /* return all positive values, if possible since some */
+ /* compression algorithms either only work for positive integers, */
+ /* or are more efficient. */
+ if ((maxval - minval) / delta < 2147483647. - N_RESERVED_VALUES )
+ {
+ zeropt = minval;
+ /* fudge the zero point so it is an integer multiple of delta */
+ /* This helps to ensure the same scaling will be performed if the */
+ /* file undergoes multiple fpack/funpack cycles */
+ iqfactor = (LONGLONG) (zeropt/delta + 0.5);
+ zeropt = iqfactor * delta;
+ }
+ else
+ {
+ /* center the quantized levels around zero */
+ zeropt = (minval + maxval) / 2.;
+ }
+
+ if (row > 0) { /* dither the values when quantizing */
+ for (i = 0; i < nx; i++) {
+
+ idata[i] = NINT((((double) fdata[i] - zeropt) / delta) + fits_rand_value[nextrand] - 0.5);
+
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ } else { /* do not dither the values */
+
+ for (i = 0; i < nx; i++) {
+ idata[i] = NINT ((fdata[i] - zeropt) / delta);
+ }
+ }
+ }
+ else {
+ /* data contains null values; shift the range to be */
+ /* close to the value used to represent null values */
+ zeropt = minval - delta * (NULL_VALUE + N_RESERVED_VALUES);
+
+ if (row > 0) { /* dither the values */
+ for (i = 0; i < nx; i++) {
+ if (fdata[i] != in_null_value) {
+ idata[i] = NINT((((double) fdata[i] - zeropt) / delta) + fits_rand_value[nextrand] - 0.5);
+ } else {
+ idata[i] = NULL_VALUE;
+ }
+
+ /* increment the random number index, regardless */
+ nextrand++;
+ if (nextrand == N_RANDOM) {
+ iseed++;
+ nextrand = (int) (fits_rand_value[iseed] * 500);
+ }
+ }
+ } else { /* do not dither the values */
+ for (i = 0; i < nx; i++) {
+ if (fdata[i] != in_null_value)
+ idata[i] = NINT((fdata[i] - zeropt) / delta);
+ else
+ idata[i] = NULL_VALUE;
+ }
+ }
+ }
+
+ /* calc min and max values */
+ temp = (minval - zeropt) / delta;
+ *iminval = NINT (temp);
+ temp = (maxval - zeropt) / delta;
+ *imaxval = NINT (temp);
+
+ *bscale = delta;
+ *bzero = zeropt;
+
+ return (1); /* yes, data have been quantized */
+}
+/*--------------------------------------------------------------------------*/
+int fits_img_stats_short(short *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ /* (if this is a 3D image, then ny should be the */
+ /* product of the no. of rows times the no. of planes) */
+ int nullcheck, /* check for null values, if true */
+ short nullvalue, /* value of null pixels, if nullcheck is true */
+
+ /* returned parameters (if the pointer is not null) */
+ long *ngoodpix, /* number of non-null pixels in the image */
+ short *minvalue, /* returned minimum non-null value in the array */
+ short *maxvalue, /* returned maximum non-null value in the array */
+ double *mean, /* returned mean value of all non-null pixels */
+ double *sigma, /* returned R.M.S. value of all non-null pixels */
+ double *noise1, /* 1st order estimate of noise in image background level */
+ double *noise2, /* 2nd order estimate of noise in image background level */
+ double *noise3, /* 3rd order estimate of noise in image background level */
+ double *noise5, /* 5th order estimate of noise in image background level */
+ int *status) /* error status */
+
+/*
+ Compute statistics of the input short integer image.
+*/
+{
+ long ngood;
+ short minval, maxval;
+ double xmean = 0., xsigma = 0., xnoise = 0., xnoise2 = 0., xnoise3 = 0., xnoise5 = 0.;
+
+ /* need to calculate mean and/or sigma and/or limits? */
+ if (mean || sigma ) {
+ FnMeanSigma_short(array, nx * ny, nullcheck, nullvalue,
+ &ngood, &xmean, &xsigma, status);
+
+ if (ngoodpix) *ngoodpix = ngood;
+ if (mean) *mean = xmean;
+ if (sigma) *sigma = xsigma;
+ }
+
+ if (noise1) {
+ FnNoise1_short(array, nx, ny, nullcheck, nullvalue,
+ &xnoise, status);
+
+ *noise1 = xnoise;
+ }
+
+ if (minvalue || maxvalue || noise3) {
+ FnNoise5_short(array, nx, ny, nullcheck, nullvalue,
+ &ngood, &minval, &maxval, &xnoise2, &xnoise3, &xnoise5, status);
+
+ if (ngoodpix) *ngoodpix = ngood;
+ if (minvalue) *minvalue= minval;
+ if (maxvalue) *maxvalue = maxval;
+ if (noise2) *noise2 = xnoise2;
+ if (noise3) *noise3 = xnoise3;
+ if (noise5) *noise5 = xnoise5;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_img_stats_int(int *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ /* (if this is a 3D image, then ny should be the */
+ /* product of the no. of rows times the no. of planes) */
+ int nullcheck, /* check for null values, if true */
+ int nullvalue, /* value of null pixels, if nullcheck is true */
+
+ /* returned parameters (if the pointer is not null) */
+ long *ngoodpix, /* number of non-null pixels in the image */
+ int *minvalue, /* returned minimum non-null value in the array */
+ int *maxvalue, /* returned maximum non-null value in the array */
+ double *mean, /* returned mean value of all non-null pixels */
+ double *sigma, /* returned R.M.S. value of all non-null pixels */
+ double *noise1, /* 1st order estimate of noise in image background level */
+ double *noise2, /* 2nd order estimate of noise in image background level */
+ double *noise3, /* 3rd order estimate of noise in image background level */
+ double *noise5, /* 5th order estimate of noise in image background level */
+ int *status) /* error status */
+
+/*
+ Compute statistics of the input integer image.
+*/
+{
+ long ngood;
+ int minval, maxval;
+ double xmean = 0., xsigma = 0., xnoise = 0., xnoise2 = 0., xnoise3 = 0., xnoise5 = 0.;
+
+ /* need to calculate mean and/or sigma and/or limits? */
+ if (mean || sigma ) {
+ FnMeanSigma_int(array, nx * ny, nullcheck, nullvalue,
+ &ngood, &xmean, &xsigma, status);
+
+ if (ngoodpix) *ngoodpix = ngood;
+ if (mean) *mean = xmean;
+ if (sigma) *sigma = xsigma;
+ }
+
+ if (noise1) {
+ FnNoise1_int(array, nx, ny, nullcheck, nullvalue,
+ &xnoise, status);
+
+ *noise1 = xnoise;
+ }
+
+ if (minvalue || maxvalue || noise3) {
+ FnNoise5_int(array, nx, ny, nullcheck, nullvalue,
+ &ngood, &minval, &maxval, &xnoise2, &xnoise3, &xnoise5, status);
+
+ if (ngoodpix) *ngoodpix = ngood;
+ if (minvalue) *minvalue= minval;
+ if (maxvalue) *maxvalue = maxval;
+ if (noise2) *noise2 = xnoise2;
+ if (noise3) *noise3 = xnoise3;
+ if (noise5) *noise5 = xnoise5;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fits_img_stats_float(float *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ /* (if this is a 3D image, then ny should be the */
+ /* product of the no. of rows times the no. of planes) */
+ int nullcheck, /* check for null values, if true */
+ float nullvalue, /* value of null pixels, if nullcheck is true */
+
+ /* returned parameters (if the pointer is not null) */
+ long *ngoodpix, /* number of non-null pixels in the image */
+ float *minvalue, /* returned minimum non-null value in the array */
+ float *maxvalue, /* returned maximum non-null value in the array */
+ double *mean, /* returned mean value of all non-null pixels */
+ double *sigma, /* returned R.M.S. value of all non-null pixels */
+ double *noise1, /* 1st order estimate of noise in image background level */
+ double *noise2, /* 2nd order estimate of noise in image background level */
+ double *noise3, /* 3rd order estimate of noise in image background level */
+ double *noise5, /* 5th order estimate of noise in image background level */
+ int *status) /* error status */
+
+/*
+ Compute statistics of the input float image.
+*/
+{
+ long ngood;
+ float minval, maxval;
+ double xmean = 0., xsigma = 0., xnoise = 0., xnoise2 = 0., xnoise3 = 0., xnoise5 = 0.;
+
+ /* need to calculate mean and/or sigma and/or limits? */
+ if (mean || sigma ) {
+ FnMeanSigma_float(array, nx * ny, nullcheck, nullvalue,
+ &ngood, &xmean, &xsigma, status);
+
+ if (ngoodpix) *ngoodpix = ngood;
+ if (mean) *mean = xmean;
+ if (sigma) *sigma = xsigma;
+ }
+
+ if (noise1) {
+ FnNoise1_float(array, nx, ny, nullcheck, nullvalue,
+ &xnoise, status);
+
+ *noise1 = xnoise;
+ }
+
+ if (minvalue || maxvalue || noise3) {
+ FnNoise5_float(array, nx, ny, nullcheck, nullvalue,
+ &ngood, &minval, &maxval, &xnoise2, &xnoise3, &xnoise5, status);
+
+ if (ngoodpix) *ngoodpix = ngood;
+ if (minvalue) *minvalue= minval;
+ if (maxvalue) *maxvalue = maxval;
+ if (noise2) *noise2 = xnoise2;
+ if (noise3) *noise3 = xnoise3;
+ if (noise5) *noise5 = xnoise5;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnMeanSigma_short
+ (short *array, /* 2 dimensional array of image pixels */
+ long npix, /* number of pixels in the image */
+ int nullcheck, /* check for null values, if true */
+ short nullvalue, /* value of null pixels, if nullcheck is true */
+
+ /* returned parameters */
+
+ long *ngoodpix, /* number of non-null pixels in the image */
+ double *mean, /* returned mean value of all non-null pixels */
+ double *sigma, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Compute mean and RMS sigma of the non-null pixels in the input array.
+*/
+{
+ long ii, ngood = 0;
+ short *value;
+ double sum = 0., sum2 = 0., xtemp;
+
+ value = array;
+
+ if (nullcheck) {
+ for (ii = 0; ii < npix; ii++, value++) {
+ if (*value != nullvalue) {
+ ngood++;
+ xtemp = (double) *value;
+ sum += xtemp;
+ sum2 += (xtemp * xtemp);
+ }
+ }
+ } else {
+ ngood = npix;
+ for (ii = 0; ii < npix; ii++, value++) {
+ xtemp = (double) *value;
+ sum += xtemp;
+ sum2 += (xtemp * xtemp);
+ }
+ }
+
+ if (ngood > 1) {
+ if (ngoodpix) *ngoodpix = ngood;
+ xtemp = sum / ngood;
+ if (mean) *mean = xtemp;
+ if (sigma) *sigma = sqrt((sum2 / ngood) - (xtemp * xtemp));
+ } else if (ngood == 1){
+ if (ngoodpix) *ngoodpix = 1;
+ if (mean) *mean = sum;
+ if (sigma) *sigma = 0.0;
+ } else {
+ if (ngoodpix) *ngoodpix = 0;
+ if (mean) *mean = 0.;
+ if (sigma) *sigma = 0.;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnMeanSigma_int
+ (int *array, /* 2 dimensional array of image pixels */
+ long npix, /* number of pixels in the image */
+ int nullcheck, /* check for null values, if true */
+ int nullvalue, /* value of null pixels, if nullcheck is true */
+
+ /* returned parameters */
+
+ long *ngoodpix, /* number of non-null pixels in the image */
+ double *mean, /* returned mean value of all non-null pixels */
+ double *sigma, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Compute mean and RMS sigma of the non-null pixels in the input array.
+*/
+{
+ long ii, ngood = 0;
+ int *value;
+ double sum = 0., sum2 = 0., xtemp;
+
+ value = array;
+
+ if (nullcheck) {
+ for (ii = 0; ii < npix; ii++, value++) {
+ if (*value != nullvalue) {
+ ngood++;
+ xtemp = (double) *value;
+ sum += xtemp;
+ sum2 += (xtemp * xtemp);
+ }
+ }
+ } else {
+ ngood = npix;
+ for (ii = 0; ii < npix; ii++, value++) {
+ xtemp = (double) *value;
+ sum += xtemp;
+ sum2 += (xtemp * xtemp);
+ }
+ }
+
+ if (ngood > 1) {
+ if (ngoodpix) *ngoodpix = ngood;
+ xtemp = sum / ngood;
+ if (mean) *mean = xtemp;
+ if (sigma) *sigma = sqrt((sum2 / ngood) - (xtemp * xtemp));
+ } else if (ngood == 1){
+ if (ngoodpix) *ngoodpix = 1;
+ if (mean) *mean = sum;
+ if (sigma) *sigma = 0.0;
+ } else {
+ if (ngoodpix) *ngoodpix = 0;
+ if (mean) *mean = 0.;
+ if (sigma) *sigma = 0.;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnMeanSigma_float
+ (float *array, /* 2 dimensional array of image pixels */
+ long npix, /* number of pixels in the image */
+ int nullcheck, /* check for null values, if true */
+ float nullvalue, /* value of null pixels, if nullcheck is true */
+
+ /* returned parameters */
+
+ long *ngoodpix, /* number of non-null pixels in the image */
+ double *mean, /* returned mean value of all non-null pixels */
+ double *sigma, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Compute mean and RMS sigma of the non-null pixels in the input array.
+*/
+{
+ long ii, ngood = 0;
+ float *value;
+ double sum = 0., sum2 = 0., xtemp;
+
+ value = array;
+
+ if (nullcheck) {
+ for (ii = 0; ii < npix; ii++, value++) {
+ if (*value != nullvalue) {
+ ngood++;
+ xtemp = (double) *value;
+ sum += xtemp;
+ sum2 += (xtemp * xtemp);
+ }
+ }
+ } else {
+ ngood = npix;
+ for (ii = 0; ii < npix; ii++, value++) {
+ xtemp = (double) *value;
+ sum += xtemp;
+ sum2 += (xtemp * xtemp);
+ }
+ }
+
+ if (ngood > 1) {
+ if (ngoodpix) *ngoodpix = ngood;
+ xtemp = sum / ngood;
+ if (mean) *mean = xtemp;
+ if (sigma) *sigma = sqrt((sum2 / ngood) - (xtemp * xtemp));
+ } else if (ngood == 1){
+ if (ngoodpix) *ngoodpix = 1;
+ if (mean) *mean = sum;
+ if (sigma) *sigma = 0.0;
+ } else {
+ if (ngoodpix) *ngoodpix = 0;
+ if (mean) *mean = 0.;
+ if (sigma) *sigma = 0.;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnMeanSigma_double
+ (double *array, /* 2 dimensional array of image pixels */
+ long npix, /* number of pixels in the image */
+ int nullcheck, /* check for null values, if true */
+ double nullvalue, /* value of null pixels, if nullcheck is true */
+
+ /* returned parameters */
+
+ long *ngoodpix, /* number of non-null pixels in the image */
+ double *mean, /* returned mean value of all non-null pixels */
+ double *sigma, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Compute mean and RMS sigma of the non-null pixels in the input array.
+*/
+{
+ long ii, ngood = 0;
+ double *value;
+ double sum = 0., sum2 = 0., xtemp;
+
+ value = array;
+
+ if (nullcheck) {
+ for (ii = 0; ii < npix; ii++, value++) {
+ if (*value != nullvalue) {
+ ngood++;
+ xtemp = *value;
+ sum += xtemp;
+ sum2 += (xtemp * xtemp);
+ }
+ }
+ } else {
+ ngood = npix;
+ for (ii = 0; ii < npix; ii++, value++) {
+ xtemp = *value;
+ sum += xtemp;
+ sum2 += (xtemp * xtemp);
+ }
+ }
+
+ if (ngood > 1) {
+ if (ngoodpix) *ngoodpix = ngood;
+ xtemp = sum / ngood;
+ if (mean) *mean = xtemp;
+ if (sigma) *sigma = sqrt((sum2 / ngood) - (xtemp * xtemp));
+ } else if (ngood == 1){
+ if (ngoodpix) *ngoodpix = 1;
+ if (mean) *mean = sum;
+ if (sigma) *sigma = 0.0;
+ } else {
+ if (ngoodpix) *ngoodpix = 0;
+ if (mean) *mean = 0.;
+ if (sigma) *sigma = 0.;
+ }
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise5_short
+ (short *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ short nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ long *ngood, /* number of good, non-null pixels? */
+ short *minval, /* minimum non-null value */
+ short *maxval, /* maximum non-null value */
+ double *noise2, /* returned 2nd order MAD of all non-null pixels */
+ double *noise3, /* returned 3rd order MAD of all non-null pixels */
+ double *noise5, /* returned 5th order MAD of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Estimate the median and background noise in the input image using 2nd, 3rd and 5th
+order Median Absolute Differences.
+
+The noise in the background of the image is calculated using the MAD algorithms
+developed for deriving the signal to noise ratio in spectra
+(see issue #42 of the ST-ECF newsletter, http://www.stecf.org/documents/newsletter/)
+
+3rd order: noise = 1.482602 / sqrt(6) * median (abs(2*flux(i) - flux(i-2) - flux(i+2)))
+
+The returned estimates are the median of the values that are computed for each
+row of the image.
+*/
+{
+ long ii, jj, nrows = 0, nrows2 = 0, nvals, nvals2, ngoodpix = 0;
+ int *differences2, *differences3, *differences5;
+ short *rowpix, v1, v2, v3, v4, v5, v6, v7, v8, v9;
+ short xminval = SHRT_MAX, xmaxval = SHRT_MIN;
+ int do_range = 0;
+ double *diffs2, *diffs3, *diffs5;
+ double xnoise2 = 0, xnoise3 = 0, xnoise5 = 0;
+
+ if (nx < 5) {
+ /* treat entire array as an image with a single row */
+ nx = nx * ny;
+ ny = 1;
+ }
+
+ /* rows must have at least 9 pixels */
+ if (nx < 9) {
+
+ for (ii = 0; ii < nx; ii++) {
+ if (nullcheck && array[ii] == nullvalue)
+ continue;
+ else {
+ if (array[ii] < xminval) xminval = array[ii];
+ if (array[ii] > xmaxval) xmaxval = array[ii];
+ ngoodpix++;
+ }
+ }
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (ngood) *ngood = ngoodpix;
+ if (noise2) *noise2 = 0.;
+ if (noise3) *noise3 = 0.;
+ if (noise5) *noise5 = 0.;
+ return(*status);
+ }
+
+ /* do we need to compute the min and max value? */
+ if (minval || maxval) do_range = 1;
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences2 = calloc(nx, sizeof(int));
+ if (!differences2) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ differences3 = calloc(nx, sizeof(int));
+ if (!differences3) {
+ free(differences2);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ differences5 = calloc(nx, sizeof(int));
+ if (!differences5) {
+ free(differences2);
+ free(differences3);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs2 = calloc(ny, sizeof(double));
+ if (!diffs2) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs3 = calloc(ny, sizeof(double));
+ if (!diffs3) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ free(diffs2);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs5 = calloc(ny, sizeof(double));
+ if (!diffs5) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ free(diffs2);
+ free(diffs3);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v1 < xminval) xminval = v1;
+ if (v1 > xmaxval) xmaxval = v1;
+ }
+
+ /***** find the 2nd valid pixel in row (which we will skip over) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v2 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v2 < xminval) xminval = v2;
+ if (v2 > xmaxval) xmaxval = v2;
+ }
+
+ /***** find the 3rd valid pixel in row */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v3 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v3 < xminval) xminval = v3;
+ if (v3 > xmaxval) xmaxval = v3;
+ }
+
+ /* find the 4nd valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v4 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v4 < xminval) xminval = v4;
+ if (v4 > xmaxval) xmaxval = v4;
+ }
+
+ /* find the 5th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v5 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v5 < xminval) xminval = v5;
+ if (v5 > xmaxval) xmaxval = v5;
+ }
+
+ /* find the 6th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v6 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v6 < xminval) xminval = v6;
+ if (v6 > xmaxval) xmaxval = v6;
+ }
+
+ /* find the 7th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v7 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v7 < xminval) xminval = v7;
+ if (v7 > xmaxval) xmaxval = v7;
+ }
+
+ /* find the 8th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v8 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v8 < xminval) xminval = v8;
+ if (v8 > xmaxval) xmaxval = v8;
+ }
+ /* now populate the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ nvals2 = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+ v9 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v9 < xminval) xminval = v9;
+ if (v9 > xmaxval) xmaxval = v9;
+ }
+
+ /* construct array of absolute differences */
+
+ if (!(v5 == v6 && v6 == v7) ) {
+ differences2[nvals2] = abs((int) v5 - (int) v7);
+ nvals2++;
+ }
+
+ if (!(v3 == v4 && v4 == v5 && v5 == v6 && v6 == v7) ) {
+ differences3[nvals] = abs((2 * (int) v5) - (int) v3 - (int) v7);
+ differences5[nvals] = abs((6 * (int) v5) - (4 * (int) v3) - (4 * (int) v7) + (int) v1 + (int) v9);
+ nvals++;
+ } else {
+ /* ignore constant background regions */
+ ngoodpix++;
+ }
+
+ /* shift over 1 pixel */
+ v1 = v2;
+ v2 = v3;
+ v3 = v4;
+ v4 = v5;
+ v5 = v6;
+ v6 = v7;
+ v7 = v8;
+ v8 = v9;
+ } /* end of loop over pixels in the row */
+
+ /* compute the median diffs */
+ /* Note that there are 8 more pixel values than there are diffs values. */
+ ngoodpix += (nvals + 8);
+
+ if (nvals == 0) {
+ continue; /* cannot compute medians on this row */
+ } else if (nvals == 1) {
+ if (nvals2 == 1) {
+ diffs2[nrows2] = differences2[0];
+ nrows2++;
+ }
+
+ diffs3[nrows] = differences3[0];
+ diffs5[nrows] = differences5[0];
+ } else {
+ /* quick_select returns the median MUCH faster than using qsort */
+ if (nvals2 > 1) {
+ diffs2[nrows2] = quick_select_int(differences2, nvals);
+ nrows2++;
+ }
+
+ diffs3[nrows] = quick_select_int(differences3, nvals);
+ diffs5[nrows] = quick_select_int(differences5, nvals);
+ }
+
+ nrows++;
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise3 = 0;
+ xnoise5 = 0;
+ } else if (nrows == 1) {
+ xnoise3 = diffs3[0];
+ xnoise5 = diffs5[0];
+ } else {
+ qsort(diffs3, nrows, sizeof(double), FnCompare_double);
+ qsort(diffs5, nrows, sizeof(double), FnCompare_double);
+ xnoise3 = (diffs3[(nrows - 1)/2] + diffs3[nrows/2]) / 2.;
+ xnoise5 = (diffs5[(nrows - 1)/2] + diffs5[nrows/2]) / 2.;
+ }
+
+ if (nrows2 == 0) {
+ xnoise2 = 0;
+ } else if (nrows2 == 1) {
+ xnoise2 = diffs2[0];
+ } else {
+ qsort(diffs2, nrows2, sizeof(double), FnCompare_double);
+ xnoise2 = (diffs2[(nrows2 - 1)/2] + diffs2[nrows2/2]) / 2.;
+ }
+
+ if (ngood) *ngood = ngoodpix;
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (noise2) *noise2 = 1.0483579 * xnoise2;
+ if (noise3) *noise3 = 0.6052697 * xnoise3;
+ if (noise5) *noise5 = 0.1772048 * xnoise5;
+
+ free(diffs5);
+ free(diffs3);
+ free(diffs2);
+ free(differences5);
+ free(differences3);
+ free(differences2);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise5_int
+ (int *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ int nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ long *ngood, /* number of good, non-null pixels? */
+ int *minval, /* minimum non-null value */
+ int *maxval, /* maximum non-null value */
+ double *noise2, /* returned 2nd order MAD of all non-null pixels */
+ double *noise3, /* returned 3rd order MAD of all non-null pixels */
+ double *noise5, /* returned 5th order MAD of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Estimate the median and background noise in the input image using 2nd, 3rd and 5th
+order Median Absolute Differences.
+
+The noise in the background of the image is calculated using the MAD algorithms
+developed for deriving the signal to noise ratio in spectra
+(see issue #42 of the ST-ECF newsletter, http://www.stecf.org/documents/newsletter/)
+
+3rd order: noise = 1.482602 / sqrt(6) * median (abs(2*flux(i) - flux(i-2) - flux(i+2)))
+
+The returned estimates are the median of the values that are computed for each
+row of the image.
+*/
+{
+ long ii, jj, nrows = 0, nrows2 = 0, nvals, nvals2, ngoodpix = 0;
+ LONGLONG *differences2, *differences3, *differences5, tdiff;
+ int *rowpix, v1, v2, v3, v4, v5, v6, v7, v8, v9;
+ int xminval = INT_MAX, xmaxval = INT_MIN;
+ int do_range = 0;
+ double *diffs2, *diffs3, *diffs5;
+ double xnoise2 = 0, xnoise3 = 0, xnoise5 = 0;
+
+ if (nx < 5) {
+ /* treat entire array as an image with a single row */
+ nx = nx * ny;
+ ny = 1;
+ }
+
+ /* rows must have at least 9 pixels */
+ if (nx < 9) {
+
+ for (ii = 0; ii < nx; ii++) {
+ if (nullcheck && array[ii] == nullvalue)
+ continue;
+ else {
+ if (array[ii] < xminval) xminval = array[ii];
+ if (array[ii] > xmaxval) xmaxval = array[ii];
+ ngoodpix++;
+ }
+ }
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (ngood) *ngood = ngoodpix;
+ if (noise2) *noise2 = 0.;
+ if (noise3) *noise3 = 0.;
+ if (noise5) *noise5 = 0.;
+ return(*status);
+ }
+
+ /* do we need to compute the min and max value? */
+ if (minval || maxval) do_range = 1;
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences2 = calloc(nx, sizeof(LONGLONG));
+ if (!differences2) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ differences3 = calloc(nx, sizeof(LONGLONG));
+ if (!differences3) {
+ free(differences2);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ differences5 = calloc(nx, sizeof(LONGLONG));
+ if (!differences5) {
+ free(differences2);
+ free(differences3);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs2 = calloc(ny, sizeof(double));
+ if (!diffs2) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs3 = calloc(ny, sizeof(double));
+ if (!diffs3) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ free(diffs2);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs5 = calloc(ny, sizeof(double));
+ if (!diffs5) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ free(diffs2);
+ free(diffs3);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v1 < xminval) xminval = v1;
+ if (v1 > xmaxval) xmaxval = v1;
+ }
+
+ /***** find the 2nd valid pixel in row (which we will skip over) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v2 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v2 < xminval) xminval = v2;
+ if (v2 > xmaxval) xmaxval = v2;
+ }
+
+ /***** find the 3rd valid pixel in row */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v3 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v3 < xminval) xminval = v3;
+ if (v3 > xmaxval) xmaxval = v3;
+ }
+
+ /* find the 4nd valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v4 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v4 < xminval) xminval = v4;
+ if (v4 > xmaxval) xmaxval = v4;
+ }
+
+ /* find the 5th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v5 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v5 < xminval) xminval = v5;
+ if (v5 > xmaxval) xmaxval = v5;
+ }
+
+ /* find the 6th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v6 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v6 < xminval) xminval = v6;
+ if (v6 > xmaxval) xmaxval = v6;
+ }
+
+ /* find the 7th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v7 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v7 < xminval) xminval = v7;
+ if (v7 > xmaxval) xmaxval = v7;
+ }
+
+ /* find the 8th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v8 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v8 < xminval) xminval = v8;
+ if (v8 > xmaxval) xmaxval = v8;
+ }
+ /* now populate the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ nvals2 = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+ v9 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v9 < xminval) xminval = v9;
+ if (v9 > xmaxval) xmaxval = v9;
+ }
+
+ /* construct array of absolute differences */
+
+ if (!(v5 == v6 && v6 == v7) ) {
+ tdiff = (LONGLONG) v5 - (LONGLONG) v7;
+ if (tdiff < 0)
+ differences2[nvals2] = -1 * tdiff;
+ else
+ differences2[nvals2] = tdiff;
+
+ nvals2++;
+ }
+
+ if (!(v3 == v4 && v4 == v5 && v5 == v6 && v6 == v7) ) {
+ tdiff = (2 * (LONGLONG) v5) - (LONGLONG) v3 - (LONGLONG) v7;
+ if (tdiff < 0)
+ differences3[nvals] = -1 * tdiff;
+ else
+ differences3[nvals] = tdiff;
+
+ tdiff = (6 * (LONGLONG) v5) - (4 * (LONGLONG) v3) - (4 * (LONGLONG) v7) + (LONGLONG) v1 + (LONGLONG) v9;
+ if (tdiff < 0)
+ differences5[nvals] = -1 * tdiff;
+ else
+ differences5[nvals] = tdiff;
+
+ nvals++;
+ } else {
+ /* ignore constant background regions */
+ ngoodpix++;
+ }
+
+ /* shift over 1 pixel */
+ v1 = v2;
+ v2 = v3;
+ v3 = v4;
+ v4 = v5;
+ v5 = v6;
+ v6 = v7;
+ v7 = v8;
+ v8 = v9;
+ } /* end of loop over pixels in the row */
+
+ /* compute the median diffs */
+ /* Note that there are 8 more pixel values than there are diffs values. */
+ ngoodpix += (nvals + 8);
+
+ if (nvals == 0) {
+ continue; /* cannot compute medians on this row */
+ } else if (nvals == 1) {
+ if (nvals2 == 1) {
+ diffs2[nrows2] = (double) differences2[0];
+ nrows2++;
+ }
+
+ diffs3[nrows] = (double) differences3[0];
+ diffs5[nrows] = (double) differences5[0];
+ } else {
+ /* quick_select returns the median MUCH faster than using qsort */
+ if (nvals2 > 1) {
+ diffs2[nrows2] = (double) quick_select_longlong(differences2, nvals);
+ nrows2++;
+ }
+
+ diffs3[nrows] = (double) quick_select_longlong(differences3, nvals);
+ diffs5[nrows] = (double) quick_select_longlong(differences5, nvals);
+ }
+
+ nrows++;
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise3 = 0;
+ xnoise5 = 0;
+ } else if (nrows == 1) {
+ xnoise3 = diffs3[0];
+ xnoise5 = diffs5[0];
+ } else {
+ qsort(diffs3, nrows, sizeof(double), FnCompare_double);
+ qsort(diffs5, nrows, sizeof(double), FnCompare_double);
+ xnoise3 = (diffs3[(nrows - 1)/2] + diffs3[nrows/2]) / 2.;
+ xnoise5 = (diffs5[(nrows - 1)/2] + diffs5[nrows/2]) / 2.;
+ }
+
+ if (nrows2 == 0) {
+ xnoise2 = 0;
+ } else if (nrows2 == 1) {
+ xnoise2 = diffs2[0];
+ } else {
+ qsort(diffs2, nrows2, sizeof(double), FnCompare_double);
+ xnoise2 = (diffs2[(nrows2 - 1)/2] + diffs2[nrows2/2]) / 2.;
+ }
+
+ if (ngood) *ngood = ngoodpix;
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (noise2) *noise2 = 1.0483579 * xnoise2;
+ if (noise3) *noise3 = 0.6052697 * xnoise3;
+ if (noise5) *noise5 = 0.1772048 * xnoise5;
+
+ free(diffs5);
+ free(diffs3);
+ free(diffs2);
+ free(differences5);
+ free(differences3);
+ free(differences2);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise5_float
+ (float *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ float nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ long *ngood, /* number of good, non-null pixels? */
+ float *minval, /* minimum non-null value */
+ float *maxval, /* maximum non-null value */
+ double *noise2, /* returned 2nd order MAD of all non-null pixels */
+ double *noise3, /* returned 3rd order MAD of all non-null pixels */
+ double *noise5, /* returned 5th order MAD of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Estimate the median and background noise in the input image using 2nd, 3rd and 5th
+order Median Absolute Differences.
+
+The noise in the background of the image is calculated using the MAD algorithms
+developed for deriving the signal to noise ratio in spectra
+(see issue #42 of the ST-ECF newsletter, http://www.stecf.org/documents/newsletter/)
+
+3rd order: noise = 1.482602 / sqrt(6) * median (abs(2*flux(i) - flux(i-2) - flux(i+2)))
+
+The returned estimates are the median of the values that are computed for each
+row of the image.
+*/
+{
+ long ii, jj, nrows = 0, nrows2 = 0, nvals, nvals2, ngoodpix = 0;
+ float *differences2, *differences3, *differences5;
+ float *rowpix, v1, v2, v3, v4, v5, v6, v7, v8, v9;
+ float xminval = FLT_MAX, xmaxval = -FLT_MAX;
+ int do_range = 0;
+ double *diffs2, *diffs3, *diffs5;
+ double xnoise2 = 0, xnoise3 = 0, xnoise5 = 0;
+
+ if (nx < 5) {
+ /* treat entire array as an image with a single row */
+ nx = nx * ny;
+ ny = 1;
+ }
+
+ /* rows must have at least 9 pixels */
+ if (nx < 9) {
+
+ for (ii = 0; ii < nx; ii++) {
+ if (nullcheck && array[ii] == nullvalue)
+ continue;
+ else {
+ if (array[ii] < xminval) xminval = array[ii];
+ if (array[ii] > xmaxval) xmaxval = array[ii];
+ ngoodpix++;
+ }
+ }
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (ngood) *ngood = ngoodpix;
+ if (noise2) *noise2 = 0.;
+ if (noise3) *noise3 = 0.;
+ if (noise5) *noise5 = 0.;
+ return(*status);
+ }
+
+ /* do we need to compute the min and max value? */
+ if (minval || maxval) do_range = 1;
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences2 = calloc(nx, sizeof(float));
+ if (!differences2) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ differences3 = calloc(nx, sizeof(float));
+ if (!differences3) {
+ free(differences2);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ differences5 = calloc(nx, sizeof(float));
+ if (!differences5) {
+ free(differences2);
+ free(differences3);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs2 = calloc(ny, sizeof(double));
+ if (!diffs2) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs3 = calloc(ny, sizeof(double));
+ if (!diffs3) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ free(diffs2);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs5 = calloc(ny, sizeof(double));
+ if (!diffs5) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ free(diffs2);
+ free(diffs3);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v1 < xminval) xminval = v1;
+ if (v1 > xmaxval) xmaxval = v1;
+ }
+
+ /***** find the 2nd valid pixel in row (which we will skip over) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v2 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v2 < xminval) xminval = v2;
+ if (v2 > xmaxval) xmaxval = v2;
+ }
+
+ /***** find the 3rd valid pixel in row */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v3 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v3 < xminval) xminval = v3;
+ if (v3 > xmaxval) xmaxval = v3;
+ }
+
+ /* find the 4nd valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v4 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v4 < xminval) xminval = v4;
+ if (v4 > xmaxval) xmaxval = v4;
+ }
+
+ /* find the 5th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v5 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v5 < xminval) xminval = v5;
+ if (v5 > xmaxval) xmaxval = v5;
+ }
+
+ /* find the 6th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v6 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v6 < xminval) xminval = v6;
+ if (v6 > xmaxval) xmaxval = v6;
+ }
+
+ /* find the 7th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v7 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v7 < xminval) xminval = v7;
+ if (v7 > xmaxval) xmaxval = v7;
+ }
+
+ /* find the 8th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v8 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v8 < xminval) xminval = v8;
+ if (v8 > xmaxval) xmaxval = v8;
+ }
+ /* now populate the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ nvals2 = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+ v9 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v9 < xminval) xminval = v9;
+ if (v9 > xmaxval) xmaxval = v9;
+ }
+
+ /* construct array of absolute differences */
+
+ if (!(v5 == v6 && v6 == v7) ) {
+ differences2[nvals2] = (float) fabs(v5 - v7);
+ nvals2++;
+ }
+
+ if (!(v3 == v4 && v4 == v5 && v5 == v6 && v6 == v7) ) {
+ differences3[nvals] = (float) fabs((2 * v5) - v3 - v7);
+ differences5[nvals] = (float) fabs((6 * v5) - (4 * v3) - (4 * v7) + v1 + v9);
+ nvals++;
+ } else {
+ /* ignore constant background regions */
+ ngoodpix++;
+ }
+
+ /* shift over 1 pixel */
+ v1 = v2;
+ v2 = v3;
+ v3 = v4;
+ v4 = v5;
+ v5 = v6;
+ v6 = v7;
+ v7 = v8;
+ v8 = v9;
+ } /* end of loop over pixels in the row */
+
+ /* compute the median diffs */
+ /* Note that there are 8 more pixel values than there are diffs values. */
+ ngoodpix += (nvals + 8);
+
+ if (nvals == 0) {
+ continue; /* cannot compute medians on this row */
+ } else if (nvals == 1) {
+ if (nvals2 == 1) {
+ diffs2[nrows2] = differences2[0];
+ nrows2++;
+ }
+
+ diffs3[nrows] = differences3[0];
+ diffs5[nrows] = differences5[0];
+ } else {
+ /* quick_select returns the median MUCH faster than using qsort */
+ if (nvals2 > 1) {
+ diffs2[nrows2] = quick_select_float(differences2, nvals);
+ nrows2++;
+ }
+
+ diffs3[nrows] = quick_select_float(differences3, nvals);
+ diffs5[nrows] = quick_select_float(differences5, nvals);
+ }
+
+ nrows++;
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise3 = 0;
+ xnoise5 = 0;
+ } else if (nrows == 1) {
+ xnoise3 = diffs3[0];
+ xnoise5 = diffs5[0];
+ } else {
+ qsort(diffs3, nrows, sizeof(double), FnCompare_double);
+ qsort(diffs5, nrows, sizeof(double), FnCompare_double);
+ xnoise3 = (diffs3[(nrows - 1)/2] + diffs3[nrows/2]) / 2.;
+ xnoise5 = (diffs5[(nrows - 1)/2] + diffs5[nrows/2]) / 2.;
+ }
+
+ if (nrows2 == 0) {
+ xnoise2 = 0;
+ } else if (nrows2 == 1) {
+ xnoise2 = diffs2[0];
+ } else {
+ qsort(diffs2, nrows2, sizeof(double), FnCompare_double);
+ xnoise2 = (diffs2[(nrows2 - 1)/2] + diffs2[nrows2/2]) / 2.;
+ }
+
+ if (ngood) *ngood = ngoodpix;
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (noise2) *noise2 = 1.0483579 * xnoise2;
+ if (noise3) *noise3 = 0.6052697 * xnoise3;
+ if (noise5) *noise5 = 0.1772048 * xnoise5;
+
+ free(diffs5);
+ free(diffs3);
+ free(diffs2);
+ free(differences5);
+ free(differences3);
+ free(differences2);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise5_double
+ (double *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ double nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ long *ngood, /* number of good, non-null pixels? */
+ double *minval, /* minimum non-null value */
+ double *maxval, /* maximum non-null value */
+ double *noise2, /* returned 2nd order MAD of all non-null pixels */
+ double *noise3, /* returned 3rd order MAD of all non-null pixels */
+ double *noise5, /* returned 5th order MAD of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Estimate the median and background noise in the input image using 2nd, 3rd and 5th
+order Median Absolute Differences.
+
+The noise in the background of the image is calculated using the MAD algorithms
+developed for deriving the signal to noise ratio in spectra
+(see issue #42 of the ST-ECF newsletter, http://www.stecf.org/documents/newsletter/)
+
+3rd order: noise = 1.482602 / sqrt(6) * median (abs(2*flux(i) - flux(i-2) - flux(i+2)))
+
+The returned estimates are the median of the values that are computed for each
+row of the image.
+*/
+{
+ long ii, jj, nrows = 0, nrows2 = 0, nvals, nvals2, ngoodpix = 0;
+ double *differences2, *differences3, *differences5;
+ double *rowpix, v1, v2, v3, v4, v5, v6, v7, v8, v9;
+ double xminval = DBL_MAX, xmaxval = -DBL_MAX;
+ int do_range = 0;
+ double *diffs2, *diffs3, *diffs5;
+ double xnoise2 = 0, xnoise3 = 0, xnoise5 = 0;
+
+ if (nx < 5) {
+ /* treat entire array as an image with a single row */
+ nx = nx * ny;
+ ny = 1;
+ }
+
+ /* rows must have at least 9 pixels */
+ if (nx < 9) {
+
+ for (ii = 0; ii < nx; ii++) {
+ if (nullcheck && array[ii] == nullvalue)
+ continue;
+ else {
+ if (array[ii] < xminval) xminval = array[ii];
+ if (array[ii] > xmaxval) xmaxval = array[ii];
+ ngoodpix++;
+ }
+ }
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (ngood) *ngood = ngoodpix;
+ if (noise2) *noise2 = 0.;
+ if (noise3) *noise3 = 0.;
+ if (noise5) *noise5 = 0.;
+ return(*status);
+ }
+
+ /* do we need to compute the min and max value? */
+ if (minval || maxval) do_range = 1;
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences2 = calloc(nx, sizeof(double));
+ if (!differences2) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ differences3 = calloc(nx, sizeof(double));
+ if (!differences3) {
+ free(differences2);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ differences5 = calloc(nx, sizeof(double));
+ if (!differences5) {
+ free(differences2);
+ free(differences3);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs2 = calloc(ny, sizeof(double));
+ if (!diffs2) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs3 = calloc(ny, sizeof(double));
+ if (!diffs3) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ free(diffs2);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs5 = calloc(ny, sizeof(double));
+ if (!diffs5) {
+ free(differences2);
+ free(differences3);
+ free(differences5);
+ free(diffs2);
+ free(diffs3);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v1 < xminval) xminval = v1;
+ if (v1 > xmaxval) xmaxval = v1;
+ }
+
+ /***** find the 2nd valid pixel in row (which we will skip over) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v2 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v2 < xminval) xminval = v2;
+ if (v2 > xmaxval) xmaxval = v2;
+ }
+
+ /***** find the 3rd valid pixel in row */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v3 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v3 < xminval) xminval = v3;
+ if (v3 > xmaxval) xmaxval = v3;
+ }
+
+ /* find the 4nd valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v4 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v4 < xminval) xminval = v4;
+ if (v4 > xmaxval) xmaxval = v4;
+ }
+
+ /* find the 5th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v5 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v5 < xminval) xminval = v5;
+ if (v5 > xmaxval) xmaxval = v5;
+ }
+
+ /* find the 6th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v6 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v6 < xminval) xminval = v6;
+ if (v6 > xmaxval) xmaxval = v6;
+ }
+
+ /* find the 7th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v7 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v7 < xminval) xminval = v7;
+ if (v7 > xmaxval) xmaxval = v7;
+ }
+
+ /* find the 8th valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v8 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v8 < xminval) xminval = v8;
+ if (v8 > xmaxval) xmaxval = v8;
+ }
+ /* now populate the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ nvals2 = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+ v9 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v9 < xminval) xminval = v9;
+ if (v9 > xmaxval) xmaxval = v9;
+ }
+
+ /* construct array of absolute differences */
+
+ if (!(v5 == v6 && v6 == v7) ) {
+ differences2[nvals2] = fabs(v5 - v7);
+ nvals2++;
+ }
+
+ if (!(v3 == v4 && v4 == v5 && v5 == v6 && v6 == v7) ) {
+ differences3[nvals] = fabs((2 * v5) - v3 - v7);
+ differences5[nvals] = fabs((6 * v5) - (4 * v3) - (4 * v7) + v1 + v9);
+ nvals++;
+ } else {
+ /* ignore constant background regions */
+ ngoodpix++;
+ }
+
+ /* shift over 1 pixel */
+ v1 = v2;
+ v2 = v3;
+ v3 = v4;
+ v4 = v5;
+ v5 = v6;
+ v6 = v7;
+ v7 = v8;
+ v8 = v9;
+ } /* end of loop over pixels in the row */
+
+ /* compute the median diffs */
+ /* Note that there are 8 more pixel values than there are diffs values. */
+ ngoodpix += (nvals + 8);
+
+ if (nvals == 0) {
+ continue; /* cannot compute medians on this row */
+ } else if (nvals == 1) {
+ if (nvals2 == 1) {
+ diffs2[nrows2] = differences2[0];
+ nrows2++;
+ }
+
+ diffs3[nrows] = differences3[0];
+ diffs5[nrows] = differences5[0];
+ } else {
+ /* quick_select returns the median MUCH faster than using qsort */
+ if (nvals2 > 1) {
+ diffs2[nrows2] = quick_select_double(differences2, nvals);
+ nrows2++;
+ }
+
+ diffs3[nrows] = quick_select_double(differences3, nvals);
+ diffs5[nrows] = quick_select_double(differences5, nvals);
+ }
+
+ nrows++;
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise3 = 0;
+ xnoise5 = 0;
+ } else if (nrows == 1) {
+ xnoise3 = diffs3[0];
+ xnoise5 = diffs5[0];
+ } else {
+ qsort(diffs3, nrows, sizeof(double), FnCompare_double);
+ qsort(diffs5, nrows, sizeof(double), FnCompare_double);
+ xnoise3 = (diffs3[(nrows - 1)/2] + diffs3[nrows/2]) / 2.;
+ xnoise5 = (diffs5[(nrows - 1)/2] + diffs5[nrows/2]) / 2.;
+ }
+
+ if (nrows2 == 0) {
+ xnoise2 = 0;
+ } else if (nrows2 == 1) {
+ xnoise2 = diffs2[0];
+ } else {
+ qsort(diffs2, nrows2, sizeof(double), FnCompare_double);
+ xnoise2 = (diffs2[(nrows2 - 1)/2] + diffs2[nrows2/2]) / 2.;
+ }
+
+ if (ngood) *ngood = ngoodpix;
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (noise2) *noise2 = 1.0483579 * xnoise2;
+ if (noise3) *noise3 = 0.6052697 * xnoise3;
+ if (noise5) *noise5 = 0.1772048 * xnoise5;
+
+ free(diffs5);
+ free(diffs3);
+ free(diffs2);
+ free(differences5);
+ free(differences3);
+ free(differences2);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise3_short
+ (short *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ short nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ long *ngood, /* number of good, non-null pixels? */
+ short *minval, /* minimum non-null value */
+ short *maxval, /* maximum non-null value */
+ double *noise, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Estimate the median and background noise in the input image using 3rd order differences.
+
+The noise in the background of the image is calculated using the 3rd order algorithm
+developed for deriving the signal to noise ratio in spectra
+(see issue #42 of the ST-ECF newsletter, http://www.stecf.org/documents/newsletter/)
+
+ noise = 1.482602 / sqrt(6) * median (abs(2*flux(i) - flux(i-2) - flux(i+2)))
+
+The returned estimates are the median of the values that are computed for each
+row of the image.
+*/
+{
+ long ii, jj, nrows = 0, nvals, ngoodpix = 0;
+ short *differences, *rowpix, v1, v2, v3, v4, v5;
+ short xminval = SHRT_MAX, xmaxval = SHRT_MIN, do_range = 0;
+ double *diffs, xnoise = 0, sigma;
+
+ if (nx < 5) {
+ /* treat entire array as an image with a single row */
+ nx = nx * ny;
+ ny = 1;
+ }
+
+ /* rows must have at least 5 pixels */
+ if (nx < 5) {
+
+ for (ii = 0; ii < nx; ii++) {
+ if (nullcheck && array[ii] == nullvalue)
+ continue;
+ else {
+ if (array[ii] < xminval) xminval = array[ii];
+ if (array[ii] > xmaxval) xmaxval = array[ii];
+ ngoodpix++;
+ }
+ }
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (ngood) *ngood = ngoodpix;
+ if (noise) *noise = 0.;
+ return(*status);
+ }
+
+ /* do we need to compute the min and max value? */
+ if (minval || maxval) do_range = 1;
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences = calloc(nx, sizeof(short));
+ if (!differences) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs = calloc(ny, sizeof(double));
+ if (!diffs) {
+ free(differences);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v1 < xminval) xminval = v1;
+ if (v1 > xmaxval) xmaxval = v1;
+ }
+
+ /***** find the 2nd valid pixel in row (which we will skip over) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v2 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v2 < xminval) xminval = v2;
+ if (v2 > xmaxval) xmaxval = v2;
+ }
+
+ /***** find the 3rd valid pixel in row */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v3 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v3 < xminval) xminval = v3;
+ if (v3 > xmaxval) xmaxval = v3;
+ }
+
+ /* find the 4nd valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v4 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v4 < xminval) xminval = v4;
+ if (v4 > xmaxval) xmaxval = v4;
+ }
+
+ /* now populate the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+ v5 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v5 < xminval) xminval = v5;
+ if (v5 > xmaxval) xmaxval = v5;
+ }
+
+ /* construct array of 3rd order absolute differences */
+ if (!(v1 == v2 && v2 == v3 && v3 == v4 && v4 == v5)) {
+ differences[nvals] = abs((2 * v3) - v1 - v5);
+ nvals++;
+ } else {
+ /* ignore constant background regions */
+ ngoodpix++;
+ }
+
+
+ /* shift over 1 pixel */
+ v1 = v2;
+ v2 = v3;
+ v3 = v4;
+ v4 = v5;
+ } /* end of loop over pixels in the row */
+
+ /* compute the 3rd order diffs */
+ /* Note that there are 4 more pixel values than there are diffs values. */
+ ngoodpix += (nvals + 4);
+
+ if (nvals == 0) {
+ continue; /* cannot compute medians on this row */
+ } else if (nvals == 1) {
+ diffs[nrows] = differences[0];
+ } else {
+ /* quick_select returns the median MUCH faster than using qsort */
+ diffs[nrows] = quick_select_short(differences, nvals);
+ }
+
+ nrows++;
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise = 0;
+ } else if (nrows == 1) {
+ xnoise = diffs[0];
+ } else {
+
+
+ qsort(diffs, nrows, sizeof(double), FnCompare_double);
+ xnoise = (diffs[(nrows - 1)/2] + diffs[nrows/2]) / 2.;
+
+ FnMeanSigma_double(diffs, nrows, 0, 0.0, 0, &xnoise, &sigma, status);
+
+ /* do a 4.5 sigma rejection of outliers */
+ jj = 0;
+ sigma = 4.5 * sigma;
+ for (ii = 0; ii < nrows; ii++) {
+ if ( fabs(diffs[ii] - xnoise) <= sigma) {
+ if (jj != ii)
+ diffs[jj] = diffs[ii];
+ jj++;
+ }
+ }
+ if (ii != jj)
+ FnMeanSigma_double(diffs, jj, 0, 0.0, 0, &xnoise, &sigma, status);
+ }
+
+ if (ngood) *ngood = ngoodpix;
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (noise) *noise = 0.6052697 * xnoise;
+
+ free(diffs);
+ free(differences);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise3_int
+ (int *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ int nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ long *ngood, /* number of good, non-null pixels? */
+ int *minval, /* minimum non-null value */
+ int *maxval, /* maximum non-null value */
+ double *noise, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Estimate the background noise in the input image using 3rd order differences.
+
+The noise in the background of the image is calculated using the 3rd order algorithm
+developed for deriving the signal to noise ratio in spectra
+(see issue #42 of the ST-ECF newsletter, http://www.stecf.org/documents/newsletter/)
+
+ noise = 1.482602 / sqrt(6) * median (abs(2*flux(i) - flux(i-2) - flux(i+2)))
+
+The returned estimates are the median of the values that are computed for each
+row of the image.
+*/
+{
+ long ii, jj, nrows = 0, nvals, ngoodpix = 0;
+ int *differences, *rowpix, v1, v2, v3, v4, v5;
+ int xminval = INT_MAX, xmaxval = INT_MIN, do_range = 0;
+ double *diffs, xnoise = 0, sigma;
+
+ if (nx < 5) {
+ /* treat entire array as an image with a single row */
+ nx = nx * ny;
+ ny = 1;
+ }
+
+ /* rows must have at least 5 pixels */
+ if (nx < 5) {
+
+ for (ii = 0; ii < nx; ii++) {
+ if (nullcheck && array[ii] == nullvalue)
+ continue;
+ else {
+ if (array[ii] < xminval) xminval = array[ii];
+ if (array[ii] > xmaxval) xmaxval = array[ii];
+ ngoodpix++;
+ }
+ }
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (ngood) *ngood = ngoodpix;
+ if (noise) *noise = 0.;
+ return(*status);
+ }
+
+ /* do we need to compute the min and max value? */
+ if (minval || maxval) do_range = 1;
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences = calloc(nx, sizeof(int));
+ if (!differences) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs = calloc(ny, sizeof(double));
+ if (!diffs) {
+ free(differences);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v1 < xminval) xminval = v1;
+ if (v1 > xmaxval) xmaxval = v1;
+ }
+
+ /***** find the 2nd valid pixel in row (which we will skip over) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v2 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v2 < xminval) xminval = v2;
+ if (v2 > xmaxval) xmaxval = v2;
+ }
+
+ /***** find the 3rd valid pixel in row */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v3 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v3 < xminval) xminval = v3;
+ if (v3 > xmaxval) xmaxval = v3;
+ }
+
+ /* find the 4nd valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v4 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v4 < xminval) xminval = v4;
+ if (v4 > xmaxval) xmaxval = v4;
+ }
+
+ /* now populate the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+ v5 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v5 < xminval) xminval = v5;
+ if (v5 > xmaxval) xmaxval = v5;
+ }
+
+ /* construct array of 3rd order absolute differences */
+ if (!(v1 == v2 && v2 == v3 && v3 == v4 && v4 == v5)) {
+ differences[nvals] = abs((2 * v3) - v1 - v5);
+ nvals++;
+ } else {
+ /* ignore constant background regions */
+ ngoodpix++;
+ }
+
+ /* shift over 1 pixel */
+ v1 = v2;
+ v2 = v3;
+ v3 = v4;
+ v4 = v5;
+ } /* end of loop over pixels in the row */
+
+ /* compute the 3rd order diffs */
+ /* Note that there are 4 more pixel values than there are diffs values. */
+ ngoodpix += (nvals + 4);
+
+ if (nvals == 0) {
+ continue; /* cannot compute medians on this row */
+ } else if (nvals == 1) {
+ diffs[nrows] = differences[0];
+ } else {
+ /* quick_select returns the median MUCH faster than using qsort */
+ diffs[nrows] = quick_select_int(differences, nvals);
+ }
+
+ nrows++;
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise = 0;
+ } else if (nrows == 1) {
+ xnoise = diffs[0];
+ } else {
+
+ qsort(diffs, nrows, sizeof(double), FnCompare_double);
+ xnoise = (diffs[(nrows - 1)/2] + diffs[nrows/2]) / 2.;
+
+ FnMeanSigma_double(diffs, nrows, 0, 0.0, 0, &xnoise, &sigma, status);
+
+ /* do a 4.5 sigma rejection of outliers */
+ jj = 0;
+ sigma = 4.5 * sigma;
+ for (ii = 0; ii < nrows; ii++) {
+ if ( fabs(diffs[ii] - xnoise) <= sigma) {
+ if (jj != ii)
+ diffs[jj] = diffs[ii];
+ jj++;
+ }
+ }
+ if (ii != jj)
+ FnMeanSigma_double(diffs, jj, 0, 0.0, 0, &xnoise, &sigma, status);
+ }
+
+ if (ngood) *ngood = ngoodpix;
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (noise) *noise = 0.6052697 * xnoise;
+
+ free(diffs);
+ free(differences);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise3_float
+ (float *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ float nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ long *ngood, /* number of good, non-null pixels? */
+ float *minval, /* minimum non-null value */
+ float *maxval, /* maximum non-null value */
+ double *noise, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Estimate the median and background noise in the input image using 3rd order differences.
+
+The noise in the background of the image is calculated using the 3rd order algorithm
+developed for deriving the signal to noise ratio in spectra
+(see issue #42 of the ST-ECF newsletter, http://www.stecf.org/documents/newsletter/)
+
+ noise = 1.482602 / sqrt(6) * median (abs(2*flux(i) - flux(i-2) - flux(i+2)))
+
+The returned estimates are the median of the values that are computed for each
+row of the image.
+*/
+{
+ long ii, jj, nrows = 0, nvals, ngoodpix = 0;
+ float *differences, *rowpix, v1, v2, v3, v4, v5;
+ float xminval = FLT_MAX, xmaxval = -FLT_MAX;
+ int do_range = 0;
+ double *diffs, xnoise = 0;
+
+ if (nx < 5) {
+ /* treat entire array as an image with a single row */
+ nx = nx * ny;
+ ny = 1;
+ }
+
+ /* rows must have at least 5 pixels to calc noise, so just calc min, max, ngood */
+ if (nx < 5) {
+
+ for (ii = 0; ii < nx; ii++) {
+ if (nullcheck && array[ii] == nullvalue)
+ continue;
+ else {
+ if (array[ii] < xminval) xminval = array[ii];
+ if (array[ii] > xmaxval) xmaxval = array[ii];
+ ngoodpix++;
+ }
+ }
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (ngood) *ngood = ngoodpix;
+ if (noise) *noise = 0.;
+ return(*status);
+ }
+
+ /* do we need to compute the min and max value? */
+ if (minval || maxval) do_range = 1;
+
+ /* allocate arrays used to compute the median and noise estimates */
+ if (noise) {
+ differences = calloc(nx, sizeof(float));
+ if (!differences) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs = calloc(ny, sizeof(double));
+ if (!diffs) {
+ free(differences);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v1 < xminval) xminval = v1;
+ if (v1 > xmaxval) xmaxval = v1;
+ }
+
+ /***** find the 2nd valid pixel in row (which we will skip over) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v2 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v2 < xminval) xminval = v2;
+ if (v2 > xmaxval) xmaxval = v2;
+ }
+
+ /***** find the 3rd valid pixel in row */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v3 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v3 < xminval) xminval = v3;
+ if (v3 > xmaxval) xmaxval = v3;
+ }
+
+ /* find the 4nd valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v4 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v4 < xminval) xminval = v4;
+ if (v4 > xmaxval) xmaxval = v4;
+ }
+
+ /* now populate the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) {
+ ii++;
+ }
+
+ if (ii == nx) break; /* hit end of row */
+ v5 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v5 < xminval) xminval = v5;
+ if (v5 > xmaxval) xmaxval = v5;
+ }
+
+ /* construct array of 3rd order absolute differences */
+ if (noise) {
+ if (!(v1 == v2 && v2 == v3 && v3 == v4 && v4 == v5)) {
+
+ differences[nvals] = (float) fabs((2. * v3) - v1 - v5);
+ nvals++;
+ } else {
+ /* ignore constant background regions */
+ ngoodpix++;
+ }
+ } else {
+ /* just increment the number of non-null pixels */
+ ngoodpix++;
+ }
+
+ /* shift over 1 pixel */
+ v1 = v2;
+ v2 = v3;
+ v3 = v4;
+ v4 = v5;
+ } /* end of loop over pixels in the row */
+
+ /* compute the 3rd order diffs */
+ /* Note that there are 4 more pixel values than there are diffs values. */
+ ngoodpix += (nvals + 4);
+
+ if (noise) {
+ if (nvals == 0) {
+ continue; /* cannot compute medians on this row */
+ } else if (nvals == 1) {
+ diffs[nrows] = differences[0];
+ } else {
+ /* quick_select returns the median MUCH faster than using qsort */
+ diffs[nrows] = quick_select_float(differences, nvals);
+ }
+ }
+ nrows++;
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (noise) {
+ if (nrows == 0) {
+ xnoise = 0;
+ } else if (nrows == 1) {
+ xnoise = diffs[0];
+ } else {
+ qsort(diffs, nrows, sizeof(double), FnCompare_double);
+ xnoise = (diffs[(nrows - 1)/2] + diffs[nrows/2]) / 2.;
+ }
+ }
+
+ if (ngood) *ngood = ngoodpix;
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (noise) {
+ *noise = 0.6052697 * xnoise;
+ free(diffs);
+ free(differences);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise3_double
+ (double *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ double nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ long *ngood, /* number of good, non-null pixels? */
+ double *minval, /* minimum non-null value */
+ double *maxval, /* maximum non-null value */
+ double *noise, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+
+/*
+Estimate the median and background noise in the input image using 3rd order differences.
+
+The noise in the background of the image is calculated using the 3rd order algorithm
+developed for deriving the signal to noise ratio in spectra
+(see issue #42 of the ST-ECF newsletter, http://www.stecf.org/documents/newsletter/)
+
+ noise = 1.482602 / sqrt(6) * median (abs(2*flux(i) - flux(i-2) - flux(i+2)))
+
+The returned estimates are the median of the values that are computed for each
+row of the image.
+*/
+{
+ long ii, jj, nrows = 0, nvals, ngoodpix = 0;
+ double *differences, *rowpix, v1, v2, v3, v4, v5;
+ double xminval = DBL_MAX, xmaxval = -DBL_MAX;
+ int do_range = 0;
+ double *diffs, xnoise = 0;
+
+ if (nx < 5) {
+ /* treat entire array as an image with a single row */
+ nx = nx * ny;
+ ny = 1;
+ }
+
+ /* rows must have at least 5 pixels */
+ if (nx < 5) {
+
+ for (ii = 0; ii < nx; ii++) {
+ if (nullcheck && array[ii] == nullvalue)
+ continue;
+ else {
+ if (array[ii] < xminval) xminval = array[ii];
+ if (array[ii] > xmaxval) xmaxval = array[ii];
+ ngoodpix++;
+ }
+ }
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (ngood) *ngood = ngoodpix;
+ if (noise) *noise = 0.;
+ return(*status);
+ }
+
+ /* do we need to compute the min and max value? */
+ if (minval || maxval) do_range = 1;
+
+ /* allocate arrays used to compute the median and noise estimates */
+ if (noise) {
+ differences = calloc(nx, sizeof(double));
+ if (!differences) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs = calloc(ny, sizeof(double));
+ if (!diffs) {
+ free(differences);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v1 < xminval) xminval = v1;
+ if (v1 > xmaxval) xmaxval = v1;
+ }
+
+ /***** find the 2nd valid pixel in row (which we will skip over) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v2 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v2 < xminval) xminval = v2;
+ if (v2 > xmaxval) xmaxval = v2;
+ }
+
+ /***** find the 3rd valid pixel in row */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v3 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v3 < xminval) xminval = v3;
+ if (v3 > xmaxval) xmaxval = v3;
+ }
+
+ /* find the 4nd valid pixel in row (to be skipped) */
+ ii++;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v4 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v4 < xminval) xminval = v4;
+ if (v4 > xmaxval) xmaxval = v4;
+ }
+
+ /* now populate the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+ v5 = rowpix[ii]; /* store the good pixel value */
+
+ if (do_range) {
+ if (v5 < xminval) xminval = v5;
+ if (v5 > xmaxval) xmaxval = v5;
+ }
+
+ /* construct array of 3rd order absolute differences */
+ if (noise) {
+ if (!(v1 == v2 && v2 == v3 && v3 == v4 && v4 == v5)) {
+
+ differences[nvals] = fabs((2. * v3) - v1 - v5);
+ nvals++;
+ } else {
+ /* ignore constant background regions */
+ ngoodpix++;
+ }
+ } else {
+ /* just increment the number of non-null pixels */
+ ngoodpix++;
+ }
+
+ /* shift over 1 pixel */
+ v1 = v2;
+ v2 = v3;
+ v3 = v4;
+ v4 = v5;
+ } /* end of loop over pixels in the row */
+
+ /* compute the 3rd order diffs */
+ /* Note that there are 4 more pixel values than there are diffs values. */
+ ngoodpix += (nvals + 4);
+
+ if (noise) {
+ if (nvals == 0) {
+ continue; /* cannot compute medians on this row */
+ } else if (nvals == 1) {
+ diffs[nrows] = differences[0];
+ } else {
+ /* quick_select returns the median MUCH faster than using qsort */
+ diffs[nrows] = quick_select_double(differences, nvals);
+ }
+ }
+ nrows++;
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (noise) {
+ if (nrows == 0) {
+ xnoise = 0;
+ } else if (nrows == 1) {
+ xnoise = diffs[0];
+ } else {
+ qsort(diffs, nrows, sizeof(double), FnCompare_double);
+ xnoise = (diffs[(nrows - 1)/2] + diffs[nrows/2]) / 2.;
+ }
+ }
+
+ if (ngood) *ngood = ngoodpix;
+ if (minval) *minval = xminval;
+ if (maxval) *maxval = xmaxval;
+ if (noise) {
+ *noise = 0.6052697 * xnoise;
+ free(diffs);
+ free(differences);
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise1_short
+ (short *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ short nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ double *noise, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+/*
+Estimate the background noise in the input image using sigma of 1st order differences.
+
+ noise = 1.0 / sqrt(2) * rms of (flux[i] - flux[i-1])
+
+The returned estimate is the median of the values that are computed for each
+row of the image.
+*/
+{
+ int iter;
+ long ii, jj, kk, nrows = 0, nvals;
+ short *differences, *rowpix, v1;
+ double *diffs, xnoise, mean, stdev;
+
+ /* rows must have at least 3 pixels to estimate noise */
+ if (nx < 3) {
+ *noise = 0;
+ return(*status);
+ }
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences = calloc(nx, sizeof(short));
+ if (!differences) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs = calloc(ny, sizeof(double));
+ if (!diffs) {
+ free(differences);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ /* now continue populating the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+
+ /* construct array of 1st order differences */
+ differences[nvals] = v1 - rowpix[ii];
+
+ nvals++;
+ /* shift over 1 pixel */
+ v1 = rowpix[ii];
+ } /* end of loop over pixels in the row */
+
+ if (nvals < 2)
+ continue;
+ else {
+
+ FnMeanSigma_short(differences, nvals, 0, 0, 0, &mean, &stdev, status);
+
+ if (stdev > 0.) {
+ for (iter = 0; iter < NITER; iter++) {
+ kk = 0;
+ for (ii = 0; ii < nvals; ii++) {
+ if (fabs (differences[ii] - mean) < SIGMA_CLIP * stdev) {
+ if (kk < ii)
+ differences[kk] = differences[ii];
+ kk++;
+ }
+ }
+ if (kk == nvals) break;
+
+ nvals = kk;
+ FnMeanSigma_short(differences, nvals, 0, 0, 0, &mean, &stdev, status);
+ }
+ }
+
+ diffs[nrows] = stdev;
+ nrows++;
+ }
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise = 0;
+ } else if (nrows == 1) {
+ xnoise = diffs[0];
+ } else {
+ qsort(diffs, nrows, sizeof(double), FnCompare_double);
+ xnoise = (diffs[(nrows - 1)/2] + diffs[nrows/2]) / 2.;
+ }
+
+ *noise = .70710678 * xnoise;
+
+ free(diffs);
+ free(differences);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise1_int
+ (int *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ int nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ double *noise, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+/*
+Estimate the background noise in the input image using sigma of 1st order differences.
+
+ noise = 1.0 / sqrt(2) * rms of (flux[i] - flux[i-1])
+
+The returned estimate is the median of the values that are computed for each
+row of the image.
+*/
+{
+ int iter;
+ long ii, jj, kk, nrows = 0, nvals;
+ int *differences, *rowpix, v1;
+ double *diffs, xnoise, mean, stdev;
+
+ /* rows must have at least 3 pixels to estimate noise */
+ if (nx < 3) {
+ *noise = 0;
+ return(*status);
+ }
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences = calloc(nx, sizeof(int));
+ if (!differences) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs = calloc(ny, sizeof(double));
+ if (!diffs) {
+ free(differences);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ /* now continue populating the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+
+ /* construct array of 1st order differences */
+ differences[nvals] = v1 - rowpix[ii];
+
+ nvals++;
+ /* shift over 1 pixel */
+ v1 = rowpix[ii];
+ } /* end of loop over pixels in the row */
+
+ if (nvals < 2)
+ continue;
+ else {
+
+ FnMeanSigma_int(differences, nvals, 0, 0, 0, &mean, &stdev, status);
+
+ if (stdev > 0.) {
+ for (iter = 0; iter < NITER; iter++) {
+ kk = 0;
+ for (ii = 0; ii < nvals; ii++) {
+ if (fabs (differences[ii] - mean) < SIGMA_CLIP * stdev) {
+ if (kk < ii)
+ differences[kk] = differences[ii];
+ kk++;
+ }
+ }
+ if (kk == nvals) break;
+
+ nvals = kk;
+ FnMeanSigma_int(differences, nvals, 0, 0, 0, &mean, &stdev, status);
+ }
+ }
+
+ diffs[nrows] = stdev;
+ nrows++;
+ }
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise = 0;
+ } else if (nrows == 1) {
+ xnoise = diffs[0];
+ } else {
+ qsort(diffs, nrows, sizeof(double), FnCompare_double);
+ xnoise = (diffs[(nrows - 1)/2] + diffs[nrows/2]) / 2.;
+ }
+
+ *noise = .70710678 * xnoise;
+
+ free(diffs);
+ free(differences);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise1_float
+ (float *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ float nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ double *noise, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+/*
+Estimate the background noise in the input image using sigma of 1st order differences.
+
+ noise = 1.0 / sqrt(2) * rms of (flux[i] - flux[i-1])
+
+The returned estimate is the median of the values that are computed for each
+row of the image.
+*/
+{
+ int iter;
+ long ii, jj, kk, nrows = 0, nvals;
+ float *differences, *rowpix, v1;
+ double *diffs, xnoise, mean, stdev;
+
+ /* rows must have at least 3 pixels to estimate noise */
+ if (nx < 3) {
+ *noise = 0;
+ return(*status);
+ }
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences = calloc(nx, sizeof(float));
+ if (!differences) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs = calloc(ny, sizeof(double));
+ if (!diffs) {
+ free(differences);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ /* now continue populating the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+
+ /* construct array of 1st order differences */
+ differences[nvals] = v1 - rowpix[ii];
+
+ nvals++;
+ /* shift over 1 pixel */
+ v1 = rowpix[ii];
+ } /* end of loop over pixels in the row */
+
+ if (nvals < 2)
+ continue;
+ else {
+
+ FnMeanSigma_float(differences, nvals, 0, 0, 0, &mean, &stdev, status);
+
+ if (stdev > 0.) {
+ for (iter = 0; iter < NITER; iter++) {
+ kk = 0;
+ for (ii = 0; ii < nvals; ii++) {
+ if (fabs (differences[ii] - mean) < SIGMA_CLIP * stdev) {
+ if (kk < ii)
+ differences[kk] = differences[ii];
+ kk++;
+ }
+ }
+ if (kk == nvals) break;
+
+ nvals = kk;
+ FnMeanSigma_float(differences, nvals, 0, 0, 0, &mean, &stdev, status);
+ }
+ }
+
+ diffs[nrows] = stdev;
+ nrows++;
+ }
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise = 0;
+ } else if (nrows == 1) {
+ xnoise = diffs[0];
+ } else {
+ qsort(diffs, nrows, sizeof(double), FnCompare_double);
+ xnoise = (diffs[(nrows - 1)/2] + diffs[nrows/2]) / 2.;
+ }
+
+ *noise = .70710678 * xnoise;
+
+ free(diffs);
+ free(differences);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnNoise1_double
+ (double *array, /* 2 dimensional array of image pixels */
+ long nx, /* number of pixels in each row of the image */
+ long ny, /* number of rows in the image */
+ int nullcheck, /* check for null values, if true */
+ double nullvalue, /* value of null pixels, if nullcheck is true */
+ /* returned parameters */
+ double *noise, /* returned R.M.S. value of all non-null pixels */
+ int *status) /* error status */
+/*
+Estimate the background noise in the input image using sigma of 1st order differences.
+
+ noise = 1.0 / sqrt(2) * rms of (flux[i] - flux[i-1])
+
+The returned estimate is the median of the values that are computed for each
+row of the image.
+*/
+{
+ int iter;
+ long ii, jj, kk, nrows = 0, nvals;
+ double *differences, *rowpix, v1;
+ double *diffs, xnoise, mean, stdev;
+
+ /* rows must have at least 3 pixels to estimate noise */
+ if (nx < 3) {
+ *noise = 0;
+ return(*status);
+ }
+
+ /* allocate arrays used to compute the median and noise estimates */
+ differences = calloc(nx, sizeof(double));
+ if (!differences) {
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ diffs = calloc(ny, sizeof(double));
+ if (!diffs) {
+ free(differences);
+ *status = MEMORY_ALLOCATION;
+ return(*status);
+ }
+
+ /* loop over each row of the image */
+ for (jj=0; jj < ny; jj++) {
+
+ rowpix = array + (jj * nx); /* point to first pixel in the row */
+
+ /***** find the first valid pixel in row */
+ ii = 0;
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) continue; /* hit end of row */
+ v1 = rowpix[ii]; /* store the good pixel value */
+
+ /* now continue populating the differences arrays */
+ /* for the remaining pixels in the row */
+ nvals = 0;
+ for (ii++; ii < nx; ii++) {
+
+ /* find the next valid pixel in row */
+ if (nullcheck)
+ while (ii < nx && rowpix[ii] == nullvalue) ii++;
+
+ if (ii == nx) break; /* hit end of row */
+
+ /* construct array of 1st order differences */
+ differences[nvals] = v1 - rowpix[ii];
+
+ nvals++;
+ /* shift over 1 pixel */
+ v1 = rowpix[ii];
+ } /* end of loop over pixels in the row */
+
+ if (nvals < 2)
+ continue;
+ else {
+
+ FnMeanSigma_double(differences, nvals, 0, 0, 0, &mean, &stdev, status);
+
+ if (stdev > 0.) {
+ for (iter = 0; iter < NITER; iter++) {
+ kk = 0;
+ for (ii = 0; ii < nvals; ii++) {
+ if (fabs (differences[ii] - mean) < SIGMA_CLIP * stdev) {
+ if (kk < ii)
+ differences[kk] = differences[ii];
+ kk++;
+ }
+ }
+ if (kk == nvals) break;
+
+ nvals = kk;
+ FnMeanSigma_double(differences, nvals, 0, 0, 0, &mean, &stdev, status);
+ }
+ }
+
+ diffs[nrows] = stdev;
+ nrows++;
+ }
+ } /* end of loop over rows */
+
+ /* compute median of the values for each row */
+ if (nrows == 0) {
+ xnoise = 0;
+ } else if (nrows == 1) {
+ xnoise = diffs[0];
+ } else {
+ qsort(diffs, nrows, sizeof(double), FnCompare_double);
+ xnoise = (diffs[(nrows - 1)/2] + diffs[nrows/2]) / 2.;
+ }
+
+ *noise = .70710678 * xnoise;
+
+ free(diffs);
+ free(differences);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+static int FnCompare_short(const void *v1, const void *v2)
+{
+ const short *i1 = v1;
+ const short *i2 = v2;
+
+ if (*i1 < *i2)
+ return(-1);
+ else if (*i1 > *i2)
+ return(1);
+ else
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+static int FnCompare_int(const void *v1, const void *v2)
+{
+ const int *i1 = v1;
+ const int *i2 = v2;
+
+ if (*i1 < *i2)
+ return(-1);
+ else if (*i1 > *i2)
+ return(1);
+ else
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+static int FnCompare_float(const void *v1, const void *v2)
+{
+ const float *i1 = v1;
+ const float *i2 = v2;
+
+ if (*i1 < *i2)
+ return(-1);
+ else if (*i1 > *i2)
+ return(1);
+ else
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+static int FnCompare_double(const void *v1, const void *v2)
+{
+ const double *i1 = v1;
+ const double *i2 = v2;
+
+ if (*i1 < *i2)
+ return(-1);
+ else if (*i1 > *i2)
+ return(1);
+ else
+ return(0);
+}
+/*--------------------------------------------------------------------------*/
+
+/*
+ * These Quickselect routines are based on the algorithm described in
+ * "Numerical recipes in C", Second Edition,
+ * Cambridge University Press, 1992, Section 8.5, ISBN 0-521-43108-5
+ * This code by Nicolas Devillard - 1998. Public domain.
+ */
+
+/*--------------------------------------------------------------------------*/
+
+#define ELEM_SWAP(a,b) { register float t=(a);(a)=(b);(b)=t; }
+
+static float quick_select_float(float arr[], int n)
+{
+ int low, high ;
+ int median;
+ int middle, ll, hh;
+
+ low = 0 ; high = n-1 ; median = (low + high) / 2;
+ for (;;) {
+ if (high <= low) /* One element only */
+ return arr[median] ;
+
+ if (high == low + 1) { /* Two elements only */
+ if (arr[low] > arr[high])
+ ELEM_SWAP(arr[low], arr[high]) ;
+ return arr[median] ;
+ }
+
+ /* Find median of low, middle and high items; swap into position low */
+ middle = (low + high) / 2;
+ if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ;
+ if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ;
+ if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ;
+
+ /* Swap low item (now in position middle) into position (low+1) */
+ ELEM_SWAP(arr[middle], arr[low+1]) ;
+
+ /* Nibble from each end towards middle, swapping items when stuck */
+ ll = low + 1;
+ hh = high;
+ for (;;) {
+ do ll++; while (arr[low] > arr[ll]) ;
+ do hh--; while (arr[hh] > arr[low]) ;
+
+ if (hh < ll)
+ break;
+
+ ELEM_SWAP(arr[ll], arr[hh]) ;
+ }
+
+ /* Swap middle item (in position low) back into correct position */
+ ELEM_SWAP(arr[low], arr[hh]) ;
+
+ /* Re-set active partition */
+ if (hh <= median)
+ low = ll;
+ if (hh >= median)
+ high = hh - 1;
+ }
+}
+
+#undef ELEM_SWAP
+
+/*--------------------------------------------------------------------------*/
+
+#define ELEM_SWAP(a,b) { register short t=(a);(a)=(b);(b)=t; }
+
+static short quick_select_short(short arr[], int n)
+{
+ int low, high ;
+ int median;
+ int middle, ll, hh;
+
+ low = 0 ; high = n-1 ; median = (low + high) / 2;
+ for (;;) {
+ if (high <= low) /* One element only */
+ return arr[median] ;
+
+ if (high == low + 1) { /* Two elements only */
+ if (arr[low] > arr[high])
+ ELEM_SWAP(arr[low], arr[high]) ;
+ return arr[median] ;
+ }
+
+ /* Find median of low, middle and high items; swap into position low */
+ middle = (low + high) / 2;
+ if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ;
+ if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ;
+ if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ;
+
+ /* Swap low item (now in position middle) into position (low+1) */
+ ELEM_SWAP(arr[middle], arr[low+1]) ;
+
+ /* Nibble from each end towards middle, swapping items when stuck */
+ ll = low + 1;
+ hh = high;
+ for (;;) {
+ do ll++; while (arr[low] > arr[ll]) ;
+ do hh--; while (arr[hh] > arr[low]) ;
+
+ if (hh < ll)
+ break;
+
+ ELEM_SWAP(arr[ll], arr[hh]) ;
+ }
+
+ /* Swap middle item (in position low) back into correct position */
+ ELEM_SWAP(arr[low], arr[hh]) ;
+
+ /* Re-set active partition */
+ if (hh <= median)
+ low = ll;
+ if (hh >= median)
+ high = hh - 1;
+ }
+}
+
+#undef ELEM_SWAP
+
+/*--------------------------------------------------------------------------*/
+
+#define ELEM_SWAP(a,b) { register int t=(a);(a)=(b);(b)=t; }
+
+static int quick_select_int(int arr[], int n)
+{
+ int low, high ;
+ int median;
+ int middle, ll, hh;
+
+ low = 0 ; high = n-1 ; median = (low + high) / 2;
+ for (;;) {
+ if (high <= low) /* One element only */
+ return arr[median] ;
+
+ if (high == low + 1) { /* Two elements only */
+ if (arr[low] > arr[high])
+ ELEM_SWAP(arr[low], arr[high]) ;
+ return arr[median] ;
+ }
+
+ /* Find median of low, middle and high items; swap into position low */
+ middle = (low + high) / 2;
+ if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ;
+ if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ;
+ if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ;
+
+ /* Swap low item (now in position middle) into position (low+1) */
+ ELEM_SWAP(arr[middle], arr[low+1]) ;
+
+ /* Nibble from each end towards middle, swapping items when stuck */
+ ll = low + 1;
+ hh = high;
+ for (;;) {
+ do ll++; while (arr[low] > arr[ll]) ;
+ do hh--; while (arr[hh] > arr[low]) ;
+
+ if (hh < ll)
+ break;
+
+ ELEM_SWAP(arr[ll], arr[hh]) ;
+ }
+
+ /* Swap middle item (in position low) back into correct position */
+ ELEM_SWAP(arr[low], arr[hh]) ;
+
+ /* Re-set active partition */
+ if (hh <= median)
+ low = ll;
+ if (hh >= median)
+ high = hh - 1;
+ }
+}
+
+#undef ELEM_SWAP
+
+/*--------------------------------------------------------------------------*/
+
+#define ELEM_SWAP(a,b) { register LONGLONG t=(a);(a)=(b);(b)=t; }
+
+static LONGLONG quick_select_longlong(LONGLONG arr[], int n)
+{
+ int low, high ;
+ int median;
+ int middle, ll, hh;
+
+ low = 0 ; high = n-1 ; median = (low + high) / 2;
+ for (;;) {
+ if (high <= low) /* One element only */
+ return arr[median] ;
+
+ if (high == low + 1) { /* Two elements only */
+ if (arr[low] > arr[high])
+ ELEM_SWAP(arr[low], arr[high]) ;
+ return arr[median] ;
+ }
+
+ /* Find median of low, middle and high items; swap into position low */
+ middle = (low + high) / 2;
+ if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ;
+ if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ;
+ if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ;
+
+ /* Swap low item (now in position middle) into position (low+1) */
+ ELEM_SWAP(arr[middle], arr[low+1]) ;
+
+ /* Nibble from each end towards middle, swapping items when stuck */
+ ll = low + 1;
+ hh = high;
+ for (;;) {
+ do ll++; while (arr[low] > arr[ll]) ;
+ do hh--; while (arr[hh] > arr[low]) ;
+
+ if (hh < ll)
+ break;
+
+ ELEM_SWAP(arr[ll], arr[hh]) ;
+ }
+
+ /* Swap middle item (in position low) back into correct position */
+ ELEM_SWAP(arr[low], arr[hh]) ;
+
+ /* Re-set active partition */
+ if (hh <= median)
+ low = ll;
+ if (hh >= median)
+ high = hh - 1;
+ }
+}
+
+#undef ELEM_SWAP
+
+/*--------------------------------------------------------------------------*/
+
+#define ELEM_SWAP(a,b) { register double t=(a);(a)=(b);(b)=t; }
+
+static double quick_select_double(double arr[], int n)
+{
+ int low, high ;
+ int median;
+ int middle, ll, hh;
+
+ low = 0 ; high = n-1 ; median = (low + high) / 2;
+ for (;;) {
+ if (high <= low) /* One element only */
+ return arr[median] ;
+
+ if (high == low + 1) { /* Two elements only */
+ if (arr[low] > arr[high])
+ ELEM_SWAP(arr[low], arr[high]) ;
+ return arr[median] ;
+ }
+
+ /* Find median of low, middle and high items; swap into position low */
+ middle = (low + high) / 2;
+ if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ;
+ if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ;
+ if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ;
+
+ /* Swap low item (now in position middle) into position (low+1) */
+ ELEM_SWAP(arr[middle], arr[low+1]) ;
+
+ /* Nibble from each end towards middle, swapping items when stuck */
+ ll = low + 1;
+ hh = high;
+ for (;;) {
+ do ll++; while (arr[low] > arr[ll]) ;
+ do hh--; while (arr[hh] > arr[low]) ;
+
+ if (hh < ll)
+ break;
+
+ ELEM_SWAP(arr[ll], arr[hh]) ;
+ }
+
+ /* Swap middle item (in position low) back into correct position */
+ ELEM_SWAP(arr[low], arr[hh]) ;
+
+ /* Re-set active partition */
+ if (hh <= median)
+ low = ll;
+ if (hh >= median)
+ high = hh - 1;
+ }
+}
+
+#undef ELEM_SWAP
+
+
diff --git a/src/plugins/cfitsio/region.c b/src/plugins/cfitsio/region.c
new file mode 100644
index 0000000..3ec5bc2
--- /dev/null
+++ b/src/plugins/cfitsio/region.c
@@ -0,0 +1,1747 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <ctype.h>
+#include "fitsio2.h"
+#include "region.h"
+static int Pt_in_Poly( double x, double y, int nPts, double *Pts );
+
+/*---------------------------------------------------------------------------*/
+int fits_read_rgnfile( const char *filename,
+ WCSdata *wcs,
+ SAORegion **Rgn,
+ int *status )
+/* Read regions from either a FITS or ASCII region file and return the information */
+/* in the "SAORegion" structure. If it is nonNULL, use wcs to convert the */
+/* region coordinates to pixels. Return an error if region is in degrees */
+/* but no WCS data is provided. */
+/*---------------------------------------------------------------------------*/
+{
+ fitsfile *fptr;
+ int tstatus = 0;
+
+ if( *status ) return( *status );
+
+ /* try to open as a FITS file - if that doesn't work treat as an ASCII file */
+
+ fits_write_errmark();
+ if ( ffopen(&fptr, filename, READONLY, &tstatus) ) {
+ fits_clear_errmark();
+ fits_read_ascii_region(filename, wcs, Rgn, status);
+ } else {
+ fits_read_fits_region(fptr, wcs, Rgn, status);
+ }
+
+ return(*status);
+
+}
+/*---------------------------------------------------------------------------*/
+int fits_read_ascii_region( const char *filename,
+ WCSdata *wcs,
+ SAORegion **Rgn,
+ int *status )
+/* Read regions from a SAO-style region file and return the information */
+/* in the "SAORegion" structure. If it is nonNULL, use wcs to convert the */
+/* region coordinates to pixels. Return an error if region is in degrees */
+/* but no WCS data is provided. */
+/*---------------------------------------------------------------------------*/
+{
+ char *currLine;
+ char *namePtr, *paramPtr, *currLoc;
+ char *pX, *pY, *endp;
+ long allocLen, lineLen, hh, mm, dd;
+ double *coords, X, Y, x, y, ss, div, xsave= 0., ysave= 0.;
+ int nParams, nCoords, negdec;
+ int i, done;
+ FILE *rgnFile;
+ coordFmt cFmt;
+ SAORegion *aRgn;
+ RgnShape *newShape, *tmpShape;
+
+ if( *status ) return( *status );
+
+ aRgn = (SAORegion *)malloc( sizeof(SAORegion) );
+ if( ! aRgn ) {
+ ffpmsg("Couldn't allocate memory to hold Region file contents.");
+ return(*status = MEMORY_ALLOCATION );
+ }
+ aRgn->nShapes = 0;
+ aRgn->Shapes = NULL;
+ if( wcs && wcs->exists )
+ aRgn->wcs = *wcs;
+ else
+ aRgn->wcs.exists = 0;
+
+ cFmt = pixel_fmt; /* set default format */
+
+ /* Allocate Line Buffer */
+
+ allocLen = 512;
+ currLine = (char *)malloc( allocLen * sizeof(char) );
+ if( !currLine ) {
+ free( aRgn );
+ ffpmsg("Couldn't allocate memory to hold Region file contents.");
+ return(*status = MEMORY_ALLOCATION );
+ }
+
+ /* Open Region File */
+
+ if( (rgnFile = fopen( filename, "r" ))==NULL ) {
+ sprintf(currLine,"Could not open Region file %s.",filename);
+ ffpmsg( currLine );
+ free( currLine );
+ free( aRgn );
+ return( *status = FILE_NOT_OPENED );
+ }
+
+ /* Read in file, line by line */
+
+ while( fgets(currLine,allocLen,rgnFile) != NULL ) {
+
+ /* Make sure we have a full line of text */
+
+ lineLen = strlen(currLine);
+ while( lineLen==allocLen-1 && currLine[lineLen-1]!='\n' ) {
+ currLoc = (char *)realloc( currLine, 2 * allocLen * sizeof(char) );
+ if( !currLoc ) {
+ ffpmsg("Couldn't allocate memory to hold Region file contents.");
+ *status = MEMORY_ALLOCATION;
+ goto error;
+ } else {
+ currLine = currLoc;
+ }
+ fgets( currLine+lineLen, allocLen+1, rgnFile );
+ allocLen += allocLen;
+ lineLen += strlen(currLine+lineLen);
+ }
+
+ currLoc = currLine;
+ if( *currLoc == '#' ) {
+
+ /* Look to see if it is followed by a format statement... */
+ /* if not skip line */
+
+ currLoc++;
+ while( isspace(*currLoc) ) currLoc++;
+ if( !strncasecmp( currLoc, "format:", 7 ) ) {
+ if( aRgn->nShapes ) {
+ ffpmsg("Format code encountered after reading 1 or more shapes.");
+ *status = PARSE_SYNTAX_ERR;
+ goto error;
+ }
+ currLoc += 7;
+ while( isspace(*currLoc) ) currLoc++;
+ if( !strncasecmp( currLoc, "pixel", 5 ) ) {
+ cFmt = pixel_fmt;
+ } else if( !strncasecmp( currLoc, "degree", 6 ) ) {
+ cFmt = degree_fmt;
+ } else if( !strncasecmp( currLoc, "hhmmss", 6 ) ) {
+ cFmt = hhmmss_fmt;
+ } else if( !strncasecmp( currLoc, "hms", 3 ) ) {
+ cFmt = hhmmss_fmt;
+ } else {
+ ffpmsg("Unknown format code encountered in region file.");
+ *status = PARSE_SYNTAX_ERR;
+ goto error;
+ }
+ }
+
+ } else if( !strncasecmp( currLoc, "glob", 4 ) ) {
+ /* skip lines that begin with the word 'global' */
+
+ } else {
+
+ while( *currLoc != '\0' ) {
+
+ namePtr = currLoc;
+ paramPtr = NULL;
+ nParams = 1;
+
+ /* Search for closing parenthesis */
+
+ done = 0;
+ while( !done && !*status && *currLoc ) {
+ switch (*currLoc) {
+ case '(':
+ *currLoc = '\0';
+ currLoc++;
+ if( paramPtr ) /* Can't have two '(' in a region! */
+ *status = 1;
+ else
+ paramPtr = currLoc;
+ break;
+ case ')':
+ *currLoc = '\0';
+ currLoc++;
+ if( !paramPtr ) /* Can't have a ')' without a '(' first */
+ *status = 1;
+ else
+ done = 1;
+ break;
+ case '#':
+ case '\n':
+ *currLoc = '\0';
+ if( !paramPtr ) /* Allow for a blank line */
+ done = 1;
+ break;
+ case ':':
+ currLoc++;
+ if ( paramPtr ) cFmt = hhmmss_fmt; /* set format if parameter has : */
+ break;
+ case 'd':
+ currLoc++;
+ if ( paramPtr ) cFmt = degree_fmt; /* set format if parameter has d */
+ break;
+ case ',':
+ nParams++; /* Fall through to default */
+ default:
+ currLoc++;
+ break;
+ }
+ }
+ if( *status || !done ) {
+ ffpmsg( "Error reading Region file" );
+ *status = PARSE_SYNTAX_ERR;
+ goto error;
+ }
+
+ /* Skip white space in region name */
+
+ while( isspace(*namePtr) ) namePtr++;
+
+ /* Was this a blank line? Or the end of the current one */
+
+ if( ! *namePtr && ! paramPtr ) continue;
+
+ /* Check for format code at beginning of the line */
+
+ if( !strncasecmp( namePtr, "image;", 6 ) ) {
+ namePtr += 6;
+ cFmt = pixel_fmt;
+ } else if( !strncasecmp( namePtr, "physical;", 9 ) ) {
+ namePtr += 9;
+ cFmt = pixel_fmt;
+ } else if( !strncasecmp( namePtr, "linear;", 7 ) ) {
+ namePtr += 7;
+ cFmt = pixel_fmt;
+ } else if( !strncasecmp( namePtr, "fk4;", 4 ) ) {
+ namePtr += 4;
+ cFmt = degree_fmt;
+ } else if( !strncasecmp( namePtr, "fk5;", 4 ) ) {
+ namePtr += 4;
+ cFmt = degree_fmt;
+ } else if( !strncasecmp( namePtr, "icrs;", 5 ) ) {
+ namePtr += 5;
+ cFmt = degree_fmt;
+
+ /* the following 5 cases support region files created by POW
+ (or ds9 Version 4.x) which
+ may have lines containing only a format code, not followed
+ by a ';' (and with no region specifier on the line). We use
+ the 'continue' statement to jump to the end of the loop and
+ then continue reading the next line of the region file. */
+
+ } else if( !strncasecmp( namePtr, "fk5", 3 ) ) {
+ cFmt = degree_fmt;
+ continue; /* supports POW region file format */
+ } else if( !strncasecmp( namePtr, "fk4", 3 ) ) {
+ cFmt = degree_fmt;
+ continue; /* supports POW region file format */
+ } else if( !strncasecmp( namePtr, "icrs", 4 ) ) {
+ cFmt = degree_fmt;
+ continue; /* supports POW region file format */
+ } else if( !strncasecmp( namePtr, "image", 5 ) ) {
+ cFmt = pixel_fmt;
+ continue; /* supports POW region file format */
+ } else if( !strncasecmp( namePtr, "physical", 8 ) ) {
+ cFmt = pixel_fmt;
+ continue; /* supports POW region file format */
+
+
+ } else if( !strncasecmp( namePtr, "galactic;", 9 ) ) {
+ ffpmsg( "Galactic region coordinates not supported" );
+ ffpmsg( namePtr );
+ *status = PARSE_SYNTAX_ERR;
+ goto error;
+ } else if( !strncasecmp( namePtr, "ecliptic;", 9 ) ) {
+ ffpmsg( "ecliptic region coordinates not supported" );
+ ffpmsg( namePtr );
+ *status = PARSE_SYNTAX_ERR;
+ goto error;
+ }
+
+ /**************************************************/
+ /* We've apparently found a region... Set it up */
+ /**************************************************/
+
+ if( !(aRgn->nShapes % 10) ) {
+ if( aRgn->Shapes )
+ tmpShape = (RgnShape *)realloc( aRgn->Shapes,
+ (10+aRgn->nShapes)
+ * sizeof(RgnShape) );
+ else
+ tmpShape = (RgnShape *) malloc( 10 * sizeof(RgnShape) );
+ if( tmpShape ) {
+ aRgn->Shapes = tmpShape;
+ } else {
+ ffpmsg( "Failed to allocate memory for Region data");
+ *status = MEMORY_ALLOCATION;
+ goto error;
+ }
+
+ }
+ newShape = &aRgn->Shapes[aRgn->nShapes++];
+ newShape->sign = 1;
+ newShape->shape = point_rgn;
+ for (i=0; i<8; i++) newShape->param.gen.p[i] = 0.0;
+ newShape->param.gen.a = 0.0;
+ newShape->param.gen.b = 0.0;
+ newShape->param.gen.sinT = 0.0;
+ newShape->param.gen.cosT = 0.0;
+
+ while( isspace(*namePtr) ) namePtr++;
+
+ /* Check for the shape's sign */
+
+ if( *namePtr=='+' ) {
+ namePtr++;
+ } else if( *namePtr=='-' ) {
+ namePtr++;
+ newShape->sign = 0;
+ }
+
+ /* Skip white space in region name */
+
+ while( isspace(*namePtr) ) namePtr++;
+ if( *namePtr=='\0' ) {
+ ffpmsg( "Error reading Region file" );
+ *status = PARSE_SYNTAX_ERR;
+ goto error;
+ }
+ lineLen = strlen( namePtr ) - 1;
+ while( isspace(namePtr[lineLen]) ) namePtr[lineLen--] = '\0';
+
+ /* Now identify the region */
+
+ if( !strcasecmp( namePtr, "circle" ) ) {
+ newShape->shape = circle_rgn;
+ if( nParams != 3 )
+ *status = PARSE_SYNTAX_ERR;
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "annulus" ) ) {
+ newShape->shape = annulus_rgn;
+ if( nParams != 4 )
+ *status = PARSE_SYNTAX_ERR;
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "ellipse" ) ) {
+ if( nParams < 4 || nParams > 8 ) {
+ *status = PARSE_SYNTAX_ERR;
+ } else if ( nParams < 6 ) {
+ newShape->shape = ellipse_rgn;
+ newShape->param.gen.p[4] = 0.0;
+ } else {
+ newShape->shape = elliptannulus_rgn;
+ newShape->param.gen.p[6] = 0.0;
+ newShape->param.gen.p[7] = 0.0;
+ }
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "elliptannulus" ) ) {
+ newShape->shape = elliptannulus_rgn;
+ if( !( nParams==8 || nParams==6 ) )
+ *status = PARSE_SYNTAX_ERR;
+ newShape->param.gen.p[6] = 0.0;
+ newShape->param.gen.p[7] = 0.0;
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "box" )
+ || !strcasecmp( namePtr, "rotbox" ) ) {
+ if( nParams < 4 || nParams > 8 ) {
+ *status = PARSE_SYNTAX_ERR;
+ } else if ( nParams < 6 ) {
+ newShape->shape = box_rgn;
+ newShape->param.gen.p[4] = 0.0;
+ } else {
+ newShape->shape = boxannulus_rgn;
+ newShape->param.gen.p[6] = 0.0;
+ newShape->param.gen.p[7] = 0.0;
+ }
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "rectangle" )
+ || !strcasecmp( namePtr, "rotrectangle" ) ) {
+ newShape->shape = rectangle_rgn;
+ if( nParams < 4 || nParams > 5 )
+ *status = PARSE_SYNTAX_ERR;
+ newShape->param.gen.p[4] = 0.0;
+ nCoords = 4;
+ } else if( !strcasecmp( namePtr, "diamond" )
+ || !strcasecmp( namePtr, "rotdiamond" )
+ || !strcasecmp( namePtr, "rhombus" )
+ || !strcasecmp( namePtr, "rotrhombus" ) ) {
+ newShape->shape = diamond_rgn;
+ if( nParams < 4 || nParams > 5 )
+ *status = PARSE_SYNTAX_ERR;
+ newShape->param.gen.p[4] = 0.0;
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "sector" )
+ || !strcasecmp( namePtr, "pie" ) ) {
+ newShape->shape = sector_rgn;
+ if( nParams != 4 )
+ *status = PARSE_SYNTAX_ERR;
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "point" ) ) {
+ newShape->shape = point_rgn;
+ if( nParams != 2 )
+ *status = PARSE_SYNTAX_ERR;
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "line" ) ) {
+ newShape->shape = line_rgn;
+ if( nParams != 4 )
+ *status = PARSE_SYNTAX_ERR;
+ nCoords = 4;
+ } else if( !strcasecmp( namePtr, "polygon" ) ) {
+ newShape->shape = poly_rgn;
+ if( nParams < 6 || (nParams&1) )
+ *status = PARSE_SYNTAX_ERR;
+ nCoords = nParams;
+ } else if( !strcasecmp( namePtr, "panda" ) ) {
+ newShape->shape = panda_rgn;
+ if( nParams != 8 )
+ *status = PARSE_SYNTAX_ERR;
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "epanda" ) ) {
+ newShape->shape = epanda_rgn;
+ if( nParams < 10 || nParams > 11 )
+ *status = PARSE_SYNTAX_ERR;
+ newShape->param.gen.p[10] = 0.0;
+ nCoords = 2;
+ } else if( !strcasecmp( namePtr, "bpanda" ) ) {
+ newShape->shape = bpanda_rgn;
+ if( nParams < 10 || nParams > 11 )
+ *status = PARSE_SYNTAX_ERR;
+ newShape->param.gen.p[10] = 0.0;
+ nCoords = 2;
+ } else {
+ ffpmsg( "Unrecognized region found in region file:" );
+ ffpmsg( namePtr );
+ *status = PARSE_SYNTAX_ERR;
+ goto error;
+ }
+ if( *status ) {
+ ffpmsg( "Wrong number of parameters found for region" );
+ ffpmsg( namePtr );
+ goto error;
+ }
+
+ /* Parse Parameter string... convert to pixels if necessary */
+
+ if( newShape->shape==poly_rgn ) {
+ newShape->param.poly.Pts = (double *)malloc( nParams
+ * sizeof(double) );
+ if( !newShape->param.poly.Pts ) {
+ ffpmsg(
+ "Could not allocate memory to hold polygon parameters" );
+ *status = MEMORY_ALLOCATION;
+ goto error;
+ }
+ newShape->param.poly.nPts = nParams;
+ coords = newShape->param.poly.Pts;
+ } else
+ coords = newShape->param.gen.p;
+
+ /* Parse the initial "WCS?" coordinates */
+ for( i=0; i<nCoords; i+=2 ) {
+
+ pX = paramPtr;
+ while( *paramPtr!=',' ) paramPtr++;
+ *(paramPtr++) = '\0';
+
+ pY = paramPtr;
+ while( *paramPtr!=',' && *paramPtr != '\0' ) paramPtr++;
+ *(paramPtr++) = '\0';
+
+ if( strchr(pX, ':' ) ) {
+ /* Read in special format & convert to decimal degrees */
+ cFmt = hhmmss_fmt;
+ mm = 0;
+ ss = 0.;
+ hh = strtol(pX, &endp, 10);
+ if (endp && *endp==':') {
+ pX = endp + 1;
+ mm = strtol(pX, &endp, 10);
+ if (endp && *endp==':') {
+ pX = endp + 1;
+ ss = atof( pX );
+ }
+ }
+ X = 15. * (hh + mm/60. + ss/3600.); /* convert to degrees */
+
+ mm = 0;
+ ss = 0.;
+ negdec = 0;
+
+ while( isspace(*pY) ) pY++;
+ if (*pY=='-') {
+ negdec = 1;
+ pY++;
+ }
+ dd = strtol(pY, &endp, 10);
+ if (endp && *endp==':') {
+ pY = endp + 1;
+ mm = strtol(pY, &endp, 10);
+ if (endp && *endp==':') {
+ pY = endp + 1;
+ ss = atof( pY );
+ }
+ }
+ if (negdec)
+ Y = -dd - mm/60. - ss/3600.; /* convert to degrees */
+ else
+ Y = dd + mm/60. + ss/3600.;
+
+ } else {
+ X = atof( pX );
+ Y = atof( pY );
+ }
+ if (i==0) { /* save 1st coord. in case needed later */
+ xsave = X;
+ ysave = Y;
+ }
+
+ if( cFmt!=pixel_fmt ) {
+ /* Convert to pixels */
+ if( wcs==NULL || ! wcs->exists ) {
+ ffpmsg("WCS information needed to convert region coordinates.");
+ *status = NO_WCS_KEY;
+ goto error;
+ }
+
+ if( ffxypx( X, Y, wcs->xrefval, wcs->yrefval,
+ wcs->xrefpix, wcs->yrefpix,
+ wcs->xinc, wcs->yinc,
+ wcs->rot, wcs->type,
+ &x, &y, status ) ) {
+ ffpmsg("Error converting region to pixel coordinates.");
+ goto error;
+ }
+ X = x; Y = y;
+ }
+ coords[i] = X;
+ coords[i+1] = Y;
+
+ }
+
+ /* Read in remaining parameters... */
+
+ for( ; i<nParams; i++ ) {
+ pX = paramPtr;
+ while( *paramPtr!=',' && *paramPtr != '\0' ) paramPtr++;
+ *(paramPtr++) = '\0';
+ coords[i] = strtod( pX, &endp );
+
+ if (endp && (*endp=='"' || *endp=='\'' || *endp=='d') ) {
+ div = 1.0;
+ if ( *endp=='"' ) div = 3600.0;
+ if ( *endp=='\'' ) div = 60.0;
+ /* parameter given in arcsec so convert to pixels. */
+ /* Increment first Y coordinate by this amount then calc */
+ /* the distance in pixels from the original coordinate. */
+ /* NOTE: This assumes the pixels are square!! */
+ if (ysave < 0.)
+ Y = ysave + coords[i]/div; /* don't exceed -90 */
+ else
+ Y = ysave - coords[i]/div; /* don't exceed +90 */
+
+ X = xsave;
+ if( ffxypx( X, Y, wcs->xrefval, wcs->yrefval,
+ wcs->xrefpix, wcs->yrefpix,
+ wcs->xinc, wcs->yinc,
+ wcs->rot, wcs->type,
+ &x, &y, status ) ) {
+ ffpmsg("Error converting region to pixel coordinates.");
+ goto error;
+ }
+
+ coords[i] = sqrt( pow(x-coords[0],2) + pow(y-coords[1],2) );
+
+ }
+ }
+
+ /* special case for elliptannulus and boxannulus if only one angle
+ was given */
+
+ if ( (newShape->shape == elliptannulus_rgn ||
+ newShape->shape == boxannulus_rgn ) && nParams == 7 ) {
+ coords[7] = coords[6];
+ }
+
+ /* Also, correct the position angle for any WCS rotation: */
+ /* If regions are specified in WCS coordintes, then the angles */
+ /* are relative to the WCS system, not the pixel X,Y system */
+
+ if( cFmt!=pixel_fmt ) {
+ switch( newShape->shape ) {
+ case sector_rgn:
+ case panda_rgn:
+ coords[2] += (wcs->rot);
+ coords[3] += (wcs->rot);
+ break;
+ case box_rgn:
+ case rectangle_rgn:
+ case diamond_rgn:
+ case ellipse_rgn:
+ coords[4] += (wcs->rot);
+ break;
+ case boxannulus_rgn:
+ case elliptannulus_rgn:
+ coords[6] += (wcs->rot);
+ coords[7] += (wcs->rot);
+ break;
+ case epanda_rgn:
+ case bpanda_rgn:
+ coords[2] += (wcs->rot);
+ coords[3] += (wcs->rot);
+ coords[10] += (wcs->rot);
+ }
+ }
+
+ /* do some precalculations to speed up tests */
+
+ fits_setup_shape(newShape);
+
+ } /* End of while( *currLoc ) */
+/*
+ if (coords)printf("%.8f %.8f %.8f %.8f %.8f\n",
+ coords[0],coords[1],coords[2],coords[3],coords[4]);
+*/
+ } /* End of if...else parse line */
+ } /* End of while( fgets(rgnFile) ) */
+
+ /* set up component numbers */
+
+ fits_set_region_components( aRgn );
+
+error:
+
+ if( *status ) {
+ fits_free_region( aRgn );
+ } else {
+ *Rgn = aRgn;
+ }
+
+ fclose( rgnFile );
+ free( currLine );
+
+ return( *status );
+}
+
+/*---------------------------------------------------------------------------*/
+int fits_in_region( double X,
+ double Y,
+ SAORegion *Rgn )
+/* Test if the given point is within the region described by Rgn. X and */
+/* Y are in pixel coordinates. */
+/*---------------------------------------------------------------------------*/
+{
+ double x, y, dx, dy, xprime, yprime, r, th;
+ RgnShape *Shapes;
+ int i, cur_comp;
+ int result, comp_result;
+
+ Shapes = Rgn->Shapes;
+
+ result = 0;
+ comp_result = 0;
+ cur_comp = Rgn->Shapes[0].comp;
+
+ for( i=0; i<Rgn->nShapes; i++, Shapes++ ) {
+
+ /* if this region has a different component number to the last one */
+ /* then replace the accumulated selection logical with the union of */
+ /* the current logical and the total logical. Reinitialize the */
+ /* temporary logical. */
+
+ if ( i==0 || Shapes->comp != cur_comp ) {
+ result = result || comp_result;
+ cur_comp = Shapes->comp;
+ /* if an excluded region is given first, then implicitly */
+ /* assume a previous shape that includes the entire image. */
+ comp_result = !Shapes->sign;
+ }
+
+ /* only need to test if */
+ /* the point is not already included and this is an include region, */
+ /* or the point is included and this is an excluded region */
+
+ if ( (!comp_result && Shapes->sign) || (comp_result && !Shapes->sign) ) {
+
+ comp_result = 1;
+
+ switch( Shapes->shape ) {
+
+ case box_rgn:
+ /* Shift origin to center of region */
+ xprime = X - Shapes->param.gen.p[0];
+ yprime = Y - Shapes->param.gen.p[1];
+
+ /* Rotate point to region's orientation */
+ x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT;
+ y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT;
+
+ dx = 0.5 * Shapes->param.gen.p[2];
+ dy = 0.5 * Shapes->param.gen.p[3];
+ if( (x < -dx) || (x > dx) || (y < -dy) || (y > dy) )
+ comp_result = 0;
+ break;
+
+ case boxannulus_rgn:
+ /* Shift origin to center of region */
+ xprime = X - Shapes->param.gen.p[0];
+ yprime = Y - Shapes->param.gen.p[1];
+
+ /* Rotate point to region's orientation */
+ x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT;
+ y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT;
+
+ dx = 0.5 * Shapes->param.gen.p[4];
+ dy = 0.5 * Shapes->param.gen.p[5];
+ if( (x < -dx) || (x > dx) || (y < -dy) || (y > dy) ) {
+ comp_result = 0;
+ } else {
+ /* Repeat test for inner box */
+ x = xprime * Shapes->param.gen.b + yprime * Shapes->param.gen.a;
+ y = -xprime * Shapes->param.gen.a + yprime * Shapes->param.gen.b;
+
+ dx = 0.5 * Shapes->param.gen.p[2];
+ dy = 0.5 * Shapes->param.gen.p[3];
+ if( (x >= -dx) && (x <= dx) && (y >= -dy) && (y <= dy) )
+ comp_result = 0;
+ }
+ break;
+
+ case rectangle_rgn:
+ /* Shift origin to center of region */
+ xprime = X - Shapes->param.gen.p[5];
+ yprime = Y - Shapes->param.gen.p[6];
+
+ /* Rotate point to region's orientation */
+ x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT;
+ y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT;
+
+ dx = Shapes->param.gen.a;
+ dy = Shapes->param.gen.b;
+ if( (x < -dx) || (x > dx) || (y < -dy) || (y > dy) )
+ comp_result = 0;
+ break;
+
+ case diamond_rgn:
+ /* Shift origin to center of region */
+ xprime = X - Shapes->param.gen.p[0];
+ yprime = Y - Shapes->param.gen.p[1];
+
+ /* Rotate point to region's orientation */
+ x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT;
+ y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT;
+
+ dx = 0.5 * Shapes->param.gen.p[2];
+ dy = 0.5 * Shapes->param.gen.p[3];
+ r = fabs(x/dx) + fabs(y/dy);
+ if( r > 1 )
+ comp_result = 0;
+ break;
+
+ case circle_rgn:
+ /* Shift origin to center of region */
+ x = X - Shapes->param.gen.p[0];
+ y = Y - Shapes->param.gen.p[1];
+
+ r = x*x + y*y;
+ if ( r > Shapes->param.gen.a )
+ comp_result = 0;
+ break;
+
+ case annulus_rgn:
+ /* Shift origin to center of region */
+ x = X - Shapes->param.gen.p[0];
+ y = Y - Shapes->param.gen.p[1];
+
+ r = x*x + y*y;
+ if ( r < Shapes->param.gen.a || r > Shapes->param.gen.b )
+ comp_result = 0;
+ break;
+
+ case sector_rgn:
+ /* Shift origin to center of region */
+ x = X - Shapes->param.gen.p[0];
+ y = Y - Shapes->param.gen.p[1];
+
+ if( x || y ) {
+ r = atan2( y, x ) * RadToDeg;
+ if( Shapes->param.gen.p[2] <= Shapes->param.gen.p[3] ) {
+ if( r < Shapes->param.gen.p[2] || r > Shapes->param.gen.p[3] )
+ comp_result = 0;
+ } else {
+ if( r < Shapes->param.gen.p[2] && r > Shapes->param.gen.p[3] )
+ comp_result = 0;
+ }
+ }
+ break;
+
+ case ellipse_rgn:
+ /* Shift origin to center of region */
+ xprime = X - Shapes->param.gen.p[0];
+ yprime = Y - Shapes->param.gen.p[1];
+
+ /* Rotate point to region's orientation */
+ x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT;
+ y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT;
+
+ x /= Shapes->param.gen.p[2];
+ y /= Shapes->param.gen.p[3];
+ r = x*x + y*y;
+ if( r>1.0 )
+ comp_result = 0;
+ break;
+
+ case elliptannulus_rgn:
+ /* Shift origin to center of region */
+ xprime = X - Shapes->param.gen.p[0];
+ yprime = Y - Shapes->param.gen.p[1];
+
+ /* Rotate point to outer ellipse's orientation */
+ x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT;
+ y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT;
+
+ x /= Shapes->param.gen.p[4];
+ y /= Shapes->param.gen.p[5];
+ r = x*x + y*y;
+ if( r>1.0 )
+ comp_result = 0;
+ else {
+ /* Repeat test for inner ellipse */
+ x = xprime * Shapes->param.gen.b + yprime * Shapes->param.gen.a;
+ y = -xprime * Shapes->param.gen.a + yprime * Shapes->param.gen.b;
+
+ x /= Shapes->param.gen.p[2];
+ y /= Shapes->param.gen.p[3];
+ r = x*x + y*y;
+ if( r<1.0 )
+ comp_result = 0;
+ }
+ break;
+
+ case line_rgn:
+ /* Shift origin to first point of line */
+ xprime = X - Shapes->param.gen.p[0];
+ yprime = Y - Shapes->param.gen.p[1];
+
+ /* Rotate point to line's orientation */
+ x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT;
+ y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT;
+
+ if( (y < -0.5) || (y >= 0.5) || (x < -0.5)
+ || (x >= Shapes->param.gen.a) )
+ comp_result = 0;
+ break;
+
+ case point_rgn:
+ /* Shift origin to center of region */
+ x = X - Shapes->param.gen.p[0];
+ y = Y - Shapes->param.gen.p[1];
+
+ if ( (x<-0.5) || (x>=0.5) || (y<-0.5) || (y>=0.5) )
+ comp_result = 0;
+ break;
+
+ case poly_rgn:
+ if( X<Shapes->xmin || X>Shapes->xmax
+ || Y<Shapes->ymin || Y>Shapes->ymax )
+ comp_result = 0;
+ else
+ comp_result = Pt_in_Poly( X, Y, Shapes->param.poly.nPts,
+ Shapes->param.poly.Pts );
+ break;
+
+ case panda_rgn:
+ /* Shift origin to center of region */
+ x = X - Shapes->param.gen.p[0];
+ y = Y - Shapes->param.gen.p[1];
+
+ r = x*x + y*y;
+ if ( r < Shapes->param.gen.a || r > Shapes->param.gen.b ) {
+ comp_result = 0;
+ } else {
+ if( x || y ) {
+ th = atan2( y, x ) * RadToDeg;
+ if( Shapes->param.gen.p[2] <= Shapes->param.gen.p[3] ) {
+ if( th < Shapes->param.gen.p[2] || th > Shapes->param.gen.p[3] )
+ comp_result = 0;
+ } else {
+ if( th < Shapes->param.gen.p[2] && th > Shapes->param.gen.p[3] )
+ comp_result = 0;
+ }
+ }
+ }
+ break;
+
+ case epanda_rgn:
+ /* Shift origin to center of region */
+ xprime = X - Shapes->param.gen.p[0];
+ yprime = Y - Shapes->param.gen.p[1];
+
+ /* Rotate point to region's orientation */
+ x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT;
+ y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT;
+ xprime = x;
+ yprime = y;
+
+ /* outer region test */
+ x = xprime/Shapes->param.gen.p[7];
+ y = yprime/Shapes->param.gen.p[8];
+ r = x*x + y*y;
+ if ( r>1.0 )
+ comp_result = 0;
+ else {
+ /* inner region test */
+ x = xprime/Shapes->param.gen.p[5];
+ y = yprime/Shapes->param.gen.p[6];
+ r = x*x + y*y;
+ if ( r<1.0 )
+ comp_result = 0;
+ else {
+ /* angle test */
+ if( xprime || yprime ) {
+ th = atan2( yprime, xprime ) * RadToDeg;
+ if( Shapes->param.gen.p[2] <= Shapes->param.gen.p[3] ) {
+ if( th < Shapes->param.gen.p[2] || th > Shapes->param.gen.p[3] )
+ comp_result = 0;
+ } else {
+ if( th < Shapes->param.gen.p[2] && th > Shapes->param.gen.p[3] )
+ comp_result = 0;
+ }
+ }
+ }
+ }
+ break;
+
+ case bpanda_rgn:
+ /* Shift origin to center of region */
+ xprime = X - Shapes->param.gen.p[0];
+ yprime = Y - Shapes->param.gen.p[1];
+
+ /* Rotate point to region's orientation */
+ x = xprime * Shapes->param.gen.cosT + yprime * Shapes->param.gen.sinT;
+ y = -xprime * Shapes->param.gen.sinT + yprime * Shapes->param.gen.cosT;
+
+ /* outer box test */
+ dx = 0.5 * Shapes->param.gen.p[7];
+ dy = 0.5 * Shapes->param.gen.p[8];
+ if( (x < -dx) || (x > dx) || (y < -dy) || (y > dy) )
+ comp_result = 0;
+ else {
+ /* inner box test */
+ dx = 0.5 * Shapes->param.gen.p[5];
+ dy = 0.5 * Shapes->param.gen.p[6];
+ if( (x >= -dx) && (x <= dx) && (y >= -dy) && (y <= dy) )
+ comp_result = 0;
+ else {
+ /* angle test */
+ if( x || y ) {
+ th = atan2( y, x ) * RadToDeg;
+ if( Shapes->param.gen.p[2] <= Shapes->param.gen.p[3] ) {
+ if( th < Shapes->param.gen.p[2] || th > Shapes->param.gen.p[3] )
+ comp_result = 0;
+ } else {
+ if( th < Shapes->param.gen.p[2] && th > Shapes->param.gen.p[3] )
+ comp_result = 0;
+ }
+ }
+ }
+ }
+ break;
+ }
+
+ if( !Shapes->sign ) comp_result = !comp_result;
+
+ }
+
+ }
+
+ result = result || comp_result;
+
+ return( result );
+}
+
+/*---------------------------------------------------------------------------*/
+void fits_free_region( SAORegion *Rgn )
+/* Free up memory allocated to hold the region data. */
+/*---------------------------------------------------------------------------*/
+{
+ int i;
+
+ for( i=0; i<Rgn->nShapes; i++ )
+ if( Rgn->Shapes[i].shape == poly_rgn )
+ free( Rgn->Shapes[i].param.poly.Pts );
+ if( Rgn->Shapes )
+ free( Rgn->Shapes );
+ free( Rgn );
+}
+
+/*---------------------------------------------------------------------------*/
+static int Pt_in_Poly( double x,
+ double y,
+ int nPts,
+ double *Pts )
+/* Internal routine for testing whether the coordinate x,y is within the */
+/* polygon region traced out by the array Pts. */
+/*---------------------------------------------------------------------------*/
+{
+ int i, j, flag=0;
+ double prevX, prevY;
+ double nextX, nextY;
+ double dx, dy, Dy;
+
+ nextX = Pts[nPts-2];
+ nextY = Pts[nPts-1];
+
+ for( i=0; i<nPts; i+=2 ) {
+ prevX = nextX;
+ prevY = nextY;
+
+ nextX = Pts[i];
+ nextY = Pts[i+1];
+
+ if( (y>prevY && y>=nextY) || (y<prevY && y<=nextY)
+ || (x>prevX && x>=nextX) )
+ continue;
+
+ /* Check to see if x,y lies right on the segment */
+
+ if( x>=prevX || x>nextX ) {
+ dy = y - prevY;
+ Dy = nextY - prevY;
+
+ if( fabs(Dy)<1e-10 ) {
+ if( fabs(dy)<1e-10 )
+ return( 1 );
+ else
+ continue;
+ }
+
+ dx = prevX + ( (nextX-prevX)/(Dy) ) * dy - x;
+ if( dx < -1e-10 )
+ continue;
+ if( dx < 1e-10 )
+ return( 1 );
+ }
+
+ /* There is an intersection! Make sure it isn't a V point. */
+
+ if( y != prevY ) {
+ flag = 1 - flag;
+ } else {
+ j = i+1; /* Point to Y component */
+ do {
+ if( j>1 )
+ j -= 2;
+ else
+ j = nPts-1;
+ } while( y == Pts[j] );
+
+ if( (nextY-y)*(y-Pts[j]) > 0 )
+ flag = 1-flag;
+ }
+
+ }
+ return( flag );
+}
+/*---------------------------------------------------------------------------*/
+void fits_set_region_components ( SAORegion *aRgn )
+{
+/*
+ Internal routine to turn a collection of regions read from an ascii file into
+ the more complex structure that is allowed by the FITS REGION extension with
+ multiple components. Regions are anded within components and ored between them
+ ie for a pixel to be selected it must be selected by at least one component
+ and to be selected by a component it must be selected by all that component's
+ shapes.
+
+ The algorithm is to replicate every exclude region after every include
+ region before it in the list. eg reg1, reg2, -reg3, reg4, -reg5 becomes
+ (reg1, -reg3, -reg5), (reg2, -reg5, -reg3), (reg4, -reg5) where the
+ parentheses designate components.
+*/
+
+ int i, j, k, icomp;
+
+/* loop round shapes */
+
+ i = 0;
+ while ( i<aRgn->nShapes ) {
+
+ /* first do the case of an exclude region */
+
+ if ( !aRgn->Shapes[i].sign ) {
+
+ /* we need to run back through the list copying the current shape as
+ required. start by findin the first include shape before this exclude */
+
+ j = i-1;
+ while ( j > 0 && !aRgn->Shapes[j].sign ) j--;
+
+ /* then go back one more shape */
+
+ j--;
+
+ /* and loop back through the regions */
+
+ while ( j >= 0 ) {
+
+ /* if this is an include region then insert a copy of the exclude
+ region immediately after it */
+
+ if ( aRgn->Shapes[j].sign ) {
+
+ aRgn->Shapes = (RgnShape *) realloc (aRgn->Shapes,(1+aRgn->nShapes)*sizeof(RgnShape));
+ aRgn->nShapes++;
+ for (k=aRgn->nShapes-1; k>j+1; k--) aRgn->Shapes[k] = aRgn->Shapes[k-1];
+
+ i++;
+ aRgn->Shapes[j+1] = aRgn->Shapes[i];
+
+ }
+
+ j--;
+
+ }
+
+ }
+
+ i++;
+
+ }
+
+ /* now set the component numbers */
+
+ icomp = 0;
+ for ( i=0; i<aRgn->nShapes; i++ ) {
+ if ( aRgn->Shapes[i].sign ) icomp++;
+ aRgn->Shapes[i].comp = icomp;
+
+ /*
+ printf("i = %d, shape = %d, sign = %d, comp = %d\n", i, aRgn->Shapes[i].shape, aRgn->Shapes[i].sign, aRgn->Shapes[i].comp);
+ */
+
+ }
+
+ return;
+
+}
+
+/*---------------------------------------------------------------------------*/
+void fits_setup_shape ( RgnShape *newShape)
+{
+/* Perform some useful calculations now to speed up filter later */
+
+ double X, Y, R;
+ double *coords;
+ int i;
+
+ if ( newShape->shape == poly_rgn ) {
+ coords = newShape->param.poly.Pts;
+ } else {
+ coords = newShape->param.gen.p;
+ }
+
+ switch( newShape->shape ) {
+ case circle_rgn:
+ newShape->param.gen.a = coords[2] * coords[2];
+ break;
+ case annulus_rgn:
+ newShape->param.gen.a = coords[2] * coords[2];
+ newShape->param.gen.b = coords[3] * coords[3];
+ break;
+ case sector_rgn:
+ while( coords[2]> 180.0 ) coords[2] -= 360.0;
+ while( coords[2]<=-180.0 ) coords[2] += 360.0;
+ while( coords[3]> 180.0 ) coords[3] -= 360.0;
+ while( coords[3]<=-180.0 ) coords[3] += 360.0;
+ break;
+ case ellipse_rgn:
+ newShape->param.gen.sinT = sin( myPI * (coords[4] / 180.0) );
+ newShape->param.gen.cosT = cos( myPI * (coords[4] / 180.0) );
+ break;
+ case elliptannulus_rgn:
+ newShape->param.gen.a = sin( myPI * (coords[6] / 180.0) );
+ newShape->param.gen.b = cos( myPI * (coords[6] / 180.0) );
+ newShape->param.gen.sinT = sin( myPI * (coords[7] / 180.0) );
+ newShape->param.gen.cosT = cos( myPI * (coords[7] / 180.0) );
+ break;
+ case box_rgn:
+ newShape->param.gen.sinT = sin( myPI * (coords[4] / 180.0) );
+ newShape->param.gen.cosT = cos( myPI * (coords[4] / 180.0) );
+ break;
+ case boxannulus_rgn:
+ newShape->param.gen.a = sin( myPI * (coords[6] / 180.0) );
+ newShape->param.gen.b = cos( myPI * (coords[6] / 180.0) );
+ newShape->param.gen.sinT = sin( myPI * (coords[7] / 180.0) );
+ newShape->param.gen.cosT = cos( myPI * (coords[7] / 180.0) );
+ break;
+ case rectangle_rgn:
+ newShape->param.gen.sinT = sin( myPI * (coords[4] / 180.0) );
+ newShape->param.gen.cosT = cos( myPI * (coords[4] / 180.0) );
+ X = 0.5 * ( coords[2]-coords[0] );
+ Y = 0.5 * ( coords[3]-coords[1] );
+ newShape->param.gen.a = fabs( X * newShape->param.gen.cosT
+ + Y * newShape->param.gen.sinT );
+ newShape->param.gen.b = fabs( Y * newShape->param.gen.cosT
+ - X * newShape->param.gen.sinT );
+ newShape->param.gen.p[5] = 0.5 * ( coords[2]+coords[0] );
+ newShape->param.gen.p[6] = 0.5 * ( coords[3]+coords[1] );
+ break;
+ case diamond_rgn:
+ newShape->param.gen.sinT = sin( myPI * (coords[4] / 180.0) );
+ newShape->param.gen.cosT = cos( myPI * (coords[4] / 180.0) );
+ break;
+ case line_rgn:
+ X = coords[2] - coords[0];
+ Y = coords[3] - coords[1];
+ R = sqrt( X*X + Y*Y );
+ newShape->param.gen.sinT = ( R ? Y/R : 0.0 );
+ newShape->param.gen.cosT = ( R ? X/R : 1.0 );
+ newShape->param.gen.a = R + 0.5;
+ break;
+ case panda_rgn:
+ while( coords[2]> 180.0 ) coords[2] -= 360.0;
+ while( coords[2]<=-180.0 ) coords[2] += 360.0;
+ while( coords[3]> 180.0 ) coords[3] -= 360.0;
+ while( coords[3]<=-180.0 ) coords[3] += 360.0;
+ newShape->param.gen.a = newShape->param.gen.p[5]*newShape->param.gen.p[5];
+ newShape->param.gen.b = newShape->param.gen.p[6]*newShape->param.gen.p[6];
+ break;
+ case epanda_rgn:
+ case bpanda_rgn:
+ while( coords[2]> 180.0 ) coords[2] -= 360.0;
+ while( coords[2]<=-180.0 ) coords[2] += 360.0;
+ while( coords[3]> 180.0 ) coords[3] -= 360.0;
+ while( coords[3]<=-180.0 ) coords[3] += 360.0;
+ newShape->param.gen.sinT = sin( myPI * (coords[10] / 180.0) );
+ newShape->param.gen.cosT = cos( myPI * (coords[10] / 180.0) );
+ break;
+ }
+
+ /* Set the xmin, xmax, ymin, ymax elements of the RgnShape structure */
+
+ /* For everything which has first two parameters as center position just */
+ /* find a circle that encompasses the region and use it to set the */
+ /* bounding box */
+
+ R = -1.0;
+
+ switch ( newShape->shape ) {
+
+ case circle_rgn:
+ R = coords[2];
+ break;
+
+ case annulus_rgn:
+ R = coords[3];
+ break;
+
+ case ellipse_rgn:
+ if ( coords[2] > coords[3] ) {
+ R = coords[2];
+ } else {
+ R = coords[3];
+ }
+ break;
+
+ case elliptannulus_rgn:
+ if ( coords[4] > coords[5] ) {
+ R = coords[4];
+ } else {
+ R = coords[5];
+ }
+ break;
+
+ case box_rgn:
+ R = sqrt(coords[2]*coords[2]+
+ coords[3]*coords[3])/2.0;
+ break;
+
+ case boxannulus_rgn:
+ R = sqrt(coords[4]*coords[5]+
+ coords[4]*coords[5])/2.0;
+ break;
+
+ case diamond_rgn:
+ if ( coords[2] > coords[3] ) {
+ R = coords[2]/2.0;
+ } else {
+ R = coords[3]/2.0;
+ }
+ break;
+
+ case point_rgn:
+ R = 1.0;
+ break;
+
+ case panda_rgn:
+ R = coords[6];
+ break;
+
+ case epanda_rgn:
+ if ( coords[7] > coords[8] ) {
+ R = coords[7];
+ } else {
+ R = coords[8];
+ }
+ break;
+
+ case bpanda_rgn:
+ R = sqrt(coords[7]*coords[8]+
+ coords[7]*coords[8])/2.0;
+ break;
+
+ }
+
+ if ( R > 0.0 ) {
+
+ newShape->xmin = coords[0] - R;
+ newShape->xmax = coords[0] + R;
+ newShape->ymin = coords[1] - R;
+ newShape->ymax = coords[1] + R;
+
+ return;
+
+ }
+
+ /* Now do the rest of the shapes that require individual methods */
+
+ switch ( newShape->shape ) {
+
+ case rectangle_rgn:
+ R = sqrt((coords[5]-coords[0])*(coords[5]-coords[0])+
+ (coords[6]-coords[1])*(coords[6]-coords[1]));
+ newShape->xmin = coords[5] - R;
+ newShape->xmax = coords[5] + R;
+ newShape->ymin = coords[6] - R;
+ newShape->ymax = coords[6] + R;
+ break;
+
+ case poly_rgn:
+ newShape->xmin = coords[0];
+ newShape->xmax = coords[0];
+ newShape->ymin = coords[1];
+ newShape->ymax = coords[1];
+ for( i=2; i < newShape->param.poly.nPts; ) {
+ if( newShape->xmin > coords[i] ) /* Min X */
+ newShape->xmin = coords[i];
+ if( newShape->xmax < coords[i] ) /* Max X */
+ newShape->xmax = coords[i];
+ i++;
+ if( newShape->ymin > coords[i] ) /* Min Y */
+ newShape->ymin = coords[i];
+ if( newShape->ymax < coords[i] ) /* Max Y */
+ newShape->ymax = coords[i];
+ i++;
+ }
+ break;
+
+ case line_rgn:
+ if ( coords[0] > coords[2] ) {
+ newShape->xmin = coords[2];
+ newShape->xmax = coords[0];
+ } else {
+ newShape->xmin = coords[0];
+ newShape->xmax = coords[2];
+ }
+ if ( coords[1] > coords[3] ) {
+ newShape->ymin = coords[3];
+ newShape->ymax = coords[1];
+ } else {
+ newShape->ymin = coords[1];
+ newShape->ymax = coords[3];
+ }
+
+ break;
+
+ /* sector doesn't have min and max so indicate by setting max < min */
+
+ case sector_rgn:
+ newShape->xmin = 1.0;
+ newShape->xmax = -1.0;
+ newShape->ymin = 1.0;
+ newShape->ymax = -1.0;
+ break;
+
+ }
+
+ return;
+
+}
+
+/*---------------------------------------------------------------------------*/
+int fits_read_fits_region ( fitsfile *fptr,
+ WCSdata *wcs,
+ SAORegion **Rgn,
+ int *status)
+/* Read regions from a FITS region extension and return the information */
+/* in the "SAORegion" structure. If it is nonNULL, use wcs to convert the */
+/* region coordinates to pixels. Return an error if region is in degrees */
+/* but no WCS data is provided. */
+/*---------------------------------------------------------------------------*/
+{
+
+ int i, j, icol[6], idum, anynul, npos;
+ int dotransform, got_component = 1, tstatus;
+ long icsize[6];
+ double X, Y, Theta, Xsave, Ysave, Xpos, Ypos;
+ double *coords;
+ char *cvalue, *cvalue2;
+ char comment[FLEN_COMMENT];
+ char colname[6][FLEN_VALUE] = {"X", "Y", "SHAPE", "R", "ROTANG", "COMPONENT"};
+ char shapename[17][FLEN_VALUE] = {"POINT","CIRCLE","ELLIPSE","ANNULUS",
+ "ELLIPTANNULUS","BOX","ROTBOX","BOXANNULUS",
+ "RECTANGLE","ROTRECTANGLE","POLYGON","PIE",
+ "SECTOR","DIAMOND","RHOMBUS","ROTDIAMOND",
+ "ROTRHOMBUS"};
+ int shapetype[17] = {point_rgn, circle_rgn, ellipse_rgn, annulus_rgn,
+ elliptannulus_rgn, box_rgn, box_rgn, boxannulus_rgn,
+ rectangle_rgn, rectangle_rgn, poly_rgn, sector_rgn,
+ sector_rgn, diamond_rgn, diamond_rgn, diamond_rgn,
+ diamond_rgn};
+ SAORegion *aRgn;
+ RgnShape *newShape;
+ WCSdata *regwcs;
+
+ if ( *status ) return( *status );
+
+ aRgn = (SAORegion *)malloc( sizeof(SAORegion) );
+ if( ! aRgn ) {
+ ffpmsg("Couldn't allocate memory to hold Region file contents.");
+ return(*status = MEMORY_ALLOCATION );
+ }
+ aRgn->nShapes = 0;
+ aRgn->Shapes = NULL;
+ if( wcs && wcs->exists )
+ aRgn->wcs = *wcs;
+ else
+ aRgn->wcs.exists = 0;
+
+ /* See if we are already positioned to a region extension, else */
+ /* move to the REGION extension (file is already open). */
+
+ tstatus = 0;
+ for (i=0; i<5; i++) {
+ ffgcno(fptr, CASEINSEN, colname[i], &icol[i], &tstatus);
+ }
+
+ if (tstatus) {
+ /* couldn't find the required columns, so search for "REGION" extension */
+ if ( ffmnhd(fptr, BINARY_TBL, "REGION", 1, status) ) {
+ ffpmsg("Could not move to REGION extension.");
+ goto error;
+ }
+ }
+
+ /* get the number of shapes and allocate memory */
+
+ if ( ffgky(fptr, TINT, "NAXIS2", &aRgn->nShapes, comment, status) ) {
+ ffpmsg("Could not read NAXIS2 keyword.");
+ goto error;
+ }
+
+ aRgn->Shapes = (RgnShape *) malloc(aRgn->nShapes * sizeof(RgnShape));
+ if ( !aRgn->Shapes ) {
+ ffpmsg( "Failed to allocate memory for Region data");
+ *status = MEMORY_ALLOCATION;
+ goto error;
+ }
+
+ /* get the required column numbers */
+
+ for (i=0; i<5; i++) {
+ if ( ffgcno(fptr, CASEINSEN, colname[i], &icol[i], status) ) {
+ ffpmsg("Could not find column.");
+ goto error;
+ }
+ }
+
+ /* try to get the optional column numbers */
+
+ if ( ffgcno(fptr, CASEINSEN, colname[5], &icol[5], status) ) {
+ got_component = 0;
+ }
+
+ /* if there was input WCS then read the WCS info for the region in case they */
+ /* are different and we have to transform */
+
+ dotransform = 0;
+ if ( aRgn->wcs.exists ) {
+ regwcs = (WCSdata *) malloc ( sizeof(WCSdata) );
+ if ( !regwcs ) {
+ ffpmsg( "Failed to allocate memory for Region WCS data");
+ *status = MEMORY_ALLOCATION;
+ goto error;
+ }
+
+ regwcs->exists = 1;
+ if ( ffgtcs(fptr, icol[0], icol[1], ®wcs->xrefval, ®wcs->yrefval,
+ ®wcs->xrefpix, ®wcs->yrefpix, ®wcs->xinc, ®wcs->yinc,
+ ®wcs->rot, regwcs->type, status) ) {
+ regwcs->exists = 0;
+ *status = 0;
+ }
+
+ if ( regwcs->exists && wcs->exists ) {
+ if ( fabs(regwcs->xrefval-wcs->xrefval) > 1.0e-6 ||
+ fabs(regwcs->yrefval-wcs->yrefval) > 1.0e-6 ||
+ fabs(regwcs->xrefpix-wcs->xrefpix) > 1.0e-6 ||
+ fabs(regwcs->yrefpix-wcs->yrefpix) > 1.0e-6 ||
+ fabs(regwcs->xinc-wcs->xinc) > 1.0e-6 ||
+ fabs(regwcs->yinc-wcs->yinc) > 1.0e-6 ||
+ fabs(regwcs->rot-wcs->rot) > 1.0e-6 ||
+ !strcmp(regwcs->type,wcs->type) ) dotransform = 1;
+ }
+ }
+
+ /* get the sizes of the X, Y, R, and ROTANG vectors */
+
+ for (i=0; i<6; i++) {
+ if ( ffgtdm(fptr, icol[i], 1, &idum, &icsize[i], status) ) {
+ ffpmsg("Could not find vector size of column.");
+ goto error;
+ }
+ }
+
+ cvalue = (char *) malloc ((FLEN_VALUE+1)*sizeof(char));
+
+ /* loop over the shapes - note 1-based counting for rows in FITS files */
+
+ for (i=1; i<=aRgn->nShapes; i++) {
+
+ newShape = &aRgn->Shapes[i-1];
+ for (j=0; j<8; j++) newShape->param.gen.p[j] = 0.0;
+ newShape->param.gen.a = 0.0;
+ newShape->param.gen.b = 0.0;
+ newShape->param.gen.sinT = 0.0;
+ newShape->param.gen.cosT = 0.0;
+
+ /* get the shape */
+
+ if ( ffgcvs(fptr, icol[2], i, 1, 1, " ", &cvalue, &anynul, status) ) {
+ ffpmsg("Could not read shape.");
+ goto error;
+ }
+
+ /* set include or exclude */
+
+ newShape->sign = 1;
+ cvalue2 = cvalue;
+ if ( !strncmp(cvalue,"!",1) ) {
+ newShape->sign = 0;
+ cvalue2++;
+ }
+
+ /* set the shape type */
+
+ for (j=0; j<9; j++) {
+ if ( !strcmp(cvalue2, shapename[j]) ) newShape->shape = shapetype[j];
+ }
+
+ /* allocate memory for polygon case and set coords pointer */
+
+ if ( newShape->shape == poly_rgn ) {
+ newShape->param.poly.Pts = (double *) calloc (2*icsize[0], sizeof(double));
+ if ( !newShape->param.poly.Pts ) {
+ ffpmsg("Could not allocate memory to hold polygon parameters" );
+ *status = MEMORY_ALLOCATION;
+ goto error;
+ }
+ newShape->param.poly.nPts = 2*icsize[0];
+ coords = newShape->param.poly.Pts;
+ } else {
+ coords = newShape->param.gen.p;
+ }
+
+
+ /* read X and Y. Polygon and Rectangle require special cases */
+
+ npos = 1;
+ if ( newShape->shape == poly_rgn ) npos = newShape->param.poly.nPts/2;
+ if ( newShape->shape == rectangle_rgn ) npos = 2;
+
+ for (j=0; j<npos; j++) {
+ if ( ffgcvd(fptr, icol[0], i, j+1, 1, DOUBLENULLVALUE, coords, &anynul, status) ) {
+ ffpmsg("Failed to read X column for polygon region");
+ goto error;
+ }
+ if (*coords == DOUBLENULLVALUE) { /* check for null value end of array marker */
+ npos = j;
+ newShape->param.poly.nPts = npos * 2;
+ break;
+ }
+ coords++;
+
+ if ( ffgcvd(fptr, icol[1], i, j+1, 1, DOUBLENULLVALUE, coords, &anynul, status) ) {
+ ffpmsg("Failed to read Y column for polygon region");
+ goto error;
+ }
+ if (*coords == DOUBLENULLVALUE) { /* check for null value end of array marker */
+ npos = j;
+ newShape->param.poly.nPts = npos * 2;
+ coords--;
+ break;
+ }
+ coords++;
+
+ if (j == 0) { /* save the first X and Y coordinate */
+ Xsave = *(coords - 2);
+ Ysave = *(coords - 1);
+ } else if ((Xsave == *(coords - 2)) && (Ysave == *(coords - 1)) ) {
+ /* if point has same coordinate as first point, this marks the end of the array */
+ npos = j + 1;
+ newShape->param.poly.nPts = npos * 2;
+ break;
+ }
+ }
+
+ /* transform positions if the region and input wcs differ */
+
+ if ( dotransform ) {
+
+ coords -= npos*2;
+ Xsave = coords[0];
+ Ysave = coords[1];
+ for (j=0; j<npos; j++) {
+ ffwldp(coords[2*j], coords[2*j+1], regwcs->xrefval, regwcs->yrefval, regwcs->xrefpix,
+ regwcs->yrefpix, regwcs->xinc, regwcs->yinc, regwcs->rot,
+ regwcs->type, &Xpos, &Ypos, status);
+ ffxypx(Xpos, Ypos, wcs->xrefval, wcs->yrefval, wcs->xrefpix,
+ wcs->yrefpix, wcs->xinc, wcs->yinc, wcs->rot,
+ wcs->type, &coords[2*j], &coords[2*j+1], status);
+ if ( *status ) {
+ ffpmsg("Failed to transform coordinates");
+ goto error;
+ }
+ }
+ coords += npos*2;
+ }
+
+ /* read R. Circle requires one number; Box, Diamond, Ellipse, Annulus, Sector
+ and Panda two; Boxannulus and Elliptannulus four; Point, Rectangle and
+ Polygon none. */
+
+ npos = 0;
+ switch ( newShape->shape ) {
+ case circle_rgn:
+ npos = 1;
+ break;
+ case box_rgn:
+ case diamond_rgn:
+ case ellipse_rgn:
+ case annulus_rgn:
+ case sector_rgn:
+ npos = 2;
+ break;
+ case boxannulus_rgn:
+ case elliptannulus_rgn:
+ npos = 4;
+ break;
+ }
+
+ if ( npos > 0 ) {
+ if ( ffgcvd(fptr, icol[3], i, 1, npos, 0.0, coords, &anynul, status) ) {
+ ffpmsg("Failed to read R column for region");
+ goto error;
+ }
+
+ /* transform lengths if the region and input wcs differ */
+
+ if ( dotransform ) {
+ for (j=0; j<npos; j++) {
+ Y = Ysave + (*coords);
+ X = Xsave;
+ ffwldp(X, Y, regwcs->xrefval, regwcs->yrefval, regwcs->xrefpix,
+ regwcs->yrefpix, regwcs->xinc, regwcs->yinc, regwcs->rot,
+ regwcs->type, &Xpos, &Ypos, status);
+ ffxypx(Xpos, Ypos, wcs->xrefval, wcs->yrefval, wcs->xrefpix,
+ wcs->yrefpix, wcs->xinc, wcs->yinc, wcs->rot,
+ wcs->type, &X, &Y, status);
+ if ( *status ) {
+ ffpmsg("Failed to transform coordinates");
+ goto error;
+ }
+ *(coords++) = sqrt(pow(X-newShape->param.gen.p[0],2)+pow(Y-newShape->param.gen.p[1],2));
+ }
+ } else {
+ coords += npos;
+ }
+ }
+
+ /* read ROTANG. Requires two values for Boxannulus, Elliptannulus, Sector,
+ Panda; one for Box, Diamond, Ellipse; and none for Circle, Point, Annulus,
+ Rectangle, Polygon */
+
+ npos = 0;
+ switch ( newShape->shape ) {
+ case box_rgn:
+ case diamond_rgn:
+ case ellipse_rgn:
+ npos = 1;
+ break;
+ case boxannulus_rgn:
+ case elliptannulus_rgn:
+ case sector_rgn:
+ npos = 2;
+ break;
+ }
+
+ if ( npos > 0 ) {
+ if ( ffgcvd(fptr, icol[4], i, 1, npos, 0.0, coords, &anynul, status) ) {
+ ffpmsg("Failed to read ROTANG column for region");
+ goto error;
+ }
+
+ /* transform angles if the region and input wcs differ */
+
+ if ( dotransform ) {
+ Theta = (wcs->rot) - (regwcs->rot);
+ for (j=0; j<npos; j++) *(coords++) += Theta;
+ } else {
+ coords += npos;
+ }
+ }
+
+ /* read the component number */
+
+ if (got_component) {
+ if ( ffgcv(fptr, TINT, icol[5], i, 1, 1, 0, &newShape->comp, &anynul, status) ) {
+ ffpmsg("Failed to read COMPONENT column for region");
+ goto error;
+ }
+ } else {
+ newShape->comp = 1;
+ }
+
+
+ /* do some precalculations to speed up tests */
+
+ fits_setup_shape(newShape);
+
+ /* end loop over shapes */
+
+ }
+
+error:
+
+ if( *status )
+ fits_free_region( aRgn );
+ else
+ *Rgn = aRgn;
+
+ ffclos(fptr, status);
+
+ return( *status );
+}
+
diff --git a/src/plugins/cfitsio/region.h b/src/plugins/cfitsio/region.h
new file mode 100644
index 0000000..516c4fd
--- /dev/null
+++ b/src/plugins/cfitsio/region.h
@@ -0,0 +1,82 @@
+/***************************************************************/
+/* REGION STUFF */
+/***************************************************************/
+
+#include "fitsio.h"
+#define myPI 3.1415926535897932385
+#define RadToDeg 180.0/myPI
+
+typedef struct {
+ int exists;
+ double xrefval, yrefval;
+ double xrefpix, yrefpix;
+ double xinc, yinc;
+ double rot;
+ char type[6];
+} WCSdata;
+
+typedef enum {
+ point_rgn,
+ line_rgn,
+ circle_rgn,
+ annulus_rgn,
+ ellipse_rgn,
+ elliptannulus_rgn,
+ box_rgn,
+ boxannulus_rgn,
+ rectangle_rgn,
+ diamond_rgn,
+ sector_rgn,
+ poly_rgn,
+ panda_rgn,
+ epanda_rgn,
+ bpanda_rgn
+} shapeType;
+
+typedef enum { pixel_fmt, degree_fmt, hhmmss_fmt } coordFmt;
+
+typedef struct {
+ char sign; /* Include or exclude? */
+ shapeType shape; /* Shape of this region */
+ int comp; /* Component number for this region */
+
+ double xmin,xmax; /* bounding box */
+ double ymin,ymax;
+
+ union { /* Parameters - In pixels */
+
+ /**** Generic Shape Data ****/
+
+ struct {
+ double p[11]; /* Region parameters */
+ double sinT, cosT; /* For rotated shapes */
+ double a, b; /* Extra scratch area */
+ } gen;
+
+ /**** Polygon Data ****/
+
+ struct {
+ int nPts; /* Number of Polygon pts */
+ double *Pts; /* Polygon points */
+ } poly;
+
+ } param;
+
+} RgnShape;
+
+typedef struct {
+ int nShapes;
+ RgnShape *Shapes;
+ WCSdata wcs;
+} SAORegion;
+
+/* SAO region file routines */
+int fits_read_rgnfile( const char *filename, WCSdata *wcs, SAORegion **Rgn, int *status );
+int fits_in_region( double X, double Y, SAORegion *Rgn );
+void fits_free_region( SAORegion *Rgn );
+void fits_set_region_components ( SAORegion *Rgn );
+void fits_setup_shape ( RgnShape *shape);
+int fits_read_fits_region ( fitsfile *fptr, WCSdata * wcs, SAORegion **Rgn, int *status);
+int fits_read_ascii_region ( const char *filename, WCSdata * wcs, SAORegion **Rgn, int *status);
+
+
diff --git a/src/plugins/cfitsio/ricecomp.c b/src/plugins/cfitsio/ricecomp.c
new file mode 100644
index 0000000..d5a11a4
--- /dev/null
+++ b/src/plugins/cfitsio/ricecomp.c
@@ -0,0 +1,1382 @@
+/*
+ The following code was written by Richard White at STScI and made
+ available for use in CFITSIO in July 1999. These routines were
+ originally contained in 2 source files: rcomp.c and rdecomp.c,
+ and the 'include' file now called ricecomp.h was originally called buffer.h.
+*/
+
+/*----------------------------------------------------------*/
+/* */
+/* START OF SOURCE FILE ORIGINALLY CALLED rcomp.c */
+/* */
+/*----------------------------------------------------------*/
+/* @(#) rcomp.c 1.5 99/03/01 12:40:27 */
+/* rcomp.c Compress image line using
+ * (1) Difference of adjacent pixels
+ * (2) Rice algorithm coding
+ *
+ * Returns number of bytes written to code buffer or
+ * -1 on failure
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+typedef unsigned char Buffer_t;
+
+typedef struct {
+ int bitbuffer; /* bit buffer */
+ int bits_to_go; /* bits to go in buffer */
+ Buffer_t *start; /* start of buffer */
+ Buffer_t *current; /* current position in buffer */
+ Buffer_t *end; /* end of buffer */
+} Buffer;
+
+#define putcbuf(c,mf) ((*(mf->current)++ = c), 0)
+
+#include "fitsio2.h"
+
+static void start_outputing_bits(Buffer *buffer);
+static int done_outputing_bits(Buffer *buffer);
+static int output_nbits(Buffer *buffer, int bits, int n);
+
+/* this routine used to be called 'rcomp' (WDP) */
+/*---------------------------------------------------------------------------*/
+
+int fits_rcomp(int a[], /* input array */
+ int nx, /* number of input pixels */
+ unsigned char *c, /* output buffer */
+ int clen, /* max length of output */
+ int nblock) /* coding block size */
+{
+Buffer bufmem, *buffer = &bufmem;
+/* int bsize; */
+int i, j, thisblock;
+int lastpix, nextpix, pdiff;
+int v, fs, fsmask, top, fsmax, fsbits, bbits;
+int lbitbuffer, lbits_to_go;
+unsigned int psum;
+double pixelsum, dpsum;
+unsigned int *diff;
+
+ /*
+ * Original size of each pixel (bsize, bytes) and coding block
+ * size (nblock, pixels)
+ * Could make bsize a parameter to allow more efficient
+ * compression of short & byte images.
+ */
+/* bsize = 4; */
+
+/* nblock = 32; now an input parameter*/
+ /*
+ * From bsize derive:
+ * FSBITS = # bits required to store FS
+ * FSMAX = maximum value for FS
+ * BBITS = bits/pixel for direct coding
+ */
+
+/*
+ switch (bsize) {
+ case 1:
+ fsbits = 3;
+ fsmax = 6;
+ break;
+ case 2:
+ fsbits = 4;
+ fsmax = 14;
+ break;
+ case 4:
+ fsbits = 5;
+ fsmax = 25;
+ break;
+ default:
+ ffpmsg("rdecomp: bsize must be 1, 2, or 4 bytes");
+ return(-1);
+ }
+*/
+
+ /* move out of switch block, to tweak performance */
+ fsbits = 5;
+ fsmax = 25;
+ bbits = 1<<fsbits;
+
+ /*
+ * Set up buffer pointers
+ */
+ buffer->start = c;
+ buffer->current = c;
+ buffer->end = c+clen;
+ buffer->bits_to_go = 8;
+ /*
+ * array for differences mapped to non-negative values
+ */
+ diff = (unsigned int *) malloc(nblock*sizeof(unsigned int));
+ if (diff == (unsigned int *) NULL) {
+ ffpmsg("fits_rcomp: insufficient memory");
+ return(-1);
+ }
+ /*
+ * Code in blocks of nblock pixels
+ */
+ start_outputing_bits(buffer);
+
+ /* write out first int value to the first 4 bytes of the buffer */
+ if (output_nbits(buffer, a[0], 32) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+
+ lastpix = a[0]; /* the first difference will always be zero */
+
+ thisblock = nblock;
+ for (i=0; i<nx; i += nblock) {
+ /* last block may be shorter */
+ if (nx-i < nblock) thisblock = nx-i;
+ /*
+ * Compute differences of adjacent pixels and map them to unsigned values.
+ * Note that this may overflow the integer variables -- that's
+ * OK, because we can recover when decompressing. If we were
+ * compressing shorts or bytes, would want to do this arithmetic
+ * with short/byte working variables (though diff will still be
+ * passed as an int.)
+ *
+ * compute sum of mapped pixel values at same time
+ * use double precision for sum to allow 32-bit integer inputs
+ */
+ pixelsum = 0.0;
+ for (j=0; j<thisblock; j++) {
+ nextpix = a[i+j];
+ pdiff = nextpix - lastpix;
+ diff[j] = (unsigned int) ((pdiff<0) ? ~(pdiff<<1) : (pdiff<<1));
+ pixelsum += diff[j];
+ lastpix = nextpix;
+ }
+
+ /*
+ * compute number of bits to split from sum
+ */
+ dpsum = (pixelsum - (thisblock/2) - 1)/thisblock;
+ if (dpsum < 0) dpsum = 0.0;
+ psum = ((unsigned int) dpsum ) >> 1;
+ for (fs = 0; psum>0; fs++) psum >>= 1;
+
+ /*
+ * write the codes
+ * fsbits ID bits used to indicate split level
+ */
+ if (fs >= fsmax) {
+ /* Special high entropy case when FS >= fsmax
+ * Just write pixel difference values directly, no Rice coding at all.
+ */
+ if (output_nbits(buffer, fsmax+1, fsbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ for (j=0; j<thisblock; j++) {
+ if (output_nbits(buffer, diff[j], bbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ }
+ } else if (fs == 0 && pixelsum == 0) {
+ /*
+ * special low entropy case when FS = 0 and pixelsum=0 (all
+ * pixels in block are zero.)
+ * Output a 0 and return
+ */
+ if (output_nbits(buffer, 0, fsbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ } else {
+ /* normal case: not either very high or very low entropy */
+ if (output_nbits(buffer, fs+1, fsbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ fsmask = (1<<fs) - 1;
+ /*
+ * local copies of bit buffer to improve optimization
+ */
+ lbitbuffer = buffer->bitbuffer;
+ lbits_to_go = buffer->bits_to_go;
+ for (j=0; j<thisblock; j++) {
+ v = diff[j];
+ top = v >> fs;
+ /*
+ * top is coded by top zeros + 1
+ */
+ if (lbits_to_go >= top+1) {
+ lbitbuffer <<= top+1;
+ lbitbuffer |= 1;
+ lbits_to_go -= top+1;
+ } else {
+ lbitbuffer <<= lbits_to_go;
+ putcbuf(lbitbuffer & 0xff,buffer);
+
+ for (top -= lbits_to_go; top>=8; top -= 8) {
+ putcbuf(0, buffer);
+ }
+ lbitbuffer = 1;
+ lbits_to_go = 7-top;
+ }
+ /*
+ * bottom FS bits are written without coding
+ * code is output_nbits, moved into this routine to reduce overheads
+ * This code potentially breaks if FS>24, so I am limiting
+ * FS to 24 by choice of FSMAX above.
+ */
+ if (fs > 0) {
+ lbitbuffer <<= fs;
+ lbitbuffer |= v & fsmask;
+ lbits_to_go -= fs;
+ while (lbits_to_go <= 0) {
+ putcbuf((lbitbuffer>>(-lbits_to_go)) & 0xff,buffer);
+ lbits_to_go += 8;
+ }
+ }
+ }
+
+ /* check if overflowed output buffer */
+ if (buffer->current > buffer->end) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ buffer->bitbuffer = lbitbuffer;
+ buffer->bits_to_go = lbits_to_go;
+ }
+ }
+ done_outputing_bits(buffer);
+ free(diff);
+ /*
+ * return number of bytes used
+ */
+ return(buffer->current - buffer->start);
+}
+/*---------------------------------------------------------------------------*/
+
+int fits_rcomp_short(
+ short a[], /* input array */
+ int nx, /* number of input pixels */
+ unsigned char *c, /* output buffer */
+ int clen, /* max length of output */
+ int nblock) /* coding block size */
+{
+Buffer bufmem, *buffer = &bufmem;
+/* int bsize; */
+int i, j, thisblock;
+
+/*
+NOTE: in principle, the following 2 variable could be declared as 'short'
+but in fact the code runs faster (on 32-bit Linux at least) as 'int'
+*/
+int lastpix, nextpix;
+/* int pdiff; */
+short pdiff;
+int v, fs, fsmask, top, fsmax, fsbits, bbits;
+int lbitbuffer, lbits_to_go;
+/* unsigned int psum; */
+unsigned short psum;
+double pixelsum, dpsum;
+unsigned int *diff;
+
+ /*
+ * Original size of each pixel (bsize, bytes) and coding block
+ * size (nblock, pixels)
+ * Could make bsize a parameter to allow more efficient
+ * compression of short & byte images.
+ */
+/* bsize = 2; */
+
+/* nblock = 32; now an input parameter */
+ /*
+ * From bsize derive:
+ * FSBITS = # bits required to store FS
+ * FSMAX = maximum value for FS
+ * BBITS = bits/pixel for direct coding
+ */
+
+/*
+ switch (bsize) {
+ case 1:
+ fsbits = 3;
+ fsmax = 6;
+ break;
+ case 2:
+ fsbits = 4;
+ fsmax = 14;
+ break;
+ case 4:
+ fsbits = 5;
+ fsmax = 25;
+ break;
+ default:
+ ffpmsg("rdecomp: bsize must be 1, 2, or 4 bytes");
+ return(-1);
+ }
+*/
+
+ /* move these out of switch block to further tweak performance */
+ fsbits = 4;
+ fsmax = 14;
+
+ bbits = 1<<fsbits;
+
+ /*
+ * Set up buffer pointers
+ */
+ buffer->start = c;
+ buffer->current = c;
+ buffer->end = c+clen;
+ buffer->bits_to_go = 8;
+ /*
+ * array for differences mapped to non-negative values
+ */
+ diff = (unsigned int *) malloc(nblock*sizeof(unsigned int));
+ if (diff == (unsigned int *) NULL) {
+ ffpmsg("fits_rcomp: insufficient memory");
+ return(-1);
+ }
+ /*
+ * Code in blocks of nblock pixels
+ */
+ start_outputing_bits(buffer);
+
+ /* write out first short value to the first 2 bytes of the buffer */
+ if (output_nbits(buffer, a[0], 16) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+
+ lastpix = a[0]; /* the first difference will always be zero */
+
+ thisblock = nblock;
+ for (i=0; i<nx; i += nblock) {
+ /* last block may be shorter */
+ if (nx-i < nblock) thisblock = nx-i;
+ /*
+ * Compute differences of adjacent pixels and map them to unsigned values.
+ * Note that this may overflow the integer variables -- that's
+ * OK, because we can recover when decompressing. If we were
+ * compressing shorts or bytes, would want to do this arithmetic
+ * with short/byte working variables (though diff will still be
+ * passed as an int.)
+ *
+ * compute sum of mapped pixel values at same time
+ * use double precision for sum to allow 32-bit integer inputs
+ */
+ pixelsum = 0.0;
+ for (j=0; j<thisblock; j++) {
+ nextpix = a[i+j];
+ pdiff = nextpix - lastpix;
+ diff[j] = (unsigned int) ((pdiff<0) ? ~(pdiff<<1) : (pdiff<<1));
+ pixelsum += diff[j];
+ lastpix = nextpix;
+ }
+ /*
+ * compute number of bits to split from sum
+ */
+ dpsum = (pixelsum - (thisblock/2) - 1)/thisblock;
+ if (dpsum < 0) dpsum = 0.0;
+/* psum = ((unsigned int) dpsum ) >> 1; */
+ psum = ((unsigned short) dpsum ) >> 1;
+ for (fs = 0; psum>0; fs++) psum >>= 1;
+
+ /*
+ * write the codes
+ * fsbits ID bits used to indicate split level
+ */
+ if (fs >= fsmax) {
+ /* Special high entropy case when FS >= fsmax
+ * Just write pixel difference values directly, no Rice coding at all.
+ */
+ if (output_nbits(buffer, fsmax+1, fsbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ for (j=0; j<thisblock; j++) {
+ if (output_nbits(buffer, diff[j], bbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ }
+ } else if (fs == 0 && pixelsum == 0) {
+ /*
+ * special low entropy case when FS = 0 and pixelsum=0 (all
+ * pixels in block are zero.)
+ * Output a 0 and return
+ */
+ if (output_nbits(buffer, 0, fsbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ } else {
+ /* normal case: not either very high or very low entropy */
+ if (output_nbits(buffer, fs+1, fsbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ fsmask = (1<<fs) - 1;
+ /*
+ * local copies of bit buffer to improve optimization
+ */
+ lbitbuffer = buffer->bitbuffer;
+ lbits_to_go = buffer->bits_to_go;
+ for (j=0; j<thisblock; j++) {
+ v = diff[j];
+ top = v >> fs;
+ /*
+ * top is coded by top zeros + 1
+ */
+ if (lbits_to_go >= top+1) {
+ lbitbuffer <<= top+1;
+ lbitbuffer |= 1;
+ lbits_to_go -= top+1;
+ } else {
+ lbitbuffer <<= lbits_to_go;
+ putcbuf(lbitbuffer & 0xff,buffer);
+ for (top -= lbits_to_go; top>=8; top -= 8) {
+ putcbuf(0, buffer);
+ }
+ lbitbuffer = 1;
+ lbits_to_go = 7-top;
+ }
+ /*
+ * bottom FS bits are written without coding
+ * code is output_nbits, moved into this routine to reduce overheads
+ * This code potentially breaks if FS>24, so I am limiting
+ * FS to 24 by choice of FSMAX above.
+ */
+ if (fs > 0) {
+ lbitbuffer <<= fs;
+ lbitbuffer |= v & fsmask;
+ lbits_to_go -= fs;
+ while (lbits_to_go <= 0) {
+ putcbuf((lbitbuffer>>(-lbits_to_go)) & 0xff,buffer);
+ lbits_to_go += 8;
+ }
+ }
+ }
+ /* check if overflowed output buffer */
+ if (buffer->current > buffer->end) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ buffer->bitbuffer = lbitbuffer;
+ buffer->bits_to_go = lbits_to_go;
+ }
+ }
+ done_outputing_bits(buffer);
+ free(diff);
+ /*
+ * return number of bytes used
+ */
+ return(buffer->current - buffer->start);
+}
+/*---------------------------------------------------------------------------*/
+
+int fits_rcomp_byte(
+ signed char a[], /* input array */
+ int nx, /* number of input pixels */
+ unsigned char *c, /* output buffer */
+ int clen, /* max length of output */
+ int nblock) /* coding block size */
+{
+Buffer bufmem, *buffer = &bufmem;
+/* int bsize; */
+int i, j, thisblock;
+
+/*
+NOTE: in principle, the following 2 variable could be declared as 'short'
+but in fact the code runs faster (on 32-bit Linux at least) as 'int'
+*/
+int lastpix, nextpix;
+/* int pdiff; */
+signed char pdiff;
+int v, fs, fsmask, top, fsmax, fsbits, bbits;
+int lbitbuffer, lbits_to_go;
+/* unsigned int psum; */
+unsigned char psum;
+double pixelsum, dpsum;
+unsigned int *diff;
+
+ /*
+ * Original size of each pixel (bsize, bytes) and coding block
+ * size (nblock, pixels)
+ * Could make bsize a parameter to allow more efficient
+ * compression of short & byte images.
+ */
+/* bsize = 1; */
+
+/* nblock = 32; now an input parameter */
+ /*
+ * From bsize derive:
+ * FSBITS = # bits required to store FS
+ * FSMAX = maximum value for FS
+ * BBITS = bits/pixel for direct coding
+ */
+
+/*
+ switch (bsize) {
+ case 1:
+ fsbits = 3;
+ fsmax = 6;
+ break;
+ case 2:
+ fsbits = 4;
+ fsmax = 14;
+ break;
+ case 4:
+ fsbits = 5;
+ fsmax = 25;
+ break;
+ default:
+ ffpmsg("rdecomp: bsize must be 1, 2, or 4 bytes");
+ return(-1);
+ }
+*/
+
+ /* move these out of switch block to further tweak performance */
+ fsbits = 3;
+ fsmax = 6;
+ bbits = 1<<fsbits;
+
+ /*
+ * Set up buffer pointers
+ */
+ buffer->start = c;
+ buffer->current = c;
+ buffer->end = c+clen;
+ buffer->bits_to_go = 8;
+ /*
+ * array for differences mapped to non-negative values
+ */
+ diff = (unsigned int *) malloc(nblock*sizeof(unsigned int));
+ if (diff == (unsigned int *) NULL) {
+ ffpmsg("fits_rcomp: insufficient memory");
+ return(-1);
+ }
+ /*
+ * Code in blocks of nblock pixels
+ */
+ start_outputing_bits(buffer);
+
+ /* write out first byte value to the first byte of the buffer */
+ if (output_nbits(buffer, a[0], 8) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+
+ lastpix = a[0]; /* the first difference will always be zero */
+
+ thisblock = nblock;
+ for (i=0; i<nx; i += nblock) {
+ /* last block may be shorter */
+ if (nx-i < nblock) thisblock = nx-i;
+ /*
+ * Compute differences of adjacent pixels and map them to unsigned values.
+ * Note that this may overflow the integer variables -- that's
+ * OK, because we can recover when decompressing. If we were
+ * compressing shorts or bytes, would want to do this arithmetic
+ * with short/byte working variables (though diff will still be
+ * passed as an int.)
+ *
+ * compute sum of mapped pixel values at same time
+ * use double precision for sum to allow 32-bit integer inputs
+ */
+ pixelsum = 0.0;
+ for (j=0; j<thisblock; j++) {
+ nextpix = a[i+j];
+ pdiff = nextpix - lastpix;
+ diff[j] = (unsigned int) ((pdiff<0) ? ~(pdiff<<1) : (pdiff<<1));
+ pixelsum += diff[j];
+ lastpix = nextpix;
+ }
+ /*
+ * compute number of bits to split from sum
+ */
+ dpsum = (pixelsum - (thisblock/2) - 1)/thisblock;
+ if (dpsum < 0) dpsum = 0.0;
+/* psum = ((unsigned int) dpsum ) >> 1; */
+ psum = ((unsigned char) dpsum ) >> 1;
+ for (fs = 0; psum>0; fs++) psum >>= 1;
+
+ /*
+ * write the codes
+ * fsbits ID bits used to indicate split level
+ */
+ if (fs >= fsmax) {
+ /* Special high entropy case when FS >= fsmax
+ * Just write pixel difference values directly, no Rice coding at all.
+ */
+ if (output_nbits(buffer, fsmax+1, fsbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ for (j=0; j<thisblock; j++) {
+ if (output_nbits(buffer, diff[j], bbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ }
+ } else if (fs == 0 && pixelsum == 0) {
+ /*
+ * special low entropy case when FS = 0 and pixelsum=0 (all
+ * pixels in block are zero.)
+ * Output a 0 and return
+ */
+ if (output_nbits(buffer, 0, fsbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ } else {
+ /* normal case: not either very high or very low entropy */
+ if (output_nbits(buffer, fs+1, fsbits) == EOF) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ fsmask = (1<<fs) - 1;
+ /*
+ * local copies of bit buffer to improve optimization
+ */
+ lbitbuffer = buffer->bitbuffer;
+ lbits_to_go = buffer->bits_to_go;
+ for (j=0; j<thisblock; j++) {
+ v = diff[j];
+ top = v >> fs;
+ /*
+ * top is coded by top zeros + 1
+ */
+ if (lbits_to_go >= top+1) {
+ lbitbuffer <<= top+1;
+ lbitbuffer |= 1;
+ lbits_to_go -= top+1;
+ } else {
+ lbitbuffer <<= lbits_to_go;
+ putcbuf(lbitbuffer & 0xff,buffer);
+ for (top -= lbits_to_go; top>=8; top -= 8) {
+ putcbuf(0, buffer);
+ }
+ lbitbuffer = 1;
+ lbits_to_go = 7-top;
+ }
+ /*
+ * bottom FS bits are written without coding
+ * code is output_nbits, moved into this routine to reduce overheads
+ * This code potentially breaks if FS>24, so I am limiting
+ * FS to 24 by choice of FSMAX above.
+ */
+ if (fs > 0) {
+ lbitbuffer <<= fs;
+ lbitbuffer |= v & fsmask;
+ lbits_to_go -= fs;
+ while (lbits_to_go <= 0) {
+ putcbuf((lbitbuffer>>(-lbits_to_go)) & 0xff,buffer);
+ lbits_to_go += 8;
+ }
+ }
+ }
+ /* check if overflowed output buffer */
+ if (buffer->current > buffer->end) {
+ ffpmsg("rice_encode: end of buffer");
+ free(diff);
+ return(-1);
+ }
+ buffer->bitbuffer = lbitbuffer;
+ buffer->bits_to_go = lbits_to_go;
+ }
+ }
+ done_outputing_bits(buffer);
+ free(diff);
+ /*
+ * return number of bytes used
+ */
+ return(buffer->current - buffer->start);
+}
+/*---------------------------------------------------------------------------*/
+/* bit_output.c
+ *
+ * Bit output routines
+ * Procedures return zero on success, EOF on end-of-buffer
+ *
+ * Programmer: R. White Date: 20 July 1998
+ */
+
+/* Initialize for bit output */
+
+static void start_outputing_bits(Buffer *buffer)
+{
+ /*
+ * Buffer is empty to start with
+ */
+ buffer->bitbuffer = 0;
+ buffer->bits_to_go = 8;
+}
+
+/*---------------------------------------------------------------------------*/
+/* Output N bits (N must be <= 32) */
+
+static int output_nbits(Buffer *buffer, int bits, int n)
+{
+/* local copies */
+int lbitbuffer;
+int lbits_to_go;
+ /* AND mask for the right-most n bits */
+ static unsigned int mask[33] =
+ {0,
+ 0x1, 0x3, 0x7, 0xf, 0x1f, 0x3f, 0x7f, 0xff,
+ 0x1ff, 0x3ff, 0x7ff, 0xfff, 0x1fff, 0x3fff, 0x7fff, 0xffff,
+ 0x1ffff, 0x3ffff, 0x7ffff, 0xfffff, 0x1fffff, 0x3fffff, 0x7fffff, 0xffffff,
+ 0x1ffffff, 0x3ffffff, 0x7ffffff, 0xfffffff, 0x1fffffff, 0x3fffffff, 0x7fffffff, 0xffffffff};
+
+ /*
+ * insert bits at end of bitbuffer
+ */
+ lbitbuffer = buffer->bitbuffer;
+ lbits_to_go = buffer->bits_to_go;
+ if (lbits_to_go+n > 32) {
+ /*
+ * special case for large n: put out the top lbits_to_go bits first
+ * note that 0 < lbits_to_go <= 8
+ */
+ lbitbuffer <<= lbits_to_go;
+/* lbitbuffer |= (bits>>(n-lbits_to_go)) & ((1<<lbits_to_go)-1); */
+ lbitbuffer |= (bits>>(n-lbits_to_go)) & *(mask+lbits_to_go);
+ putcbuf(lbitbuffer & 0xff,buffer);
+ n -= lbits_to_go;
+ lbits_to_go = 8;
+ }
+ lbitbuffer <<= n;
+/* lbitbuffer |= ( bits & ((1<<n)-1) ); */
+ lbitbuffer |= ( bits & *(mask+n) );
+ lbits_to_go -= n;
+ while (lbits_to_go <= 0) {
+ /*
+ * bitbuffer full, put out top 8 bits
+ */
+ putcbuf((lbitbuffer>>(-lbits_to_go)) & 0xff,buffer);
+ lbits_to_go += 8;
+ }
+ buffer->bitbuffer = lbitbuffer;
+ buffer->bits_to_go = lbits_to_go;
+ return(0);
+}
+/*---------------------------------------------------------------------------*/
+/* Flush out the last bits */
+
+static int done_outputing_bits(Buffer *buffer)
+{
+ if(buffer->bits_to_go < 8) {
+ putcbuf(buffer->bitbuffer<<buffer->bits_to_go,buffer);
+
+/* if (putcbuf(buffer->bitbuffer<<buffer->bits_to_go,buffer) == EOF)
+ return(EOF);
+*/
+ }
+ return(0);
+}
+/*---------------------------------------------------------------------------*/
+/*----------------------------------------------------------*/
+/* */
+/* START OF SOURCE FILE ORIGINALLY CALLED rdecomp.c */
+/* */
+/*----------------------------------------------------------*/
+
+/* @(#) rdecomp.c 1.4 99/03/01 12:38:41 */
+/* rdecomp.c Decompress image line using
+ * (1) Difference of adjacent pixels
+ * (2) Rice algorithm coding
+ *
+ * Returns 0 on success or 1 on failure
+ */
+
+/* moved these 'includes' to the beginning of the file (WDP)
+#include <stdio.h>
+#include <stdlib.h>
+*/
+
+/*---------------------------------------------------------------------------*/
+/* this routine used to be called 'rdecomp' (WDP) */
+
+int fits_rdecomp (unsigned char *c, /* input buffer */
+ int clen, /* length of input */
+ unsigned int array[], /* output array */
+ int nx, /* number of output pixels */
+ int nblock) /* coding block size */
+{
+/* int bsize; */
+int i, k, imax;
+int nbits, nzero, fs;
+unsigned char *cend, bytevalue;
+unsigned int b, diff, lastpix;
+int fsmax, fsbits, bbits;
+static int *nonzero_count = (int *)NULL;
+
+ /*
+ * Original size of each pixel (bsize, bytes) and coding block
+ * size (nblock, pixels)
+ * Could make bsize a parameter to allow more efficient
+ * compression of short & byte images.
+ */
+/* bsize = 4; */
+
+/* nblock = 32; now an input parameter */
+ /*
+ * From bsize derive:
+ * FSBITS = # bits required to store FS
+ * FSMAX = maximum value for FS
+ * BBITS = bits/pixel for direct coding
+ */
+
+/*
+ switch (bsize) {
+ case 1:
+ fsbits = 3;
+ fsmax = 6;
+ break;
+ case 2:
+ fsbits = 4;
+ fsmax = 14;
+ break;
+ case 4:
+ fsbits = 5;
+ fsmax = 25;
+ break;
+ default:
+ ffpmsg("rdecomp: bsize must be 1, 2, or 4 bytes");
+ return 1;
+ }
+*/
+
+ /* move out of switch block, to tweak performance */
+ fsbits = 5;
+ fsmax = 25;
+
+ bbits = 1<<fsbits;
+
+ FFLOCK;
+ if (nonzero_count == (int *) NULL) {
+ /*
+ * nonzero_count is lookup table giving number of bits
+ * in 8-bit values not including leading zeros
+ */
+
+ /* NOTE!!! This memory never gets freed */
+ nonzero_count = (int *) malloc(256*sizeof(int));
+ if (nonzero_count == (int *) NULL) {
+ ffpmsg("rdecomp: insufficient memory");
+ FFUNLOCK;
+ return 1;
+ }
+ nzero = 8;
+ k = 128;
+ for (i=255; i>=0; ) {
+ for ( ; i>=k; i--) nonzero_count[i] = nzero;
+ k = k/2;
+ nzero--;
+ }
+ }
+ FFUNLOCK;
+
+ /*
+ * Decode in blocks of nblock pixels
+ */
+
+ /* first 4 bytes of input buffer contain the value of the first */
+ /* 4 byte integer value, without any encoding */
+
+ lastpix = 0;
+ bytevalue = c[0];
+ lastpix = lastpix | (bytevalue<<24);
+ bytevalue = c[1];
+ lastpix = lastpix | (bytevalue<<16);
+ bytevalue = c[2];
+ lastpix = lastpix | (bytevalue<<8);
+ bytevalue = c[3];
+ lastpix = lastpix | bytevalue;
+
+ c += 4;
+ cend = c + clen - 4;
+
+ b = *c++; /* bit buffer */
+ nbits = 8; /* number of bits remaining in b */
+ for (i = 0; i<nx; ) {
+ /* get the FS value from first fsbits */
+ nbits -= fsbits;
+ while (nbits < 0) {
+ b = (b<<8) | (*c++);
+ nbits += 8;
+ }
+ fs = (b >> nbits) - 1;
+
+ b &= (1<<nbits)-1;
+ /* loop over the next block */
+ imax = i + nblock;
+ if (imax > nx) imax = nx;
+ if (fs<0) {
+ /* low-entropy case, all zero differences */
+ for ( ; i<imax; i++) array[i] = lastpix;
+ } else if (fs==fsmax) {
+ /* high-entropy case, directly coded pixel values */
+ for ( ; i<imax; i++) {
+ k = bbits - nbits;
+ diff = b<<k;
+ for (k -= 8; k >= 0; k -= 8) {
+ b = *c++;
+ diff |= b<<k;
+ }
+ if (nbits>0) {
+ b = *c++;
+ diff |= b>>(-k);
+ b &= (1<<nbits)-1;
+ } else {
+ b = 0;
+ }
+ /*
+ * undo mapping and differencing
+ * Note that some of these operations will overflow the
+ * unsigned int arithmetic -- that's OK, it all works
+ * out to give the right answers in the output file.
+ */
+ if ((diff & 1) == 0) {
+ diff = diff>>1;
+ } else {
+ diff = ~(diff>>1);
+ }
+ array[i] = diff+lastpix;
+ lastpix = array[i];
+ }
+ } else {
+ /* normal case, Rice coding */
+ for ( ; i<imax; i++) {
+ /* count number of leading zeros */
+ while (b == 0) {
+ nbits += 8;
+ b = *c++;
+ }
+ nzero = nbits - nonzero_count[b];
+ nbits -= nzero+1;
+ /* flip the leading one-bit */
+ b ^= 1<<nbits;
+ /* get the FS trailing bits */
+ nbits -= fs;
+ while (nbits < 0) {
+ b = (b<<8) | (*c++);
+ nbits += 8;
+ }
+ diff = (nzero<<fs) | (b>>nbits);
+ b &= (1<<nbits)-1;
+
+ /* undo mapping and differencing */
+ if ((diff & 1) == 0) {
+ diff = diff>>1;
+ } else {
+ diff = ~(diff>>1);
+ }
+ array[i] = diff+lastpix;
+ lastpix = array[i];
+ }
+ }
+ if (c > cend) {
+ ffpmsg("decompression error: hit end of compressed byte stream");
+ return 1;
+ }
+ }
+ if (c < cend) {
+ ffpmsg("decompression warning: unused bytes at end of compressed buffer");
+ }
+ return 0;
+}
+/*---------------------------------------------------------------------------*/
+/* this routine used to be called 'rdecomp' (WDP) */
+
+int fits_rdecomp_short (unsigned char *c, /* input buffer */
+ int clen, /* length of input */
+ unsigned short array[], /* output array */
+ int nx, /* number of output pixels */
+ int nblock) /* coding block size */
+{
+int i, imax;
+/* int bsize; */
+int k;
+int nbits, nzero, fs;
+unsigned char *cend, bytevalue;
+unsigned int b, diff, lastpix;
+int fsmax, fsbits, bbits;
+static int *nonzero_count = (int *)NULL;
+
+ /*
+ * Original size of each pixel (bsize, bytes) and coding block
+ * size (nblock, pixels)
+ * Could make bsize a parameter to allow more efficient
+ * compression of short & byte images.
+ */
+
+/* bsize = 2; */
+
+/* nblock = 32; now an input parameter */
+ /*
+ * From bsize derive:
+ * FSBITS = # bits required to store FS
+ * FSMAX = maximum value for FS
+ * BBITS = bits/pixel for direct coding
+ */
+
+/*
+ switch (bsize) {
+ case 1:
+ fsbits = 3;
+ fsmax = 6;
+ break;
+ case 2:
+ fsbits = 4;
+ fsmax = 14;
+ break;
+ case 4:
+ fsbits = 5;
+ fsmax = 25;
+ break;
+ default:
+ ffpmsg("rdecomp: bsize must be 1, 2, or 4 bytes");
+ return 1;
+ }
+*/
+
+ /* move out of switch block, to tweak performance */
+ fsbits = 4;
+ fsmax = 14;
+
+ bbits = 1<<fsbits;
+
+ FFLOCK;
+ if (nonzero_count == (int *) NULL) {
+ /*
+ * nonzero_count is lookup table giving number of bits
+ * in 8-bit values not including leading zeros
+ */
+
+ /* NOTE!!! This memory never gets freed */
+ nonzero_count = (int *) malloc(256*sizeof(int));
+ if (nonzero_count == (int *) NULL) {
+ ffpmsg("rdecomp: insufficient memory");
+ FFUNLOCK;
+ return 1;
+ }
+ nzero = 8;
+ k = 128;
+ for (i=255; i>=0; ) {
+ for ( ; i>=k; i--) nonzero_count[i] = nzero;
+ k = k/2;
+ nzero--;
+ }
+ }
+ FFUNLOCK;
+ /*
+ * Decode in blocks of nblock pixels
+ */
+
+ /* first 2 bytes of input buffer contain the value of the first */
+ /* 2 byte integer value, without any encoding */
+
+ lastpix = 0;
+ bytevalue = c[0];
+ lastpix = lastpix | (bytevalue<<8);
+ bytevalue = c[1];
+ lastpix = lastpix | bytevalue;
+
+ c += 2;
+ cend = c + clen - 2;
+
+ b = *c++; /* bit buffer */
+ nbits = 8; /* number of bits remaining in b */
+ for (i = 0; i<nx; ) {
+ /* get the FS value from first fsbits */
+ nbits -= fsbits;
+ while (nbits < 0) {
+ b = (b<<8) | (*c++);
+ nbits += 8;
+ }
+ fs = (b >> nbits) - 1;
+
+ b &= (1<<nbits)-1;
+ /* loop over the next block */
+ imax = i + nblock;
+ if (imax > nx) imax = nx;
+ if (fs<0) {
+ /* low-entropy case, all zero differences */
+ for ( ; i<imax; i++) array[i] = lastpix;
+ } else if (fs==fsmax) {
+ /* high-entropy case, directly coded pixel values */
+ for ( ; i<imax; i++) {
+ k = bbits - nbits;
+ diff = b<<k;
+ for (k -= 8; k >= 0; k -= 8) {
+ b = *c++;
+ diff |= b<<k;
+ }
+ if (nbits>0) {
+ b = *c++;
+ diff |= b>>(-k);
+ b &= (1<<nbits)-1;
+ } else {
+ b = 0;
+ }
+
+ /*
+ * undo mapping and differencing
+ * Note that some of these operations will overflow the
+ * unsigned int arithmetic -- that's OK, it all works
+ * out to give the right answers in the output file.
+ */
+ if ((diff & 1) == 0) {
+ diff = diff>>1;
+ } else {
+ diff = ~(diff>>1);
+ }
+ array[i] = diff+lastpix;
+ lastpix = array[i];
+ }
+ } else {
+ /* normal case, Rice coding */
+ for ( ; i<imax; i++) {
+ /* count number of leading zeros */
+ while (b == 0) {
+ nbits += 8;
+ b = *c++;
+ }
+ nzero = nbits - nonzero_count[b];
+ nbits -= nzero+1;
+ /* flip the leading one-bit */
+ b ^= 1<<nbits;
+ /* get the FS trailing bits */
+ nbits -= fs;
+ while (nbits < 0) {
+ b = (b<<8) | (*c++);
+ nbits += 8;
+ }
+ diff = (nzero<<fs) | (b>>nbits);
+ b &= (1<<nbits)-1;
+
+ /* undo mapping and differencing */
+ if ((diff & 1) == 0) {
+ diff = diff>>1;
+ } else {
+ diff = ~(diff>>1);
+ }
+ array[i] = diff+lastpix;
+ lastpix = array[i];
+ }
+ }
+ if (c > cend) {
+ ffpmsg("decompression error: hit end of compressed byte stream");
+ return 1;
+ }
+ }
+ if (c < cend) {
+ ffpmsg("decompression warning: unused bytes at end of compressed buffer");
+ }
+ return 0;
+}
+/*---------------------------------------------------------------------------*/
+/* this routine used to be called 'rdecomp' (WDP) */
+
+int fits_rdecomp_byte (unsigned char *c, /* input buffer */
+ int clen, /* length of input */
+ unsigned char array[], /* output array */
+ int nx, /* number of output pixels */
+ int nblock) /* coding block size */
+{
+int i, imax;
+/* int bsize; */
+int k;
+int nbits, nzero, fs;
+unsigned char *cend;
+unsigned int b, diff, lastpix;
+int fsmax, fsbits, bbits;
+static int *nonzero_count = (int *)NULL;
+
+ /*
+ * Original size of each pixel (bsize, bytes) and coding block
+ * size (nblock, pixels)
+ * Could make bsize a parameter to allow more efficient
+ * compression of short & byte images.
+ */
+
+/* bsize = 1; */
+
+/* nblock = 32; now an input parameter */
+ /*
+ * From bsize derive:
+ * FSBITS = # bits required to store FS
+ * FSMAX = maximum value for FS
+ * BBITS = bits/pixel for direct coding
+ */
+
+/*
+ switch (bsize) {
+ case 1:
+ fsbits = 3;
+ fsmax = 6;
+ break;
+ case 2:
+ fsbits = 4;
+ fsmax = 14;
+ break;
+ case 4:
+ fsbits = 5;
+ fsmax = 25;
+ break;
+ default:
+ ffpmsg("rdecomp: bsize must be 1, 2, or 4 bytes");
+ return 1;
+ }
+*/
+
+ /* move out of switch block, to tweak performance */
+ fsbits = 3;
+ fsmax = 6;
+
+ bbits = 1<<fsbits;
+
+ FFLOCK;
+ if (nonzero_count == (int *) NULL) {
+ /*
+ * nonzero_count is lookup table giving number of bits
+ * in 8-bit values not including leading zeros
+ */
+
+ /* NOTE!!! This memory never gets freed */
+ nonzero_count = (int *) malloc(256*sizeof(int));
+ if (nonzero_count == (int *) NULL) {
+ ffpmsg("rdecomp: insufficient memory");
+ FFUNLOCK;
+ return 1;
+ }
+ nzero = 8;
+ k = 128;
+ for (i=255; i>=0; ) {
+ for ( ; i>=k; i--) nonzero_count[i] = nzero;
+ k = k/2;
+ nzero--;
+ }
+ }
+ FFUNLOCK;
+ /*
+ * Decode in blocks of nblock pixels
+ */
+
+ /* first byte of input buffer contain the value of the first */
+ /* byte integer value, without any encoding */
+
+ lastpix = c[0];
+ c += 1;
+ cend = c + clen - 1;
+
+ b = *c++; /* bit buffer */
+ nbits = 8; /* number of bits remaining in b */
+ for (i = 0; i<nx; ) {
+ /* get the FS value from first fsbits */
+ nbits -= fsbits;
+ while (nbits < 0) {
+ b = (b<<8) | (*c++);
+ nbits += 8;
+ }
+ fs = (b >> nbits) - 1;
+
+ b &= (1<<nbits)-1;
+ /* loop over the next block */
+ imax = i + nblock;
+ if (imax > nx) imax = nx;
+ if (fs<0) {
+ /* low-entropy case, all zero differences */
+ for ( ; i<imax; i++) array[i] = lastpix;
+ } else if (fs==fsmax) {
+ /* high-entropy case, directly coded pixel values */
+ for ( ; i<imax; i++) {
+ k = bbits - nbits;
+ diff = b<<k;
+ for (k -= 8; k >= 0; k -= 8) {
+ b = *c++;
+ diff |= b<<k;
+ }
+ if (nbits>0) {
+ b = *c++;
+ diff |= b>>(-k);
+ b &= (1<<nbits)-1;
+ } else {
+ b = 0;
+ }
+
+ /*
+ * undo mapping and differencing
+ * Note that some of these operations will overflow the
+ * unsigned int arithmetic -- that's OK, it all works
+ * out to give the right answers in the output file.
+ */
+ if ((diff & 1) == 0) {
+ diff = diff>>1;
+ } else {
+ diff = ~(diff>>1);
+ }
+ array[i] = diff+lastpix;
+ lastpix = array[i];
+ }
+ } else {
+ /* normal case, Rice coding */
+ for ( ; i<imax; i++) {
+ /* count number of leading zeros */
+ while (b == 0) {
+ nbits += 8;
+ b = *c++;
+ }
+ nzero = nbits - nonzero_count[b];
+ nbits -= nzero+1;
+ /* flip the leading one-bit */
+ b ^= 1<<nbits;
+ /* get the FS trailing bits */
+ nbits -= fs;
+ while (nbits < 0) {
+ b = (b<<8) | (*c++);
+ nbits += 8;
+ }
+ diff = (nzero<<fs) | (b>>nbits);
+ b &= (1<<nbits)-1;
+
+ /* undo mapping and differencing */
+ if ((diff & 1) == 0) {
+ diff = diff>>1;
+ } else {
+ diff = ~(diff>>1);
+ }
+ array[i] = diff+lastpix;
+ lastpix = array[i];
+ }
+ }
+ if (c > cend) {
+ ffpmsg("decompression error: hit end of compressed byte stream");
+ return 1;
+ }
+ }
+ if (c < cend) {
+ ffpmsg("decompression warning: unused bytes at end of compressed buffer");
+ }
+ return 0;
+}
diff --git a/src/plugins/cfitsio/scalnull.c b/src/plugins/cfitsio/scalnull.c
new file mode 100644
index 0000000..d2f2924
--- /dev/null
+++ b/src/plugins/cfitsio/scalnull.c
@@ -0,0 +1,229 @@
+/* This file, scalnull.c, contains the FITSIO routines used to define */
+/* the starting heap address, the value scaling and the null values. */
+
+/* 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 "fitsio2.h"
+/*--------------------------------------------------------------------------*/
+int ffpthp(fitsfile *fptr, /* I - FITS file pointer */
+ long theap, /* I - starting addrss for the heap */
+ int *status) /* IO - error status */
+/*
+ Define the starting address for the heap for a binary table.
+ The default address is NAXIS1 * NAXIS2. It is in units of
+ bytes relative to the beginning of the regular binary table data.
+ This routine also writes the appropriate THEAP keyword to the
+ FITS header.
+*/
+{
+ if (*status > 0 || theap < 1)
+ return(*status);
+
+ /* reset position to the correct HDU if necessary */
+ if (fptr->HDUposition != (fptr->Fptr)->curhdu)
+ ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
+
+ (fptr->Fptr)->heapstart = theap;
+
+ ffukyj(fptr, "THEAP", theap, "byte offset to heap area", status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpscl(fitsfile *fptr, /* I - FITS file pointer */
+ double scale, /* I - scaling factor: value of BSCALE */
+ double zero, /* I - zero point: value of BZERO */
+ int *status) /* IO - error status */
+/*
+ Define the linear scaling factor for the primary array or image extension
+ pixel values. This routine overrides the scaling values given by the
+ BSCALE and BZERO keywords if present. Note that this routine does not
+ write or modify the BSCALE and BZERO keywords, but instead only modifies
+ the values temporarily in the internal buffer. Thus, a subsequent call to
+ the ffrdef routine will reset the scaling back to the BSCALE and BZERO
+ keyword values (or 1. and 0. respectively if the keywords are not present).
+*/
+{
+ tcolumn *colptr;
+ int hdutype;
+
+ if (*status > 0)
+ return(*status);
+
+ if (scale == 0)
+ return(*status = ZERO_SCALE); /* zero scale value is illegal */
+
+ if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */
+ return(*status);
+
+ if (hdutype != IMAGE_HDU)
+ return(*status = NOT_IMAGE); /* not proper HDU type */
+
+ if (fits_is_compressed_image(fptr, status)) /* compressed images */
+ {
+ (fptr->Fptr)->cn_bscale = scale;
+ (fptr->Fptr)->cn_bzero = zero;
+ return(*status);
+ }
+
+ /* set pointer to the first 'column' (contains group parameters if any) */
+ colptr = (fptr->Fptr)->tableptr;
+
+ colptr++; /* increment to the 2nd 'column' pointer (the image itself) */
+
+ colptr->tscale = scale;
+ colptr->tzero = zero;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffpnul(fitsfile *fptr, /* I - FITS file pointer */
+ LONGLONG nulvalue, /* I - null pixel value: value of BLANK */
+ int *status) /* IO - error status */
+/*
+ Define the value used to represent undefined pixels in the primary array or
+ image extension. This only applies to integer image pixel (i.e. BITPIX > 0).
+ This routine overrides the null pixel value given by the BLANK keyword
+ if present. Note that this routine does not write or modify the BLANK
+ keyword, but instead only modifies the value temporarily in the internal
+ buffer. Thus, a subsequent call to the ffrdef routine will reset the null
+ value back to the BLANK keyword value (or not defined if the keyword is not
+ present).
+*/
+{
+ tcolumn *colptr;
+ int hdutype;
+
+ if (*status > 0)
+ return(*status);
+
+ if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */
+ return(*status);
+
+ if (hdutype != IMAGE_HDU)
+ return(*status = NOT_IMAGE); /* not proper HDU type */
+
+ if (fits_is_compressed_image(fptr, status)) /* ignore compressed images */
+ return(*status);
+
+ /* set pointer to the first 'column' (contains group parameters if any) */
+ colptr = (fptr->Fptr)->tableptr;
+
+ colptr++; /* increment to the 2nd 'column' pointer (the image itself) */
+
+ colptr->tnull = nulvalue;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fftscl(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number to apply scaling to */
+ double scale, /* I - scaling factor: value of TSCALn */
+ double zero, /* I - zero point: value of TZEROn */
+ int *status) /* IO - error status */
+/*
+ Define the linear scaling factor for the TABLE or BINTABLE extension
+ column values. This routine overrides the scaling values given by the
+ TSCALn and TZEROn keywords if present. Note that this routine does not
+ write or modify the TSCALn and TZEROn keywords, but instead only modifies
+ the values temporarily in the internal buffer. Thus, a subsequent call to
+ the ffrdef routine will reset the scaling back to the TSCALn and TZEROn
+ keyword values (or 1. and 0. respectively if the keywords are not present).
+*/
+{
+ tcolumn *colptr;
+ int hdutype;
+
+ if (*status > 0)
+ return(*status);
+
+ if (scale == 0)
+ return(*status = ZERO_SCALE); /* zero scale value is illegal */
+
+ if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */
+ return(*status);
+
+ if (hdutype == IMAGE_HDU)
+ return(*status = NOT_TABLE); /* not proper HDU type */
+
+ colptr = (fptr->Fptr)->tableptr; /* set pointer to the first column */
+ colptr += (colnum - 1); /* increment to the correct column */
+
+ colptr->tscale = scale;
+ colptr->tzero = zero;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int fftnul(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number to apply nulvalue to */
+ LONGLONG nulvalue, /* I - null pixel value: value of TNULLn */
+ int *status) /* IO - error status */
+/*
+ Define the value used to represent undefined pixels in the BINTABLE column.
+ This only applies to integer datatype columns (TFORM = B, I, or J).
+ This routine overrides the null pixel value given by the TNULLn keyword
+ if present. Note that this routine does not write or modify the TNULLn
+ keyword, but instead only modifies the value temporarily in the internal
+ buffer. Thus, a subsequent call to the ffrdef routine will reset the null
+ value back to the TNULLn keyword value (or not defined if the keyword is not
+ present).
+*/
+{
+ tcolumn *colptr;
+ int hdutype;
+
+ if (*status > 0)
+ return(*status);
+
+ if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */
+ return(*status);
+
+ if (hdutype != BINARY_TBL)
+ return(*status = NOT_BTABLE); /* not proper HDU type */
+
+ colptr = (fptr->Fptr)->tableptr; /* set pointer to the first column */
+ colptr += (colnum - 1); /* increment to the correct column */
+
+ colptr->tnull = nulvalue;
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffsnul(fitsfile *fptr, /* I - FITS file pointer */
+ int colnum, /* I - column number to apply nulvalue to */
+ char *nulstring, /* I - null pixel value: value of TNULLn */
+ int *status) /* IO - error status */
+/*
+ Define the string used to represent undefined pixels in the ASCII TABLE
+ column. This routine overrides the null value given by the TNULLn keyword
+ if present. Note that this routine does not write or modify the TNULLn
+ keyword, but instead only modifies the value temporarily in the internal
+ buffer. Thus, a subsequent call to the ffrdef routine will reset the null
+ value back to the TNULLn keyword value (or not defined if the keyword is not
+ present).
+*/
+{
+ tcolumn *colptr;
+ int hdutype;
+
+ if (*status > 0)
+ return(*status);
+
+ if (ffghdt(fptr, &hdutype, status) > 0) /* get HDU type */
+ return(*status);
+
+ if (hdutype != ASCII_TBL)
+ return(*status = NOT_ATABLE); /* not proper HDU type */
+
+ colptr = (fptr->Fptr)->tableptr; /* set pointer to the first column */
+ colptr += (colnum - 1); /* increment to the correct column */
+
+ colptr->strnull[0] = '\0';
+ strncat(colptr->strnull, nulstring, 19); /* limit string to 19 chars */
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/swapproc.c b/src/plugins/cfitsio/swapproc.c
new file mode 100644
index 0000000..cc69d6e
--- /dev/null
+++ b/src/plugins/cfitsio/swapproc.c
@@ -0,0 +1,247 @@
+/* This file, swapproc.c, contains general utility routines that are */
+/* used by other FITSIO routines to swap bytes. */
+
+/* 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. */
+
+/* The fast SSE2 and SSSE3 functions were provided by Julian Taylor, ESO */
+
+#include <string.h>
+#include <stdlib.h>
+#include "fitsio2.h"
+
+/* bswap builtin is available since GCC 4.3 */
+#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3)
+#define HAVE_BSWAP
+#endif
+
+#ifdef __SSSE3__
+#include <tmmintrin.h>
+/* swap 16 bytes according to mask, values must be 16 byte aligned */
+static inline void swap_ssse3(char * values, __m128i mask)
+{
+ __m128i v = _mm_load_si128((__m128i *)values);
+ __m128i s = _mm_shuffle_epi8(v, mask);
+ _mm_store_si128((__m128i*)values, s);
+}
+#endif
+#ifdef __SSE2__
+#include <emmintrin.h>
+/* swap 8 shorts, values must be 16 byte aligned
+ * faster than ssse3 variant for shorts */
+static inline void swap2_sse2(char * values)
+{
+ __m128i r1 = _mm_load_si128((__m128i *)values);
+ __m128i r2 = r1;
+ r1 = _mm_srli_epi16(r1, 8);
+ r2 = _mm_slli_epi16(r2, 8);
+ r1 = _mm_or_si128(r1, r2);
+ _mm_store_si128((__m128i*)values, r1);
+}
+/* the three shuffles required for 4 and 8 byte variants make
+ * SSE2 slower than bswap */
+
+
+/* get number of elements to peel to reach alignment */
+static inline size_t get_peel(void * addr, size_t esize, size_t nvals,
+ size_t alignment)
+{
+ const size_t offset = (size_t)addr % alignment;
+ size_t peel = offset ? (alignment - offset) / esize : 0;
+ peel = nvals < peel ? nvals : peel;
+ return peel;
+}
+#endif
+
+/*--------------------------------------------------------------------------*/
+static void ffswap2_slow(short *svalues, long nvals)
+{
+ register long ii;
+ unsigned short * usvalues;
+
+ usvalues = (unsigned short *) svalues;
+
+ for (ii = 0; ii < nvals; ii++)
+ {
+ usvalues[ii] = (usvalues[ii]>>8) | (usvalues[ii]<<8);
+ }
+}
+/*--------------------------------------------------------------------------*/
+#if __SSE2__
+void ffswap2(short *svalues, /* IO - pointer to shorts to be swapped */
+ long nvals) /* I - number of shorts to be swapped */
+/*
+ swap the bytes in the input short integers: ( 0 1 -> 1 0 )
+*/
+{
+ if ((long)svalues % 2 != 0) { /* should not happen */
+ ffswap2_slow(svalues, nvals);
+ return;
+ }
+
+ long ii;
+ size_t peel = get_peel((void*)&svalues[0], sizeof(svalues[0]), nvals, 16);
+
+ ffswap2_slow(svalues, peel);
+ for (ii = peel; ii < (nvals - peel - (nvals - peel) % 8); ii+=8) {
+ swap2_sse2((char*)&svalues[ii]);
+ }
+ ffswap2_slow(&svalues[ii], nvals - ii);
+}
+#else
+void ffswap2(short *svalues, /* IO - pointer to shorts to be swapped */
+ long nvals) /* I - number of shorts to be swapped */
+/*
+ swap the bytes in the input 4-byte integer: ( 0 1 2 3 -> 3 2 1 0 )
+*/
+{
+ ffswap2_slow(svalues, nvals);
+}
+#endif
+/*--------------------------------------------------------------------------*/
+static void ffswap4_slow(INT32BIT *ivalues, long nvals)
+{
+ register long ii;
+
+#if defined(HAVE_BSWAP)
+ for (ii = 0; ii < nvals; ii++)
+ {
+ ivalues[ii] = __builtin_bswap32(ivalues[ii]);
+ }
+#elif defined(_MSC_VER) && (_MSC_VER >= 1400)
+ /* intrinsic byte swapping function in Microsoft Visual C++ 8.0 and later */
+ unsigned int* uivalues = (unsigned int *) ivalues;
+
+ /* intrinsic byte swapping function in Microsoft Visual C++ */
+ for (ii = 0; ii < nvals; ii++)
+ {
+ uivalues[ii] = _byteswap_ulong(uivalues[ii]);
+ }
+#else
+ char *cvalues, tmp;
+
+ for (ii = 0; ii < nvals; ii++)
+ {
+ cvalues = (char *)&ivalues[ii];
+ tmp = cvalues[0];
+ cvalues[0] = cvalues[3];
+ cvalues[3] = tmp;
+ tmp = cvalues[1];
+ cvalues[1] = cvalues[2];
+ cvalues[2] = tmp;
+ }
+#endif
+}
+/*--------------------------------------------------------------------------*/
+#ifdef __SSSE3__
+void ffswap4(INT32BIT *ivalues, /* IO - pointer to INT*4 to be swapped */
+ long nvals) /* I - number of floats to be swapped */
+/*
+ swap the bytes in the input 4-byte integer: ( 0 1 2 3 -> 3 2 1 0 )
+*/
+{
+ if ((long)ivalues % 4 != 0) { /* should not happen */
+ ffswap4_slow(ivalues, nvals);
+ return;
+ }
+
+ long ii;
+ const __m128i cmask4 = _mm_set_epi8(12, 13, 14, 15,
+ 8, 9, 10, 11,
+ 4, 5, 6, 7,
+ 0, 1, 2 ,3);
+ size_t peel = get_peel((void*)&ivalues[0], sizeof(ivalues[0]), nvals, 16);
+ ffswap4_slow(ivalues, peel);
+ for (ii = peel; ii < (nvals - peel - (nvals - peel) % 4); ii+=4) {
+ swap_ssse3((char*)&ivalues[ii], cmask4);
+ }
+ ffswap4_slow(&ivalues[ii], nvals - ii);
+}
+#else
+void ffswap4(INT32BIT *ivalues, /* IO - pointer to INT*4 to be swapped */
+ long nvals) /* I - number of floats to be swapped */
+/*
+ swap the bytes in the input 4-byte integer: ( 0 1 2 3 -> 3 2 1 0 )
+*/
+{
+ ffswap4_slow(ivalues, nvals);
+}
+#endif
+/*--------------------------------------------------------------------------*/
+static void ffswap8_slow(double *dvalues, long nvals)
+{
+ register long ii;
+#ifdef HAVE_BSWAP
+ LONGLONG * llvalues = (LONGLONG*)dvalues;
+
+ for (ii = 0; ii < nvals; ii++) {
+ llvalues[ii] = __builtin_bswap64(llvalues[ii]);
+ }
+#elif defined(_MSC_VER) && (_MSC_VER >= 1400)
+ /* intrinsic byte swapping function in Microsoft Visual C++ 8.0 and later */
+ unsigned __int64 * llvalues = (unsigned __int64 *) dvalues;
+
+ for (ii = 0; ii < nvals; ii++)
+ {
+ llvalues[ii] = _byteswap_uint64(llvalues[ii]);
+ }
+#else
+ register char *cvalues;
+ register char temp;
+
+ cvalues = (char *) dvalues; /* copy the pointer value */
+
+ for (ii = 0; ii < nvals*8; ii += 8)
+ {
+ temp = cvalues[ii];
+ cvalues[ii] = cvalues[ii+7];
+ cvalues[ii+7] = temp;
+
+ temp = cvalues[ii+1];
+ cvalues[ii+1] = cvalues[ii+6];
+ cvalues[ii+6] = temp;
+
+ temp = cvalues[ii+2];
+ cvalues[ii+2] = cvalues[ii+5];
+ cvalues[ii+5] = temp;
+
+ temp = cvalues[ii+3];
+ cvalues[ii+3] = cvalues[ii+4];
+ cvalues[ii+4] = temp;
+ }
+#endif
+}
+/*--------------------------------------------------------------------------*/
+#ifdef __SSSE3__
+void ffswap8(double *dvalues, /* IO - pointer to doubles to be swapped */
+ long nvals) /* I - number of doubles to be swapped */
+/*
+ swap the bytes in the input doubles: ( 01234567 -> 76543210 )
+*/
+{
+ if ((long)dvalues % 8 != 0) { /* should not happen on amd64 */
+ ffswap8_slow(dvalues, nvals);
+ return;
+ }
+
+ long ii;
+ const __m128i cmask8 = _mm_set_epi8(8, 9, 10, 11, 12, 13, 14, 15,
+ 0, 1, 2 ,3, 4, 5, 6, 7);
+ size_t peel = get_peel((void*)&dvalues[0], sizeof(dvalues[0]), nvals, 16);
+ ffswap8_slow(dvalues, peel);
+ for (ii = peel; ii < (nvals - peel - (nvals - peel) % 2); ii+=2) {
+ swap_ssse3((char*)&dvalues[ii], cmask8);
+ }
+ ffswap8_slow(&dvalues[ii], nvals - ii);
+}
+#else
+void ffswap8(double *dvalues, /* IO - pointer to doubles to be swapped */
+ long nvals) /* I - number of doubles to be swapped */
+/*
+ swap the bytes in the input doubles: ( 01234567 -> 76543210 )
+*/
+{
+ ffswap8_slow(dvalues, nvals);
+}
+#endif
diff --git a/src/plugins/cfitsio/trees.c b/src/plugins/cfitsio/trees.c
new file mode 100644
index 0000000..8436126
--- /dev/null
+++ b/src/plugins/cfitsio/trees.c
@@ -0,0 +1,1242 @@
+/* trees.c -- output deflated data using Huffman coding
+ * Copyright (C) 1995-2010 Jean-loup Gailly
+ * detect_data_type() function provided freely by Cosmin Truta, 2006
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/*
+ * ALGORITHM
+ *
+ * The "deflation" process uses several Huffman trees. The more
+ * common source values are represented by shorter bit sequences.
+ *
+ * Each code tree is stored in a compressed form which is itself
+ * a Huffman encoding of the lengths of all the code strings (in
+ * ascending order by source values). The actual code strings are
+ * reconstructed from the lengths in the inflate process, as described
+ * in the deflate specification.
+ *
+ * REFERENCES
+ *
+ * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification".
+ * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc
+ *
+ * Storer, James A.
+ * Data Compression: Methods and Theory, pp. 49-50.
+ * Computer Science Press, 1988. ISBN 0-7167-8156-5.
+ *
+ * Sedgewick, R.
+ * Algorithms, p290.
+ * Addison-Wesley, 1983. ISBN 0-201-06672-6.
+ */
+
+/* #define GEN_TREES_H */
+
+#include "deflate.h"
+
+#ifdef DEBUG
+# include <ctype.h>
+#endif
+
+/* ===========================================================================
+ * Constants
+ */
+
+#define MAX_BL_BITS 7
+/* Bit length codes must not exceed MAX_BL_BITS bits */
+
+#define END_BLOCK 256
+/* end of block literal code */
+
+#define REP_3_6 16
+/* repeat previous bit length 3-6 times (2 bits of repeat count) */
+
+#define REPZ_3_10 17
+/* repeat a zero length 3-10 times (3 bits of repeat count) */
+
+#define REPZ_11_138 18
+/* repeat a zero length 11-138 times (7 bits of repeat count) */
+
+local const int extra_lbits[LENGTH_CODES] /* extra bits for each length code */
+ = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0};
+
+local const int extra_dbits[D_CODES] /* extra bits for each distance code */
+ = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13};
+
+local const int extra_blbits[BL_CODES]/* extra bits for each bit length code */
+ = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7};
+
+local const uch bl_order[BL_CODES]
+ = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15};
+/* The lengths of the bit length codes are sent in order of decreasing
+ * probability, to avoid transmitting the lengths for unused bit length codes.
+ */
+
+#define Buf_size (8 * 2*sizeof(char))
+/* Number of bits used within bi_buf. (bi_buf might be implemented on
+ * more than 16 bits on some systems.)
+ */
+
+/* ===========================================================================
+ * Local data. These are initialized only once.
+ */
+
+#define DIST_CODE_LEN 512 /* see definition of array dist_code below */
+
+#if defined(GEN_TREES_H) || !defined(STDC)
+/* non ANSI compilers may not accept trees.h */
+
+local ct_data static_ltree[L_CODES+2];
+/* The static literal tree. Since the bit lengths are imposed, there is no
+ * need for the L_CODES extra codes used during heap construction. However
+ * The codes 286 and 287 are needed to build a canonical tree (see _tr_init
+ * below).
+ */
+
+local ct_data static_dtree[D_CODES];
+/* The static distance tree. (Actually a trivial tree since all codes use
+ * 5 bits.)
+ */
+
+uch _dist_code[DIST_CODE_LEN];
+/* Distance codes. The first 256 values correspond to the distances
+ * 3 .. 258, the last 256 values correspond to the top 8 bits of
+ * the 15 bit distances.
+ */
+
+uch _length_code[MAX_MATCH-MIN_MATCH+1];
+/* length code for each normalized match length (0 == MIN_MATCH) */
+
+local int base_length[LENGTH_CODES];
+/* First normalized length for each code (0 = MIN_MATCH) */
+
+local int base_dist[D_CODES];
+/* First normalized distance for each code (0 = distance of 1) */
+
+#else
+# include "trees.h"
+#endif /* GEN_TREES_H */
+
+struct static_tree_desc_s {
+ const ct_data *static_tree; /* static tree or NULL */
+ const intf *extra_bits; /* extra bits for each code or NULL */
+ int extra_base; /* base index for extra_bits */
+ int elems; /* max number of elements in the tree */
+ int max_length; /* max bit length for the codes */
+};
+
+local static_tree_desc static_l_desc =
+{static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS};
+
+local static_tree_desc static_d_desc =
+{static_dtree, extra_dbits, 0, D_CODES, MAX_BITS};
+
+local static_tree_desc static_bl_desc =
+{(const ct_data *)0, extra_blbits, 0, BL_CODES, MAX_BL_BITS};
+
+/* ===========================================================================
+ * Local (static) routines in this file.
+ */
+
+local void tr_static_init OF((void));
+local void init_block OF((deflate_state *s));
+local void pqdownheap OF((deflate_state *s, ct_data *tree, int k));
+local void gen_bitlen OF((deflate_state *s, tree_desc *desc));
+local void gen_codes OF((ct_data *tree, int max_code, ushf *bl_count));
+local void build_tree OF((deflate_state *s, tree_desc *desc));
+local void scan_tree OF((deflate_state *s, ct_data *tree, int max_code));
+local void send_tree OF((deflate_state *s, ct_data *tree, int max_code));
+local int build_bl_tree OF((deflate_state *s));
+local void send_all_trees OF((deflate_state *s, int lcodes, int dcodes,
+ int blcodes));
+local void compress_block OF((deflate_state *s, ct_data *ltree,
+ ct_data *dtree));
+local int detect_data_type OF((deflate_state *s));
+local unsigned bi_reverse OF((unsigned value, int length));
+local void bi_windup OF((deflate_state *s));
+local void bi_flush OF((deflate_state *s));
+local void copy_block OF((deflate_state *s, charf *buf, unsigned len,
+ int header));
+
+#ifdef GEN_TREES_H
+local void gen_trees_header OF((void));
+#endif
+
+#ifndef DEBUG
+# define send_code(s, c, tree) send_bits(s, tree[c].Code, tree[c].Len)
+ /* Send a code of the given tree. c and tree must not have side effects */
+
+#else /* DEBUG */
+# define send_code(s, c, tree) \
+ { if (z_verbose>2) fprintf(stderr,"\ncd %3d ",(c)); \
+ send_bits(s, tree[c].Code, tree[c].Len); }
+#endif
+
+/* ===========================================================================
+ * Output a short LSB first on the stream.
+ * IN assertion: there is enough room in pendingBuf.
+ */
+#define put_short(s, w) { \
+ put_byte(s, (uch)((w) & 0xff)); \
+ put_byte(s, (uch)((ush)(w) >> 8)); \
+}
+
+/* ===========================================================================
+ * Send a value on a given number of bits.
+ * IN assertion: length <= 16 and value fits in length bits.
+ */
+#ifdef DEBUG
+local void send_bits OF((deflate_state *s, int value, int length));
+
+local void send_bits(s, value, length)
+ deflate_state *s;
+ int value; /* value to send */
+ int length; /* number of bits */
+{
+ Tracevv((stderr," l %2d v %4x ", length, value));
+ Assert(length > 0 && length <= 15, "invalid length");
+ s->bits_sent += (ulg)length;
+
+ /* If not enough room in bi_buf, use (valid) bits from bi_buf and
+ * (16 - bi_valid) bits from value, leaving (width - (16-bi_valid))
+ * unused bits in value.
+ */
+ if (s->bi_valid > (int)Buf_size - length) {
+ s->bi_buf |= (ush)value << s->bi_valid;
+ put_short(s, s->bi_buf);
+ s->bi_buf = (ush)value >> (Buf_size - s->bi_valid);
+ s->bi_valid += length - Buf_size;
+ } else {
+ s->bi_buf |= (ush)value << s->bi_valid;
+ s->bi_valid += length;
+ }
+}
+#else /* !DEBUG */
+
+#define send_bits(s, value, length) \
+{ int len = length;\
+ if (s->bi_valid > (int)Buf_size - len) {\
+ int val = value;\
+ s->bi_buf |= (ush)val << s->bi_valid;\
+ put_short(s, s->bi_buf);\
+ s->bi_buf = (ush)val >> (Buf_size - s->bi_valid);\
+ s->bi_valid += len - Buf_size;\
+ } else {\
+ s->bi_buf |= (ush)(value) << s->bi_valid;\
+ s->bi_valid += len;\
+ }\
+}
+#endif /* DEBUG */
+
+
+/* the arguments must not have side effects */
+
+/* ===========================================================================
+ * Initialize the various 'constant' tables.
+ */
+local void tr_static_init()
+{
+#if defined(GEN_TREES_H) || !defined(STDC)
+ static int static_init_done = 0;
+ int n; /* iterates over tree elements */
+ int bits; /* bit counter */
+ int length; /* length value */
+ int code; /* code value */
+ int dist; /* distance index */
+ ush bl_count[MAX_BITS+1];
+ /* number of codes at each bit length for an optimal tree */
+
+ if (static_init_done) return;
+
+ /* For some embedded targets, global variables are not initialized: */
+#ifdef NO_INIT_GLOBAL_POINTERS
+ static_l_desc.static_tree = static_ltree;
+ static_l_desc.extra_bits = extra_lbits;
+ static_d_desc.static_tree = static_dtree;
+ static_d_desc.extra_bits = extra_dbits;
+ static_bl_desc.extra_bits = extra_blbits;
+#endif
+
+ /* Initialize the mapping length (0..255) -> length code (0..28) */
+ length = 0;
+ for (code = 0; code < LENGTH_CODES-1; code++) {
+ base_length[code] = length;
+ for (n = 0; n < (1<<extra_lbits[code]); n++) {
+ _length_code[length++] = (uch)code;
+ }
+ }
+ Assert (length == 256, "tr_static_init: length != 256");
+ /* Note that the length 255 (match length 258) can be represented
+ * in two different ways: code 284 + 5 bits or code 285, so we
+ * overwrite length_code[255] to use the best encoding:
+ */
+ _length_code[length-1] = (uch)code;
+
+ /* Initialize the mapping dist (0..32K) -> dist code (0..29) */
+ dist = 0;
+ for (code = 0 ; code < 16; code++) {
+ base_dist[code] = dist;
+ for (n = 0; n < (1<<extra_dbits[code]); n++) {
+ _dist_code[dist++] = (uch)code;
+ }
+ }
+ Assert (dist == 256, "tr_static_init: dist != 256");
+ dist >>= 7; /* from now on, all distances are divided by 128 */
+ for ( ; code < D_CODES; code++) {
+ base_dist[code] = dist << 7;
+ for (n = 0; n < (1<<(extra_dbits[code]-7)); n++) {
+ _dist_code[256 + dist++] = (uch)code;
+ }
+ }
+ Assert (dist == 256, "tr_static_init: 256+dist != 512");
+
+ /* Construct the codes of the static literal tree */
+ for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0;
+ n = 0;
+ while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++;
+ while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++;
+ while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++;
+ while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++;
+ /* Codes 286 and 287 do not exist, but we must include them in the
+ * tree construction to get a canonical Huffman tree (longest code
+ * all ones)
+ */
+ gen_codes((ct_data *)static_ltree, L_CODES+1, bl_count);
+
+ /* The static distance tree is trivial: */
+ for (n = 0; n < D_CODES; n++) {
+ static_dtree[n].Len = 5;
+ static_dtree[n].Code = bi_reverse((unsigned)n, 5);
+ }
+ static_init_done = 1;
+
+# ifdef GEN_TREES_H
+ gen_trees_header();
+# endif
+#endif /* defined(GEN_TREES_H) || !defined(STDC) */
+}
+
+/* ===========================================================================
+ * Genererate the file trees.h describing the static trees.
+ */
+#ifdef GEN_TREES_H
+# ifndef DEBUG
+# include <stdio.h>
+# endif
+
+# define SEPARATOR(i, last, width) \
+ ((i) == (last)? "\n};\n\n" : \
+ ((i) % (width) == (width)-1 ? ",\n" : ", "))
+
+void gen_trees_header()
+{
+ FILE *header = fopen("trees.h", "w");
+ int i;
+
+ Assert (header != NULL, "Can't open trees.h");
+ fprintf(header,
+ "/* header created automatically with -DGEN_TREES_H */\n\n");
+
+ fprintf(header, "local const ct_data static_ltree[L_CODES+2] = {\n");
+ for (i = 0; i < L_CODES+2; i++) {
+ fprintf(header, "{{%3u},{%3u}}%s", static_ltree[i].Code,
+ static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5));
+ }
+
+ fprintf(header, "local const ct_data static_dtree[D_CODES] = {\n");
+ for (i = 0; i < D_CODES; i++) {
+ fprintf(header, "{{%2u},{%2u}}%s", static_dtree[i].Code,
+ static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5));
+ }
+
+ fprintf(header, "const uch ZLIB_INTERNAL _dist_code[DIST_CODE_LEN] = {\n");
+ for (i = 0; i < DIST_CODE_LEN; i++) {
+ fprintf(header, "%2u%s", _dist_code[i],
+ SEPARATOR(i, DIST_CODE_LEN-1, 20));
+ }
+
+ fprintf(header,
+ "const uch ZLIB_INTERNAL _length_code[MAX_MATCH-MIN_MATCH+1]= {\n");
+ for (i = 0; i < MAX_MATCH-MIN_MATCH+1; i++) {
+ fprintf(header, "%2u%s", _length_code[i],
+ SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20));
+ }
+
+ fprintf(header, "local const int base_length[LENGTH_CODES] = {\n");
+ for (i = 0; i < LENGTH_CODES; i++) {
+ fprintf(header, "%1u%s", base_length[i],
+ SEPARATOR(i, LENGTH_CODES-1, 20));
+ }
+
+ fprintf(header, "local const int base_dist[D_CODES] = {\n");
+ for (i = 0; i < D_CODES; i++) {
+ fprintf(header, "%5u%s", base_dist[i],
+ SEPARATOR(i, D_CODES-1, 10));
+ }
+
+ fclose(header);
+}
+#endif /* GEN_TREES_H */
+
+/* ===========================================================================
+ * Initialize the tree data structures for a new zlib stream.
+ */
+void ZLIB_INTERNAL _tr_init(s)
+ deflate_state *s;
+{
+ tr_static_init();
+
+ s->l_desc.dyn_tree = s->dyn_ltree;
+ s->l_desc.stat_desc = &static_l_desc;
+
+ s->d_desc.dyn_tree = s->dyn_dtree;
+ s->d_desc.stat_desc = &static_d_desc;
+
+ s->bl_desc.dyn_tree = s->bl_tree;
+ s->bl_desc.stat_desc = &static_bl_desc;
+
+ s->bi_buf = 0;
+ s->bi_valid = 0;
+ s->last_eob_len = 8; /* enough lookahead for inflate */
+#ifdef DEBUG
+ s->compressed_len = 0L;
+ s->bits_sent = 0L;
+#endif
+
+ /* Initialize the first block of the first file: */
+ init_block(s);
+}
+
+/* ===========================================================================
+ * Initialize a new block.
+ */
+local void init_block(s)
+ deflate_state *s;
+{
+ int n; /* iterates over tree elements */
+
+ /* Initialize the trees. */
+ for (n = 0; n < L_CODES; n++) s->dyn_ltree[n].Freq = 0;
+ for (n = 0; n < D_CODES; n++) s->dyn_dtree[n].Freq = 0;
+ for (n = 0; n < BL_CODES; n++) s->bl_tree[n].Freq = 0;
+
+ s->dyn_ltree[END_BLOCK].Freq = 1;
+ s->opt_len = s->static_len = 0L;
+ s->last_lit = s->matches = 0;
+}
+
+#define SMALLEST 1
+/* Index within the heap array of least frequent node in the Huffman tree */
+
+
+/* ===========================================================================
+ * Remove the smallest element from the heap and recreate the heap with
+ * one less element. Updates heap and heap_len.
+ */
+#define pqremove(s, tree, top) \
+{\
+ top = s->heap[SMALLEST]; \
+ s->heap[SMALLEST] = s->heap[s->heap_len--]; \
+ pqdownheap(s, tree, SMALLEST); \
+}
+
+/* ===========================================================================
+ * Compares to subtrees, using the tree depth as tie breaker when
+ * the subtrees have equal frequency. This minimizes the worst case length.
+ */
+#define smaller(tree, n, m, depth) \
+ (tree[n].Freq < tree[m].Freq || \
+ (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m]))
+
+/* ===========================================================================
+ * Restore the heap property by moving down the tree starting at node k,
+ * exchanging a node with the smallest of its two sons if necessary, stopping
+ * when the heap property is re-established (each father smaller than its
+ * two sons).
+ */
+local void pqdownheap(s, tree, k)
+ deflate_state *s;
+ ct_data *tree; /* the tree to restore */
+ int k; /* node to move down */
+{
+ int v = s->heap[k];
+ int j = k << 1; /* left son of k */
+ while (j <= s->heap_len) {
+ /* Set j to the smallest of the two sons: */
+ if (j < s->heap_len &&
+ smaller(tree, s->heap[j+1], s->heap[j], s->depth)) {
+ j++;
+ }
+ /* Exit if v is smaller than both sons */
+ if (smaller(tree, v, s->heap[j], s->depth)) break;
+
+ /* Exchange v with the smallest son */
+ s->heap[k] = s->heap[j]; k = j;
+
+ /* And continue down the tree, setting j to the left son of k */
+ j <<= 1;
+ }
+ s->heap[k] = v;
+}
+
+/* ===========================================================================
+ * Compute the optimal bit lengths for a tree and update the total bit length
+ * for the current block.
+ * IN assertion: the fields freq and dad are set, heap[heap_max] and
+ * above are the tree nodes sorted by increasing frequency.
+ * OUT assertions: the field len is set to the optimal bit length, the
+ * array bl_count contains the frequencies for each bit length.
+ * The length opt_len is updated; static_len is also updated if stree is
+ * not null.
+ */
+local void gen_bitlen(s, desc)
+ deflate_state *s;
+ tree_desc *desc; /* the tree descriptor */
+{
+ ct_data *tree = desc->dyn_tree;
+ int max_code = desc->max_code;
+ const ct_data *stree = desc->stat_desc->static_tree;
+ const intf *extra = desc->stat_desc->extra_bits;
+ int base = desc->stat_desc->extra_base;
+ int max_length = desc->stat_desc->max_length;
+ int h; /* heap index */
+ int n, m; /* iterate over the tree elements */
+ int bits; /* bit length */
+ int xbits; /* extra bits */
+ ush f; /* frequency */
+ int overflow = 0; /* number of elements with bit length too large */
+
+ for (bits = 0; bits <= MAX_BITS; bits++) s->bl_count[bits] = 0;
+
+ /* In a first pass, compute the optimal bit lengths (which may
+ * overflow in the case of the bit length tree).
+ */
+ tree[s->heap[s->heap_max]].Len = 0; /* root of the heap */
+
+ for (h = s->heap_max+1; h < HEAP_SIZE; h++) {
+ n = s->heap[h];
+ bits = tree[tree[n].Dad].Len + 1;
+ if (bits > max_length) bits = max_length, overflow++;
+ tree[n].Len = (ush)bits;
+ /* We overwrite tree[n].Dad which is no longer needed */
+
+ if (n > max_code) continue; /* not a leaf node */
+
+ s->bl_count[bits]++;
+ xbits = 0;
+ if (n >= base) xbits = extra[n-base];
+ f = tree[n].Freq;
+ s->opt_len += (ulg)f * (bits + xbits);
+ if (stree) s->static_len += (ulg)f * (stree[n].Len + xbits);
+ }
+ if (overflow == 0) return;
+
+ Trace((stderr,"\nbit length overflow\n"));
+ /* This happens for example on obj2 and pic of the Calgary corpus */
+
+ /* Find the first bit length which could increase: */
+ do {
+ bits = max_length-1;
+ while (s->bl_count[bits] == 0) bits--;
+ s->bl_count[bits]--; /* move one leaf down the tree */
+ s->bl_count[bits+1] += 2; /* move one overflow item as its brother */
+ s->bl_count[max_length]--;
+ /* The brother of the overflow item also moves one step up,
+ * but this does not affect bl_count[max_length]
+ */
+ overflow -= 2;
+ } while (overflow > 0);
+
+ /* Now recompute all bit lengths, scanning in increasing frequency.
+ * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all
+ * lengths instead of fixing only the wrong ones. This idea is taken
+ * from 'ar' written by Haruhiko Okumura.)
+ */
+ for (bits = max_length; bits != 0; bits--) {
+ n = s->bl_count[bits];
+ while (n != 0) {
+ m = s->heap[--h];
+ if (m > max_code) continue;
+ if ((unsigned) tree[m].Len != (unsigned) bits) {
+ Trace((stderr,"code %d bits %d->%d\n", m, tree[m].Len, bits));
+ s->opt_len += ((long)bits - (long)tree[m].Len)
+ *(long)tree[m].Freq;
+ tree[m].Len = (ush)bits;
+ }
+ n--;
+ }
+ }
+}
+
+/* ===========================================================================
+ * Generate the codes for a given tree and bit counts (which need not be
+ * optimal).
+ * IN assertion: the array bl_count contains the bit length statistics for
+ * the given tree and the field len is set for all tree elements.
+ * OUT assertion: the field code is set for all tree elements of non
+ * zero code length.
+ */
+local void gen_codes (tree, max_code, bl_count)
+ ct_data *tree; /* the tree to decorate */
+ int max_code; /* largest code with non zero frequency */
+ ushf *bl_count; /* number of codes at each bit length */
+{
+ ush next_code[MAX_BITS+1]; /* next code value for each bit length */
+ ush code = 0; /* running code value */
+ int bits; /* bit index */
+ int n; /* code index */
+
+ /* The distribution counts are first used to generate the code values
+ * without bit reversal.
+ */
+ for (bits = 1; bits <= MAX_BITS; bits++) {
+ next_code[bits] = code = (code + bl_count[bits-1]) << 1;
+ }
+ /* Check that the bit counts in bl_count are consistent. The last code
+ * must be all ones.
+ */
+ Assert (code + bl_count[MAX_BITS]-1 == (1<<MAX_BITS)-1,
+ "inconsistent bit counts");
+ Tracev((stderr,"\ngen_codes: max_code %d ", max_code));
+
+ for (n = 0; n <= max_code; n++) {
+ int len = tree[n].Len;
+ if (len == 0) continue;
+ /* Now reverse the bits */
+ tree[n].Code = bi_reverse(next_code[len]++, len);
+
+ Tracecv(tree != static_ltree, (stderr,"\nn %3d %c l %2d c %4x (%x) ",
+ n, (isgraph(n) ? n : ' '), len, tree[n].Code, next_code[len]-1));
+ }
+}
+
+/* ===========================================================================
+ * Construct one Huffman tree and assigns the code bit strings and lengths.
+ * Update the total bit length for the current block.
+ * IN assertion: the field freq is set for all tree elements.
+ * OUT assertions: the fields len and code are set to the optimal bit length
+ * and corresponding code. The length opt_len is updated; static_len is
+ * also updated if stree is not null. The field max_code is set.
+ */
+local void build_tree(s, desc)
+ deflate_state *s;
+ tree_desc *desc; /* the tree descriptor */
+{
+ ct_data *tree = desc->dyn_tree;
+ const ct_data *stree = desc->stat_desc->static_tree;
+ int elems = desc->stat_desc->elems;
+ int n, m; /* iterate over heap elements */
+ int max_code = -1; /* largest code with non zero frequency */
+ int node; /* new node being created */
+
+ /* Construct the initial heap, with least frequent element in
+ * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1].
+ * heap[0] is not used.
+ */
+ s->heap_len = 0, s->heap_max = HEAP_SIZE;
+
+ for (n = 0; n < elems; n++) {
+ if (tree[n].Freq != 0) {
+ s->heap[++(s->heap_len)] = max_code = n;
+ s->depth[n] = 0;
+ } else {
+ tree[n].Len = 0;
+ }
+ }
+
+ /* The pkzip format requires that at least one distance code exists,
+ * and that at least one bit should be sent even if there is only one
+ * possible code. So to avoid special checks later on we force at least
+ * two codes of non zero frequency.
+ */
+ while (s->heap_len < 2) {
+ node = s->heap[++(s->heap_len)] = (max_code < 2 ? ++max_code : 0);
+ tree[node].Freq = 1;
+ s->depth[node] = 0;
+ s->opt_len--; if (stree) s->static_len -= stree[node].Len;
+ /* node is 0 or 1 so it does not have extra bits */
+ }
+ desc->max_code = max_code;
+
+ /* The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree,
+ * establish sub-heaps of increasing lengths:
+ */
+ for (n = s->heap_len/2; n >= 1; n--) pqdownheap(s, tree, n);
+
+ /* Construct the Huffman tree by repeatedly combining the least two
+ * frequent nodes.
+ */
+ node = elems; /* next internal node of the tree */
+ do {
+ pqremove(s, tree, n); /* n = node of least frequency */
+ m = s->heap[SMALLEST]; /* m = node of next least frequency */
+
+ s->heap[--(s->heap_max)] = n; /* keep the nodes sorted by frequency */
+ s->heap[--(s->heap_max)] = m;
+
+ /* Create a new node father of n and m */
+ tree[node].Freq = tree[n].Freq + tree[m].Freq;
+ s->depth[node] = (uch)((s->depth[n] >= s->depth[m] ?
+ s->depth[n] : s->depth[m]) + 1);
+ tree[n].Dad = tree[m].Dad = (ush)node;
+#ifdef DUMP_BL_TREE
+ if (tree == s->bl_tree) {
+ fprintf(stderr,"\nnode %d(%d), sons %d(%d) %d(%d)",
+ node, tree[node].Freq, n, tree[n].Freq, m, tree[m].Freq);
+ }
+#endif
+ /* and insert the new node in the heap */
+ s->heap[SMALLEST] = node++;
+ pqdownheap(s, tree, SMALLEST);
+
+ } while (s->heap_len >= 2);
+
+ s->heap[--(s->heap_max)] = s->heap[SMALLEST];
+
+ /* At this point, the fields freq and dad are set. We can now
+ * generate the bit lengths.
+ */
+ gen_bitlen(s, (tree_desc *)desc);
+
+ /* The field len is now set, we can generate the bit codes */
+ gen_codes ((ct_data *)tree, max_code, s->bl_count);
+}
+
+/* ===========================================================================
+ * Scan a literal or distance tree to determine the frequencies of the codes
+ * in the bit length tree.
+ */
+local void scan_tree (s, tree, max_code)
+ deflate_state *s;
+ ct_data *tree; /* the tree to be scanned */
+ int max_code; /* and its largest code of non zero frequency */
+{
+ int n; /* iterates over all tree elements */
+ int prevlen = -1; /* last emitted length */
+ int curlen; /* length of current code */
+ int nextlen = tree[0].Len; /* length of next code */
+ int count = 0; /* repeat count of the current code */
+ int max_count = 7; /* max repeat count */
+ int min_count = 4; /* min repeat count */
+
+ if (nextlen == 0) max_count = 138, min_count = 3;
+ tree[max_code+1].Len = (ush)0xffff; /* guard */
+
+ for (n = 0; n <= max_code; n++) {
+ curlen = nextlen; nextlen = tree[n+1].Len;
+ if (++count < max_count && curlen == nextlen) {
+ continue;
+ } else if (count < min_count) {
+ s->bl_tree[curlen].Freq += count;
+ } else if (curlen != 0) {
+ if (curlen != prevlen) s->bl_tree[curlen].Freq++;
+ s->bl_tree[REP_3_6].Freq++;
+ } else if (count <= 10) {
+ s->bl_tree[REPZ_3_10].Freq++;
+ } else {
+ s->bl_tree[REPZ_11_138].Freq++;
+ }
+ count = 0; prevlen = curlen;
+ if (nextlen == 0) {
+ max_count = 138, min_count = 3;
+ } else if (curlen == nextlen) {
+ max_count = 6, min_count = 3;
+ } else {
+ max_count = 7, min_count = 4;
+ }
+ }
+}
+
+/* ===========================================================================
+ * Send a literal or distance tree in compressed form, using the codes in
+ * bl_tree.
+ */
+local void send_tree (s, tree, max_code)
+ deflate_state *s;
+ ct_data *tree; /* the tree to be scanned */
+ int max_code; /* and its largest code of non zero frequency */
+{
+ int n; /* iterates over all tree elements */
+ int prevlen = -1; /* last emitted length */
+ int curlen; /* length of current code */
+ int nextlen = tree[0].Len; /* length of next code */
+ int count = 0; /* repeat count of the current code */
+ int max_count = 7; /* max repeat count */
+ int min_count = 4; /* min repeat count */
+
+ /* tree[max_code+1].Len = -1; */ /* guard already set */
+ if (nextlen == 0) max_count = 138, min_count = 3;
+
+ for (n = 0; n <= max_code; n++) {
+ curlen = nextlen; nextlen = tree[n+1].Len;
+ if (++count < max_count && curlen == nextlen) {
+ continue;
+ } else if (count < min_count) {
+ do { send_code(s, curlen, s->bl_tree); } while (--count != 0);
+
+ } else if (curlen != 0) {
+ if (curlen != prevlen) {
+ send_code(s, curlen, s->bl_tree); count--;
+ }
+ Assert(count >= 3 && count <= 6, " 3_6?");
+ send_code(s, REP_3_6, s->bl_tree); send_bits(s, count-3, 2);
+
+ } else if (count <= 10) {
+ send_code(s, REPZ_3_10, s->bl_tree); send_bits(s, count-3, 3);
+
+ } else {
+ send_code(s, REPZ_11_138, s->bl_tree); send_bits(s, count-11, 7);
+ }
+ count = 0; prevlen = curlen;
+ if (nextlen == 0) {
+ max_count = 138, min_count = 3;
+ } else if (curlen == nextlen) {
+ max_count = 6, min_count = 3;
+ } else {
+ max_count = 7, min_count = 4;
+ }
+ }
+}
+
+/* ===========================================================================
+ * Construct the Huffman tree for the bit lengths and return the index in
+ * bl_order of the last bit length code to send.
+ */
+local int build_bl_tree(s)
+ deflate_state *s;
+{
+ int max_blindex; /* index of last bit length code of non zero freq */
+
+ /* Determine the bit length frequencies for literal and distance trees */
+ scan_tree(s, (ct_data *)s->dyn_ltree, s->l_desc.max_code);
+ scan_tree(s, (ct_data *)s->dyn_dtree, s->d_desc.max_code);
+
+ /* Build the bit length tree: */
+ build_tree(s, (tree_desc *)(&(s->bl_desc)));
+ /* opt_len now includes the length of the tree representations, except
+ * the lengths of the bit lengths codes and the 5+5+4 bits for the counts.
+ */
+
+ /* Determine the number of bit length codes to send. The pkzip format
+ * requires that at least 4 bit length codes be sent. (appnote.txt says
+ * 3 but the actual value used is 4.)
+ */
+ for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) {
+ if (s->bl_tree[bl_order[max_blindex]].Len != 0) break;
+ }
+ /* Update opt_len to include the bit length tree and counts */
+ s->opt_len += 3*(max_blindex+1) + 5+5+4;
+ Tracev((stderr, "\ndyn trees: dyn %ld, stat %ld",
+ s->opt_len, s->static_len));
+
+ return max_blindex;
+}
+
+/* ===========================================================================
+ * Send the header for a block using dynamic Huffman trees: the counts, the
+ * lengths of the bit length codes, the literal tree and the distance tree.
+ * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4.
+ */
+local void send_all_trees(s, lcodes, dcodes, blcodes)
+ deflate_state *s;
+ int lcodes, dcodes, blcodes; /* number of codes for each tree */
+{
+ int rank; /* index in bl_order */
+
+ Assert (lcodes >= 257 && dcodes >= 1 && blcodes >= 4, "not enough codes");
+ Assert (lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES,
+ "too many codes");
+ Tracev((stderr, "\nbl counts: "));
+ send_bits(s, lcodes-257, 5); /* not +255 as stated in appnote.txt */
+ send_bits(s, dcodes-1, 5);
+ send_bits(s, blcodes-4, 4); /* not -3 as stated in appnote.txt */
+ for (rank = 0; rank < blcodes; rank++) {
+ Tracev((stderr, "\nbl code %2d ", bl_order[rank]));
+ send_bits(s, s->bl_tree[bl_order[rank]].Len, 3);
+ }
+ Tracev((stderr, "\nbl tree: sent %ld", s->bits_sent));
+
+ send_tree(s, (ct_data *)s->dyn_ltree, lcodes-1); /* literal tree */
+ Tracev((stderr, "\nlit tree: sent %ld", s->bits_sent));
+
+ send_tree(s, (ct_data *)s->dyn_dtree, dcodes-1); /* distance tree */
+ Tracev((stderr, "\ndist tree: sent %ld", s->bits_sent));
+}
+
+/* ===========================================================================
+ * Send a stored block
+ */
+void ZLIB_INTERNAL _tr_stored_block(s, buf, stored_len, last)
+ deflate_state *s;
+ charf *buf; /* input block */
+ ulg stored_len; /* length of input block */
+ int last; /* one if this is the last block for a file */
+{
+ send_bits(s, (STORED_BLOCK<<1)+last, 3); /* send block type */
+#ifdef DEBUG
+ s->compressed_len = (s->compressed_len + 3 + 7) & (ulg)~7L;
+ s->compressed_len += (stored_len + 4) << 3;
+#endif
+ copy_block(s, buf, (unsigned)stored_len, 1); /* with header */
+}
+
+/* ===========================================================================
+ * Send one empty static block to give enough lookahead for inflate.
+ * This takes 10 bits, of which 7 may remain in the bit buffer.
+ * The current inflate code requires 9 bits of lookahead. If the
+ * last two codes for the previous block (real code plus EOB) were coded
+ * on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode
+ * the last real code. In this case we send two empty static blocks instead
+ * of one. (There are no problems if the previous block is stored or fixed.)
+ * To simplify the code, we assume the worst case of last real code encoded
+ * on one bit only.
+ */
+void ZLIB_INTERNAL _tr_align(s)
+ deflate_state *s;
+{
+ send_bits(s, STATIC_TREES<<1, 3);
+ send_code(s, END_BLOCK, static_ltree);
+#ifdef DEBUG
+ s->compressed_len += 10L; /* 3 for block type, 7 for EOB */
+#endif
+ bi_flush(s);
+ /* Of the 10 bits for the empty block, we have already sent
+ * (10 - bi_valid) bits. The lookahead for the last real code (before
+ * the EOB of the previous block) was thus at least one plus the length
+ * of the EOB plus what we have just sent of the empty static block.
+ */
+ if (1 + s->last_eob_len + 10 - s->bi_valid < 9) {
+ send_bits(s, STATIC_TREES<<1, 3);
+ send_code(s, END_BLOCK, static_ltree);
+#ifdef DEBUG
+ s->compressed_len += 10L;
+#endif
+ bi_flush(s);
+ }
+ s->last_eob_len = 7;
+}
+
+/* ===========================================================================
+ * Determine the best encoding for the current block: dynamic trees, static
+ * trees or store, and output the encoded block to the zip file.
+ */
+void ZLIB_INTERNAL _tr_flush_block(s, buf, stored_len, last)
+ deflate_state *s;
+ charf *buf; /* input block, or NULL if too old */
+ ulg stored_len; /* length of input block */
+ int last; /* one if this is the last block for a file */
+{
+ ulg opt_lenb, static_lenb; /* opt_len and static_len in bytes */
+ int max_blindex = 0; /* index of last bit length code of non zero freq */
+
+ /* Build the Huffman trees unless a stored block is forced */
+ if (s->level > 0) {
+
+ /* Check if the file is binary or text */
+ if (s->strm->data_type == Z_UNKNOWN)
+ s->strm->data_type = detect_data_type(s);
+
+ /* Construct the literal and distance trees */
+ build_tree(s, (tree_desc *)(&(s->l_desc)));
+ Tracev((stderr, "\nlit data: dyn %ld, stat %ld", s->opt_len,
+ s->static_len));
+
+ build_tree(s, (tree_desc *)(&(s->d_desc)));
+ Tracev((stderr, "\ndist data: dyn %ld, stat %ld", s->opt_len,
+ s->static_len));
+ /* At this point, opt_len and static_len are the total bit lengths of
+ * the compressed block data, excluding the tree representations.
+ */
+
+ /* Build the bit length tree for the above two trees, and get the index
+ * in bl_order of the last bit length code to send.
+ */
+ max_blindex = build_bl_tree(s);
+
+ /* Determine the best encoding. Compute the block lengths in bytes. */
+ opt_lenb = (s->opt_len+3+7)>>3;
+ static_lenb = (s->static_len+3+7)>>3;
+
+ Tracev((stderr, "\nopt %lu(%lu) stat %lu(%lu) stored %lu lit %u ",
+ opt_lenb, s->opt_len, static_lenb, s->static_len, stored_len,
+ s->last_lit));
+
+ if (static_lenb <= opt_lenb) opt_lenb = static_lenb;
+
+ } else {
+ Assert(buf != (char*)0, "lost buf");
+ opt_lenb = static_lenb = stored_len + 5; /* force a stored block */
+ }
+
+#ifdef FORCE_STORED
+ if (buf != (char*)0) { /* force stored block */
+#else
+ if (stored_len+4 <= opt_lenb && buf != (char*)0) {
+ /* 4: two words for the lengths */
+#endif
+ /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE.
+ * Otherwise we can't have processed more than WSIZE input bytes since
+ * the last block flush, because compression would have been
+ * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to
+ * transform a block into a stored block.
+ */
+ _tr_stored_block(s, buf, stored_len, last);
+
+#ifdef FORCE_STATIC
+ } else if (static_lenb >= 0) { /* force static trees */
+#else
+ } else if (s->strategy == Z_FIXED || static_lenb == opt_lenb) {
+#endif
+ send_bits(s, (STATIC_TREES<<1)+last, 3);
+ compress_block(s, (ct_data *)static_ltree, (ct_data *)static_dtree);
+#ifdef DEBUG
+ s->compressed_len += 3 + s->static_len;
+#endif
+ } else {
+ send_bits(s, (DYN_TREES<<1)+last, 3);
+ send_all_trees(s, s->l_desc.max_code+1, s->d_desc.max_code+1,
+ max_blindex+1);
+ compress_block(s, (ct_data *)s->dyn_ltree, (ct_data *)s->dyn_dtree);
+#ifdef DEBUG
+ s->compressed_len += 3 + s->opt_len;
+#endif
+ }
+ Assert (s->compressed_len == s->bits_sent, "bad compressed size");
+ /* The above check is made mod 2^32, for files larger than 512 MB
+ * and uLong implemented on 32 bits.
+ */
+ init_block(s);
+
+ if (last) {
+ bi_windup(s);
+#ifdef DEBUG
+ s->compressed_len += 7; /* align on byte boundary */
+#endif
+ }
+ Tracev((stderr,"\ncomprlen %lu(%lu) ", s->compressed_len>>3,
+ s->compressed_len-7*last));
+}
+
+/* ===========================================================================
+ * Save the match info and tally the frequency counts. Return true if
+ * the current block must be flushed.
+ */
+int ZLIB_INTERNAL _tr_tally (s, dist, lc)
+ deflate_state *s;
+ unsigned dist; /* distance of matched string */
+ unsigned lc; /* match length-MIN_MATCH or unmatched char (if dist==0) */
+{
+ s->d_buf[s->last_lit] = (ush)dist;
+ s->l_buf[s->last_lit++] = (uch)lc;
+ if (dist == 0) {
+ /* lc is the unmatched char */
+ s->dyn_ltree[lc].Freq++;
+ } else {
+ s->matches++;
+ /* Here, lc is the match length - MIN_MATCH */
+ dist--; /* dist = match distance - 1 */
+ Assert((ush)dist < (ush)MAX_DIST(s) &&
+ (ush)lc <= (ush)(MAX_MATCH-MIN_MATCH) &&
+ (ush)d_code(dist) < (ush)D_CODES, "_tr_tally: bad match");
+
+ s->dyn_ltree[_length_code[lc]+LITERALS+1].Freq++;
+ s->dyn_dtree[d_code(dist)].Freq++;
+ }
+
+#ifdef TRUNCATE_BLOCK
+ /* Try to guess if it is profitable to stop the current block here */
+ if ((s->last_lit & 0x1fff) == 0 && s->level > 2) {
+ /* Compute an upper bound for the compressed length */
+ ulg out_length = (ulg)s->last_lit*8L;
+ ulg in_length = (ulg)((long)s->strstart - s->block_start);
+ int dcode;
+ for (dcode = 0; dcode < D_CODES; dcode++) {
+ out_length += (ulg)s->dyn_dtree[dcode].Freq *
+ (5L+extra_dbits[dcode]);
+ }
+ out_length >>= 3;
+ Tracev((stderr,"\nlast_lit %u, in %ld, out ~%ld(%ld%%) ",
+ s->last_lit, in_length, out_length,
+ 100L - out_length*100L/in_length));
+ if (s->matches < s->last_lit/2 && out_length < in_length/2) return 1;
+ }
+#endif
+ return (s->last_lit == s->lit_bufsize-1);
+ /* We avoid equality with lit_bufsize because of wraparound at 64K
+ * on 16 bit machines and because stored blocks are restricted to
+ * 64K-1 bytes.
+ */
+}
+
+/* ===========================================================================
+ * Send the block data compressed using the given Huffman trees
+ */
+local void compress_block(s, ltree, dtree)
+ deflate_state *s;
+ ct_data *ltree; /* literal tree */
+ ct_data *dtree; /* distance tree */
+{
+ unsigned dist; /* distance of matched string */
+ int lc; /* match length or unmatched char (if dist == 0) */
+ unsigned lx = 0; /* running index in l_buf */
+ unsigned code; /* the code to send */
+ int extra; /* number of extra bits to send */
+
+ if (s->last_lit != 0) do {
+ dist = s->d_buf[lx];
+ lc = s->l_buf[lx++];
+ if (dist == 0) {
+ send_code(s, lc, ltree); /* send a literal byte */
+ Tracecv(isgraph(lc), (stderr," '%c' ", lc));
+ } else {
+ /* Here, lc is the match length - MIN_MATCH */
+ code = _length_code[lc];
+ send_code(s, code+LITERALS+1, ltree); /* send the length code */
+ extra = extra_lbits[code];
+ if (extra != 0) {
+ lc -= base_length[code];
+ send_bits(s, lc, extra); /* send the extra length bits */
+ }
+ dist--; /* dist is now the match distance - 1 */
+ code = d_code(dist);
+ Assert (code < D_CODES, "bad d_code");
+
+ send_code(s, code, dtree); /* send the distance code */
+ extra = extra_dbits[code];
+ if (extra != 0) {
+ dist -= base_dist[code];
+ send_bits(s, dist, extra); /* send the extra distance bits */
+ }
+ } /* literal or match pair ? */
+
+ /* Check that the overlay between pending_buf and d_buf+l_buf is ok: */
+ Assert((uInt)(s->pending) < s->lit_bufsize + 2*lx,
+ "pendingBuf overflow");
+
+ } while (lx < s->last_lit);
+
+ send_code(s, END_BLOCK, ltree);
+ s->last_eob_len = ltree[END_BLOCK].Len;
+}
+
+/* ===========================================================================
+ * Check if the data type is TEXT or BINARY, using the following algorithm:
+ * - TEXT if the two conditions below are satisfied:
+ * a) There are no non-portable control characters belonging to the
+ * "black list" (0..6, 14..25, 28..31).
+ * b) There is at least one printable character belonging to the
+ * "white list" (9 {TAB}, 10 {LF}, 13 {CR}, 32..255).
+ * - BINARY otherwise.
+ * - The following partially-portable control characters form a
+ * "gray list" that is ignored in this detection algorithm:
+ * (7 {BEL}, 8 {BS}, 11 {VT}, 12 {FF}, 26 {SUB}, 27 {ESC}).
+ * IN assertion: the fields Freq of dyn_ltree are set.
+ */
+local int detect_data_type(s)
+ deflate_state *s;
+{
+ /* black_mask is the bit mask of black-listed bytes
+ * set bits 0..6, 14..25, and 28..31
+ * 0xf3ffc07f = binary 11110011111111111100000001111111
+ */
+ unsigned long black_mask = 0xf3ffc07fUL;
+ int n;
+
+ /* Check for non-textual ("black-listed") bytes. */
+ for (n = 0; n <= 31; n++, black_mask >>= 1)
+ if ((black_mask & 1) && (s->dyn_ltree[n].Freq != 0))
+ return Z_BINARY;
+
+ /* Check for textual ("white-listed") bytes. */
+ if (s->dyn_ltree[9].Freq != 0 || s->dyn_ltree[10].Freq != 0
+ || s->dyn_ltree[13].Freq != 0)
+ return Z_TEXT;
+ for (n = 32; n < LITERALS; n++)
+ if (s->dyn_ltree[n].Freq != 0)
+ return Z_TEXT;
+
+ /* There are no "black-listed" or "white-listed" bytes:
+ * this stream either is empty or has tolerated ("gray-listed") bytes only.
+ */
+ return Z_BINARY;
+}
+
+/* ===========================================================================
+ * Reverse the first len bits of a code, using straightforward code (a faster
+ * method would use a table)
+ * IN assertion: 1 <= len <= 15
+ */
+local unsigned bi_reverse(code, len)
+ unsigned code; /* the value to invert */
+ int len; /* its bit length */
+{
+ register unsigned res = 0;
+ do {
+ res |= code & 1;
+ code >>= 1, res <<= 1;
+ } while (--len > 0);
+ return res >> 1;
+}
+
+/* ===========================================================================
+ * Flush the bit buffer, keeping at most 7 bits in it.
+ */
+local void bi_flush(s)
+ deflate_state *s;
+{
+ if (s->bi_valid == 16) {
+ put_short(s, s->bi_buf);
+ s->bi_buf = 0;
+ s->bi_valid = 0;
+ } else if (s->bi_valid >= 8) {
+ put_byte(s, (Byte)s->bi_buf);
+ s->bi_buf >>= 8;
+ s->bi_valid -= 8;
+ }
+}
+
+/* ===========================================================================
+ * Flush the bit buffer and align the output on a byte boundary
+ */
+local void bi_windup(s)
+ deflate_state *s;
+{
+ if (s->bi_valid > 8) {
+ put_short(s, s->bi_buf);
+ } else if (s->bi_valid > 0) {
+ put_byte(s, (Byte)s->bi_buf);
+ }
+ s->bi_buf = 0;
+ s->bi_valid = 0;
+#ifdef DEBUG
+ s->bits_sent = (s->bits_sent+7) & ~7;
+#endif
+}
+
+/* ===========================================================================
+ * Copy a stored block, storing first the length and its
+ * one's complement if requested.
+ */
+local void copy_block(s, buf, len, header)
+ deflate_state *s;
+ charf *buf; /* the input data */
+ unsigned len; /* its length */
+ int header; /* true if block header must be written */
+{
+ bi_windup(s); /* align on byte boundary */
+ s->last_eob_len = 8; /* enough lookahead for inflate */
+
+ if (header) {
+ put_short(s, (ush)len);
+ put_short(s, (ush)~len);
+#ifdef DEBUG
+ s->bits_sent += 2*16;
+#endif
+ }
+#ifdef DEBUG
+ s->bits_sent += (ulg)len<<3;
+#endif
+ while (len--) {
+ put_byte(s, *buf++);
+ }
+}
diff --git a/src/plugins/cfitsio/trees.h b/src/plugins/cfitsio/trees.h
new file mode 100644
index 0000000..d35639d
--- /dev/null
+++ b/src/plugins/cfitsio/trees.h
@@ -0,0 +1,128 @@
+/* header created automatically with -DGEN_TREES_H */
+
+local const ct_data static_ltree[L_CODES+2] = {
+{{ 12},{ 8}}, {{140},{ 8}}, {{ 76},{ 8}}, {{204},{ 8}}, {{ 44},{ 8}},
+{{172},{ 8}}, {{108},{ 8}}, {{236},{ 8}}, {{ 28},{ 8}}, {{156},{ 8}},
+{{ 92},{ 8}}, {{220},{ 8}}, {{ 60},{ 8}}, {{188},{ 8}}, {{124},{ 8}},
+{{252},{ 8}}, {{ 2},{ 8}}, {{130},{ 8}}, {{ 66},{ 8}}, {{194},{ 8}},
+{{ 34},{ 8}}, {{162},{ 8}}, {{ 98},{ 8}}, {{226},{ 8}}, {{ 18},{ 8}},
+{{146},{ 8}}, {{ 82},{ 8}}, {{210},{ 8}}, {{ 50},{ 8}}, {{178},{ 8}},
+{{114},{ 8}}, {{242},{ 8}}, {{ 10},{ 8}}, {{138},{ 8}}, {{ 74},{ 8}},
+{{202},{ 8}}, {{ 42},{ 8}}, {{170},{ 8}}, {{106},{ 8}}, {{234},{ 8}},
+{{ 26},{ 8}}, {{154},{ 8}}, {{ 90},{ 8}}, {{218},{ 8}}, {{ 58},{ 8}},
+{{186},{ 8}}, {{122},{ 8}}, {{250},{ 8}}, {{ 6},{ 8}}, {{134},{ 8}},
+{{ 70},{ 8}}, {{198},{ 8}}, {{ 38},{ 8}}, {{166},{ 8}}, {{102},{ 8}},
+{{230},{ 8}}, {{ 22},{ 8}}, {{150},{ 8}}, {{ 86},{ 8}}, {{214},{ 8}},
+{{ 54},{ 8}}, {{182},{ 8}}, {{118},{ 8}}, {{246},{ 8}}, {{ 14},{ 8}},
+{{142},{ 8}}, {{ 78},{ 8}}, {{206},{ 8}}, {{ 46},{ 8}}, {{174},{ 8}},
+{{110},{ 8}}, {{238},{ 8}}, {{ 30},{ 8}}, {{158},{ 8}}, {{ 94},{ 8}},
+{{222},{ 8}}, {{ 62},{ 8}}, {{190},{ 8}}, {{126},{ 8}}, {{254},{ 8}},
+{{ 1},{ 8}}, {{129},{ 8}}, {{ 65},{ 8}}, {{193},{ 8}}, {{ 33},{ 8}},
+{{161},{ 8}}, {{ 97},{ 8}}, {{225},{ 8}}, {{ 17},{ 8}}, {{145},{ 8}},
+{{ 81},{ 8}}, {{209},{ 8}}, {{ 49},{ 8}}, {{177},{ 8}}, {{113},{ 8}},
+{{241},{ 8}}, {{ 9},{ 8}}, {{137},{ 8}}, {{ 73},{ 8}}, {{201},{ 8}},
+{{ 41},{ 8}}, {{169},{ 8}}, {{105},{ 8}}, {{233},{ 8}}, {{ 25},{ 8}},
+{{153},{ 8}}, {{ 89},{ 8}}, {{217},{ 8}}, {{ 57},{ 8}}, {{185},{ 8}},
+{{121},{ 8}}, {{249},{ 8}}, {{ 5},{ 8}}, {{133},{ 8}}, {{ 69},{ 8}},
+{{197},{ 8}}, {{ 37},{ 8}}, {{165},{ 8}}, {{101},{ 8}}, {{229},{ 8}},
+{{ 21},{ 8}}, {{149},{ 8}}, {{ 85},{ 8}}, {{213},{ 8}}, {{ 53},{ 8}},
+{{181},{ 8}}, {{117},{ 8}}, {{245},{ 8}}, {{ 13},{ 8}}, {{141},{ 8}},
+{{ 77},{ 8}}, {{205},{ 8}}, {{ 45},{ 8}}, {{173},{ 8}}, {{109},{ 8}},
+{{237},{ 8}}, {{ 29},{ 8}}, {{157},{ 8}}, {{ 93},{ 8}}, {{221},{ 8}},
+{{ 61},{ 8}}, {{189},{ 8}}, {{125},{ 8}}, {{253},{ 8}}, {{ 19},{ 9}},
+{{275},{ 9}}, {{147},{ 9}}, {{403},{ 9}}, {{ 83},{ 9}}, {{339},{ 9}},
+{{211},{ 9}}, {{467},{ 9}}, {{ 51},{ 9}}, {{307},{ 9}}, {{179},{ 9}},
+{{435},{ 9}}, {{115},{ 9}}, {{371},{ 9}}, {{243},{ 9}}, {{499},{ 9}},
+{{ 11},{ 9}}, {{267},{ 9}}, {{139},{ 9}}, {{395},{ 9}}, {{ 75},{ 9}},
+{{331},{ 9}}, {{203},{ 9}}, {{459},{ 9}}, {{ 43},{ 9}}, {{299},{ 9}},
+{{171},{ 9}}, {{427},{ 9}}, {{107},{ 9}}, {{363},{ 9}}, {{235},{ 9}},
+{{491},{ 9}}, {{ 27},{ 9}}, {{283},{ 9}}, {{155},{ 9}}, {{411},{ 9}},
+{{ 91},{ 9}}, {{347},{ 9}}, {{219},{ 9}}, {{475},{ 9}}, {{ 59},{ 9}},
+{{315},{ 9}}, {{187},{ 9}}, {{443},{ 9}}, {{123},{ 9}}, {{379},{ 9}},
+{{251},{ 9}}, {{507},{ 9}}, {{ 7},{ 9}}, {{263},{ 9}}, {{135},{ 9}},
+{{391},{ 9}}, {{ 71},{ 9}}, {{327},{ 9}}, {{199},{ 9}}, {{455},{ 9}},
+{{ 39},{ 9}}, {{295},{ 9}}, {{167},{ 9}}, {{423},{ 9}}, {{103},{ 9}},
+{{359},{ 9}}, {{231},{ 9}}, {{487},{ 9}}, {{ 23},{ 9}}, {{279},{ 9}},
+{{151},{ 9}}, {{407},{ 9}}, {{ 87},{ 9}}, {{343},{ 9}}, {{215},{ 9}},
+{{471},{ 9}}, {{ 55},{ 9}}, {{311},{ 9}}, {{183},{ 9}}, {{439},{ 9}},
+{{119},{ 9}}, {{375},{ 9}}, {{247},{ 9}}, {{503},{ 9}}, {{ 15},{ 9}},
+{{271},{ 9}}, {{143},{ 9}}, {{399},{ 9}}, {{ 79},{ 9}}, {{335},{ 9}},
+{{207},{ 9}}, {{463},{ 9}}, {{ 47},{ 9}}, {{303},{ 9}}, {{175},{ 9}},
+{{431},{ 9}}, {{111},{ 9}}, {{367},{ 9}}, {{239},{ 9}}, {{495},{ 9}},
+{{ 31},{ 9}}, {{287},{ 9}}, {{159},{ 9}}, {{415},{ 9}}, {{ 95},{ 9}},
+{{351},{ 9}}, {{223},{ 9}}, {{479},{ 9}}, {{ 63},{ 9}}, {{319},{ 9}},
+{{191},{ 9}}, {{447},{ 9}}, {{127},{ 9}}, {{383},{ 9}}, {{255},{ 9}},
+{{511},{ 9}}, {{ 0},{ 7}}, {{ 64},{ 7}}, {{ 32},{ 7}}, {{ 96},{ 7}},
+{{ 16},{ 7}}, {{ 80},{ 7}}, {{ 48},{ 7}}, {{112},{ 7}}, {{ 8},{ 7}},
+{{ 72},{ 7}}, {{ 40},{ 7}}, {{104},{ 7}}, {{ 24},{ 7}}, {{ 88},{ 7}},
+{{ 56},{ 7}}, {{120},{ 7}}, {{ 4},{ 7}}, {{ 68},{ 7}}, {{ 36},{ 7}},
+{{100},{ 7}}, {{ 20},{ 7}}, {{ 84},{ 7}}, {{ 52},{ 7}}, {{116},{ 7}},
+{{ 3},{ 8}}, {{131},{ 8}}, {{ 67},{ 8}}, {{195},{ 8}}, {{ 35},{ 8}},
+{{163},{ 8}}, {{ 99},{ 8}}, {{227},{ 8}}
+};
+
+local const ct_data static_dtree[D_CODES] = {
+{{ 0},{ 5}}, {{16},{ 5}}, {{ 8},{ 5}}, {{24},{ 5}}, {{ 4},{ 5}},
+{{20},{ 5}}, {{12},{ 5}}, {{28},{ 5}}, {{ 2},{ 5}}, {{18},{ 5}},
+{{10},{ 5}}, {{26},{ 5}}, {{ 6},{ 5}}, {{22},{ 5}}, {{14},{ 5}},
+{{30},{ 5}}, {{ 1},{ 5}}, {{17},{ 5}}, {{ 9},{ 5}}, {{25},{ 5}},
+{{ 5},{ 5}}, {{21},{ 5}}, {{13},{ 5}}, {{29},{ 5}}, {{ 3},{ 5}},
+{{19},{ 5}}, {{11},{ 5}}, {{27},{ 5}}, {{ 7},{ 5}}, {{23},{ 5}}
+};
+
+const uch ZLIB_INTERNAL _dist_code[DIST_CODE_LEN] = {
+ 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8,
+ 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10,
+10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
+11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
+12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13,
+13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
+14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15,
+15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17,
+18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22,
+23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
+26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
+26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27,
+27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
+27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
+29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
+29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
+29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29
+};
+
+const uch ZLIB_INTERNAL _length_code[MAX_MATCH-MIN_MATCH+1]= {
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12,
+13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16,
+17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19,
+19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
+21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22,
+22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23,
+23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
+25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26,
+26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
+26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
+27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28
+};
+
+local const int base_length[LENGTH_CODES] = {
+0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56,
+64, 80, 96, 112, 128, 160, 192, 224, 0
+};
+
+local const int base_dist[D_CODES] = {
+ 0, 1, 2, 3, 4, 6, 8, 12, 16, 24,
+ 32, 48, 64, 96, 128, 192, 256, 384, 512, 768,
+ 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576
+};
+
diff --git a/src/plugins/cfitsio/uncompr.c b/src/plugins/cfitsio/uncompr.c
new file mode 100644
index 0000000..769f83e
--- /dev/null
+++ b/src/plugins/cfitsio/uncompr.c
@@ -0,0 +1,57 @@
+/* uncompr.c -- decompress a memory buffer
+ * Copyright (C) 1995-2003, 2010 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#define ZLIB_INTERNAL
+#include "zlib.h"
+
+/* ===========================================================================
+ Decompresses the source buffer into the destination buffer. sourceLen is
+ the byte length of the source buffer. Upon entry, destLen is the total
+ size of the destination buffer, which must be large enough to hold the
+ entire uncompressed data. (The size of the uncompressed data must have
+ been saved previously by the compressor and transmitted to the decompressor
+ by some mechanism outside the scope of this compression library.)
+ Upon exit, destLen is the actual size of the compressed buffer.
+
+ uncompress returns Z_OK if success, Z_MEM_ERROR if there was not
+ enough memory, Z_BUF_ERROR if there was not enough room in the output
+ buffer, or Z_DATA_ERROR if the input data was corrupted.
+*/
+int ZEXPORT uncompress (dest, destLen, source, sourceLen)
+ Bytef *dest;
+ uLongf *destLen;
+ const Bytef *source;
+ uLong sourceLen;
+{
+ z_stream stream;
+ int err;
+
+ stream.next_in = (Bytef*)source;
+ stream.avail_in = (uInt)sourceLen;
+ /* Check for source > 64K on 16-bit machine: */
+ if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR;
+
+ stream.next_out = dest;
+ stream.avail_out = (uInt)*destLen;
+ if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR;
+
+ stream.zalloc = (alloc_func)0;
+ stream.zfree = (free_func)0;
+
+ err = inflateInit(&stream);
+ if (err != Z_OK) return err;
+
+ err = inflate(&stream, Z_FINISH);
+ if (err != Z_STREAM_END) {
+ inflateEnd(&stream);
+ if (err == Z_NEED_DICT || (err == Z_BUF_ERROR && stream.avail_in == 0))
+ return Z_DATA_ERROR;
+ return err;
+ }
+ *destLen = stream.total_out;
+
+ err = inflateEnd(&stream);
+ return err;
+}
diff --git a/src/plugins/cfitsio/wcssub.c b/src/plugins/cfitsio/wcssub.c
new file mode 100644
index 0000000..afb8e5c
--- /dev/null
+++ b/src/plugins/cfitsio/wcssub.c
@@ -0,0 +1,1043 @@
+#include <stdlib.h>
+#include <math.h>
+#include <string.h>
+#include "fitsio2.h"
+
+/*--------------------------------------------------------------------------*/
+int fits_read_wcstab(
+ fitsfile *fptr, /* I - FITS file pointer */
+ int nwtb, /* Number of arrays to be read from the binary table(s) */
+ wtbarr *wtb, /* Address of the first element of an array of wtbarr
+ typedefs. This wtbarr typedef is defined below to
+ match the wtbarr struct defined in WCSLIB. An array
+ of such structs returned by the WCSLIB function
+ wcstab(). */
+ int *status)
+
+/*
+* Author: Mark Calabretta, Australia Telescope National Facility
+* http://www.atnf.csiro.au/~mcalabre/index.html
+*
+* fits_read_wcstab() extracts arrays from a binary table required in
+* constructing -TAB coordinates. This helper routine is intended for
+* use by routines in the WCSLIB library when dealing with the -TAB table
+* look up WCS convention.
+*/
+
+{
+ int anynul, colnum, hdunum, iwtb, m, naxis, nostat;
+ long *naxes = 0, nelem;
+ wtbarr *wtbp;
+
+
+ if (*status) return *status;
+
+ if (fptr == 0) {
+ return (*status = NULL_INPUT_PTR);
+ }
+
+ if (nwtb == 0) return 0;
+
+ /* Zero the array pointers. */
+ wtbp = wtb;
+ for (iwtb = 0; iwtb < nwtb; iwtb++, wtbp++) {
+ *wtbp->arrayp = 0x0;
+ }
+
+ /* Save HDU number so that we can move back to it later. */
+ fits_get_hdu_num(fptr, &hdunum);
+
+ wtbp = wtb;
+ for (iwtb = 0; iwtb < nwtb; iwtb++, wtbp++) {
+ /* Move to the required binary table extension. */
+ if (fits_movnam_hdu(fptr, BINARY_TBL, (char *)(wtbp->extnam),
+ wtbp->extver, status)) {
+ goto cleanup;
+ }
+
+ /* Locate the table column. */
+ if (fits_get_colnum(fptr, CASEINSEN, (char *)(wtbp->ttype), &colnum,
+ status)) {
+ goto cleanup;
+ }
+
+ /* Get the array dimensions and check for consistency. */
+ if (wtbp->ndim < 1) {
+ *status = NEG_AXIS;
+ goto cleanup;
+ }
+
+ if (!(naxes = calloc(wtbp->ndim, sizeof(long)))) {
+ *status = MEMORY_ALLOCATION;
+ goto cleanup;
+ }
+
+ if (fits_read_tdim(fptr, colnum, wtbp->ndim, &naxis, naxes, status)) {
+ goto cleanup;
+ }
+
+ if (naxis != wtbp->ndim) {
+ if (wtbp->kind == 'c' && wtbp->ndim == 2) {
+ /* Allow TDIMn to be omitted for degenerate coordinate arrays. */
+ naxis = 2;
+ naxes[1] = naxes[0];
+ naxes[0] = 1;
+ } else {
+ *status = BAD_TDIM;
+ goto cleanup;
+ }
+ }
+
+ if (wtbp->kind == 'c') {
+ /* Coordinate array; calculate the array size. */
+ nelem = naxes[0];
+ for (m = 0; m < naxis-1; m++) {
+ *(wtbp->dimlen + m) = naxes[m+1];
+ nelem *= naxes[m+1];
+ }
+ } else {
+ /* Index vector; check length. */
+ if ((nelem = naxes[0]) != *(wtbp->dimlen)) {
+ /* N.B. coordinate array precedes the index vectors. */
+ *status = BAD_TDIM;
+ goto cleanup;
+ }
+ }
+
+ free(naxes);
+ naxes = 0;
+
+ /* Allocate memory for the array. */
+ if (!(*wtbp->arrayp = calloc((size_t)nelem, sizeof(double)))) {
+ *status = MEMORY_ALLOCATION;
+ goto cleanup;
+ }
+
+ /* Read the array from the table. */
+ if (fits_read_col_dbl(fptr, colnum, wtbp->row, 1L, nelem, 0.0,
+ *wtbp->arrayp, &anynul, status)) {
+ goto cleanup;
+ }
+ }
+
+cleanup:
+ /* Move back to the starting HDU. */
+ nostat = 0;
+ fits_movabs_hdu(fptr, hdunum, 0, &nostat);
+
+ /* Release allocated memory. */
+ if (naxes) free(naxes);
+ if (*status) {
+ wtbp = wtb;
+ for (iwtb = 0; iwtb < nwtb; iwtb++, wtbp++) {
+ if (*wtbp->arrayp) free(*wtbp->arrayp);
+ }
+ }
+
+ return *status;
+}
+/*--------------------------------------------------------------------------*/
+int ffgiwcs(fitsfile *fptr, /* I - FITS file pointer */
+ char **header, /* O - pointer to the WCS related keywords */
+ int *status) /* IO - error status */
+/*
+ int fits_get_image_wcs_keys
+ return a string containing all the image WCS header keywords.
+ This string is then used as input to the wcsinit WCSlib routine.
+
+ THIS ROUTINE IS DEPRECATED. USE fits_hdr2str INSTEAD
+*/
+{
+ int hdutype;
+
+ if (*status > 0)
+ return(*status);
+
+ fits_get_hdu_type(fptr, &hdutype, status);
+ if (hdutype != IMAGE_HDU)
+ {
+ ffpmsg(
+ "Error in ffgiwcs. This HDU is not an image. Can't read WCS keywords");
+ return(*status = NOT_IMAGE);
+ }
+
+ /* read header keywords into a long string of chars */
+ if (ffh2st(fptr, header, status) > 0)
+ {
+ ffpmsg("error creating string of image WCS keywords (ffgiwcs)");
+ return(*status);
+ }
+
+ return(*status);
+}
+
+/*--------------------------------------------------------------------------*/
+int ffgics(fitsfile *fptr, /* I - FITS file pointer */
+ double *xrval, /* O - X reference value */
+ double *yrval, /* O - Y reference value */
+ double *xrpix, /* O - X reference pixel */
+ double *yrpix, /* O - Y reference pixel */
+ double *xinc, /* O - X increment per pixel */
+ double *yinc, /* O - Y increment per pixel */
+ double *rot, /* O - rotation angle (degrees) */
+ char *type, /* O - type of projection ('-tan') */
+ int *status) /* IO - error status */
+/*
+ read the values of the celestial coordinate system keywords.
+ These values may be used as input to the subroutines that
+ calculate celestial coordinates. (ffxypx, ffwldp)
+
+ Modified in Nov 1999 to convert the CD matrix keywords back
+ to the old CDELTn form, and to swap the axes if the dec-like
+ axis is given first, and to assume default values if any of the
+ keywords are not present.
+*/
+{
+ int tstat = 0, cd_exists = 0, pc_exists = 0;
+ char ctype[FLEN_VALUE];
+ double cd11 = 0.0, cd21 = 0.0, cd22 = 0.0, cd12 = 0.0;
+ double pc11 = 1.0, pc21 = 0.0, pc22 = 1.0, pc12 = 0.0;
+ double pi = 3.1415926535897932;
+ double phia, phib, temp;
+ double toler = .0002; /* tolerance for angles to agree (radians) */
+ /* (= approximately 0.01 degrees) */
+
+ if (*status > 0)
+ return(*status);
+
+ tstat = 0;
+ if (ffgkyd(fptr, "CRVAL1", xrval, NULL, &tstat))
+ *xrval = 0.;
+
+ tstat = 0;
+ if (ffgkyd(fptr, "CRVAL2", yrval, NULL, &tstat))
+ *yrval = 0.;
+
+ tstat = 0;
+ if (ffgkyd(fptr, "CRPIX1", xrpix, NULL, &tstat))
+ *xrpix = 0.;
+
+ tstat = 0;
+ if (ffgkyd(fptr, "CRPIX2", yrpix, NULL, &tstat))
+ *yrpix = 0.;
+
+ /* look for CDELTn first, then CDi_j keywords */
+ tstat = 0;
+ if (ffgkyd(fptr, "CDELT1", xinc, NULL, &tstat))
+ {
+ /* CASE 1: no CDELTn keyword, so look for the CD matrix */
+ tstat = 0;
+ if (ffgkyd(fptr, "CD1_1", &cd11, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ cd_exists = 1; /* found at least 1 CD_ keyword */
+
+ if (ffgkyd(fptr, "CD2_1", &cd21, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ cd_exists = 1; /* found at least 1 CD_ keyword */
+
+ if (ffgkyd(fptr, "CD1_2", &cd12, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ cd_exists = 1; /* found at least 1 CD_ keyword */
+
+ if (ffgkyd(fptr, "CD2_2", &cd22, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ cd_exists = 1; /* found at least 1 CD_ keyword */
+
+ if (cd_exists) /* convert CDi_j back to CDELTn */
+ {
+ /* there are 2 ways to compute the angle: */
+ phia = atan2( cd21, cd11);
+ phib = atan2(-cd12, cd22);
+
+ /* ensure that phia <= phib */
+ temp = minvalue(phia, phib);
+ phib = maxvalue(phia, phib);
+ phia = temp;
+
+ /* there is a possible 180 degree ambiguity in the angles */
+ /* so add 180 degress to the smaller value if the values */
+ /* differ by more than 90 degrees = pi/2 radians. */
+ /* (Later, we may decide to take the other solution by */
+ /* subtracting 180 degrees from the larger value). */
+
+ if ((phib - phia) > (pi / 2.))
+ phia += pi;
+
+ if (fabs(phia - phib) > toler)
+ {
+ /* angles don't agree, so looks like there is some skewness */
+ /* between the axes. Return with an error to be safe. */
+ *status = APPROX_WCS_KEY;
+ }
+
+ phia = (phia + phib) /2.; /* use the average of the 2 values */
+ *xinc = cd11 / cos(phia);
+ *yinc = cd22 / cos(phia);
+ *rot = phia * 180. / pi;
+
+ /* common usage is to have a positive yinc value. If it is */
+ /* negative, then subtract 180 degrees from rot and negate */
+ /* both xinc and yinc. */
+
+ if (*yinc < 0)
+ {
+ *xinc = -(*xinc);
+ *yinc = -(*yinc);
+ *rot = *rot - 180.;
+ }
+ }
+ else /* no CD matrix keywords either */
+ {
+ *xinc = 1.;
+
+ /* there was no CDELT1 keyword, but check for CDELT2 just in case */
+ tstat = 0;
+ if (ffgkyd(fptr, "CDELT2", yinc, NULL, &tstat))
+ *yinc = 1.;
+
+ tstat = 0;
+ if (ffgkyd(fptr, "CROTA2", rot, NULL, &tstat))
+ *rot=0.;
+ }
+ }
+ else /* Case 2: CDELTn + optional PC matrix */
+ {
+ if (ffgkyd(fptr, "CDELT2", yinc, NULL, &tstat))
+ *yinc = 1.;
+
+ tstat = 0;
+ if (ffgkyd(fptr, "CROTA2", rot, NULL, &tstat))
+ {
+ *rot=0.;
+
+ /* no CROTA2 keyword, so look for the PC matrix */
+ tstat = 0;
+ if (ffgkyd(fptr, "PC1_1", &pc11, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ pc_exists = 1; /* found at least 1 PC_ keyword */
+
+ if (ffgkyd(fptr, "PC2_1", &pc21, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ pc_exists = 1; /* found at least 1 PC_ keyword */
+
+ if (ffgkyd(fptr, "PC1_2", &pc12, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ pc_exists = 1; /* found at least 1 PC_ keyword */
+
+ if (ffgkyd(fptr, "PC2_2", &pc22, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ pc_exists = 1; /* found at least 1 PC_ keyword */
+
+ if (pc_exists) /* convert PCi_j back to CDELTn */
+ {
+ /* there are 2 ways to compute the angle: */
+ phia = atan2( pc21, pc11);
+ phib = atan2(-pc12, pc22);
+
+ /* ensure that phia <= phib */
+ temp = minvalue(phia, phib);
+ phib = maxvalue(phia, phib);
+ phia = temp;
+
+ /* there is a possible 180 degree ambiguity in the angles */
+ /* so add 180 degress to the smaller value if the values */
+ /* differ by more than 90 degrees = pi/2 radians. */
+ /* (Later, we may decide to take the other solution by */
+ /* subtracting 180 degrees from the larger value). */
+
+ if ((phib - phia) > (pi / 2.))
+ phia += pi;
+
+ if (fabs(phia - phib) > toler)
+ {
+ /* angles don't agree, so looks like there is some skewness */
+ /* between the axes. Return with an error to be safe. */
+ *status = APPROX_WCS_KEY;
+ }
+
+ phia = (phia + phib) /2.; /* use the average of the 2 values */
+ *rot = phia * 180. / pi;
+ }
+ }
+ }
+
+ /* get the type of projection, if any */
+ tstat = 0;
+ if (ffgkys(fptr, "CTYPE1", ctype, NULL, &tstat))
+ type[0] = '\0';
+ else
+ {
+ /* copy the projection type string */
+ strncpy(type, &ctype[4], 4);
+ type[4] = '\0';
+
+ /* check if RA and DEC are inverted */
+ if (!strncmp(ctype, "DEC-", 4) || !strncmp(ctype+1, "LAT", 3))
+ {
+ /* the latitudinal axis is given first, so swap them */
+
+/*
+ this case was removed on 12/9. Apparently not correct.
+
+ if ((*xinc / *yinc) < 0. )
+ *rot = -90. - (*rot);
+ else
+*/
+ *rot = 90. - (*rot);
+
+ /* Empirical tests with ds9 show the y-axis sign must be negated */
+ /* and the xinc and yinc values must NOT be swapped. */
+ *yinc = -(*yinc);
+
+ temp = *xrval;
+ *xrval = *yrval;
+ *yrval = temp;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgicsa(fitsfile *fptr, /* I - FITS file pointer */
+ char version, /* I - character code of desired version *(/
+ /* A - Z or blank */
+ double *xrval, /* O - X reference value */
+ double *yrval, /* O - Y reference value */
+ double *xrpix, /* O - X reference pixel */
+ double *yrpix, /* O - Y reference pixel */
+ double *xinc, /* O - X increment per pixel */
+ double *yinc, /* O - Y increment per pixel */
+ double *rot, /* O - rotation angle (degrees) */
+ char *type, /* O - type of projection ('-tan') */
+ int *status) /* IO - error status */
+/*
+ read the values of the celestial coordinate system keywords.
+ These values may be used as input to the subroutines that
+ calculate celestial coordinates. (ffxypx, ffwldp)
+
+ Modified in Nov 1999 to convert the CD matrix keywords back
+ to the old CDELTn form, and to swap the axes if the dec-like
+ axis is given first, and to assume default values if any of the
+ keywords are not present.
+*/
+{
+ int tstat = 0, cd_exists = 0, pc_exists = 0;
+ char ctype[FLEN_VALUE], keyname[FLEN_VALUE], alt[2];
+ double cd11 = 0.0, cd21 = 0.0, cd22 = 0.0, cd12 = 0.0;
+ double pc11 = 1.0, pc21 = 0.0, pc22 = 1.0, pc12 = 0.0;
+ double pi = 3.1415926535897932;
+ double phia, phib, temp;
+ double toler = .0002; /* tolerance for angles to agree (radians) */
+ /* (= approximately 0.01 degrees) */
+
+ if (*status > 0)
+ return(*status);
+
+ if (version == ' ') {
+ ffgics(fptr, xrval, yrval, xrpix, yrpix, xinc, yinc, rot, type, status);
+ return (*status);
+ }
+
+ if (version > 'Z' || version < 'A') {
+ ffpmsg("ffgicsa: illegal WCS version code (must be A - Z or blank)");
+ return(*status = WCS_ERROR);
+ }
+
+ alt[0] = version;
+ alt[1] = '\0';
+
+ tstat = 0;
+ strcpy(keyname, "CRVAL1");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, xrval, NULL, &tstat))
+ *xrval = 0.;
+
+ tstat = 0;
+ strcpy(keyname, "CRVAL2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, yrval, NULL, &tstat))
+ *yrval = 0.;
+
+ tstat = 0;
+ strcpy(keyname, "CRPIX1");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, xrpix, NULL, &tstat))
+ *xrpix = 0.;
+
+ tstat = 0;
+ strcpy(keyname, "CRPIX2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, yrpix, NULL, &tstat))
+ *yrpix = 0.;
+
+ /* look for CDELTn first, then CDi_j keywords */
+ tstat = 0;
+ strcpy(keyname, "CDELT1");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, xinc, NULL, &tstat))
+ {
+ /* CASE 1: no CDELTn keyword, so look for the CD matrix */
+ tstat = 0;
+ strcpy(keyname, "CD1_1");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, &cd11, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ cd_exists = 1; /* found at least 1 CD_ keyword */
+
+ strcpy(keyname, "CD2_1");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, &cd21, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ cd_exists = 1; /* found at least 1 CD_ keyword */
+
+ strcpy(keyname, "CD1_2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, &cd12, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ cd_exists = 1; /* found at least 1 CD_ keyword */
+
+ strcpy(keyname, "CD2_2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, &cd22, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ cd_exists = 1; /* found at least 1 CD_ keyword */
+
+ if (cd_exists) /* convert CDi_j back to CDELTn */
+ {
+ /* there are 2 ways to compute the angle: */
+ phia = atan2( cd21, cd11);
+ phib = atan2(-cd12, cd22);
+
+ /* ensure that phia <= phib */
+ temp = minvalue(phia, phib);
+ phib = maxvalue(phia, phib);
+ phia = temp;
+
+ /* there is a possible 180 degree ambiguity in the angles */
+ /* so add 180 degress to the smaller value if the values */
+ /* differ by more than 90 degrees = pi/2 radians. */
+ /* (Later, we may decide to take the other solution by */
+ /* subtracting 180 degrees from the larger value). */
+
+ if ((phib - phia) > (pi / 2.))
+ phia += pi;
+
+ if (fabs(phia - phib) > toler)
+ {
+ /* angles don't agree, so looks like there is some skewness */
+ /* between the axes. Return with an error to be safe. */
+ *status = APPROX_WCS_KEY;
+ }
+
+ phia = (phia + phib) /2.; /* use the average of the 2 values */
+ *xinc = cd11 / cos(phia);
+ *yinc = cd22 / cos(phia);
+ *rot = phia * 180. / pi;
+
+ /* common usage is to have a positive yinc value. If it is */
+ /* negative, then subtract 180 degrees from rot and negate */
+ /* both xinc and yinc. */
+
+ if (*yinc < 0)
+ {
+ *xinc = -(*xinc);
+ *yinc = -(*yinc);
+ *rot = *rot - 180.;
+ }
+ }
+ else /* no CD matrix keywords either */
+ {
+ *xinc = 1.;
+
+ /* there was no CDELT1 keyword, but check for CDELT2 just in case */
+ tstat = 0;
+ strcpy(keyname, "CDELT2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, yinc, NULL, &tstat))
+ *yinc = 1.;
+
+ tstat = 0;
+ strcpy(keyname, "CROTA2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, rot, NULL, &tstat))
+ *rot=0.;
+ }
+ }
+ else /* Case 2: CDELTn + optional PC matrix */
+ {
+ strcpy(keyname, "CDELT2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, yinc, NULL, &tstat))
+ *yinc = 1.;
+
+ tstat = 0;
+ strcpy(keyname, "CROTA2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, rot, NULL, &tstat))
+ {
+ *rot=0.;
+
+ /* no CROTA2 keyword, so look for the PC matrix */
+ tstat = 0;
+ strcpy(keyname, "PC1_1");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, &pc11, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ pc_exists = 1; /* found at least 1 PC_ keyword */
+
+ strcpy(keyname, "PC2_1");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, &pc21, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ pc_exists = 1; /* found at least 1 PC_ keyword */
+
+ strcpy(keyname, "PC1_2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, &pc12, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ pc_exists = 1; /* found at least 1 PC_ keyword */
+
+ strcpy(keyname, "PC2_2");
+ strcat(keyname, alt);
+ if (ffgkyd(fptr, keyname, &pc22, NULL, &tstat))
+ tstat = 0; /* reset keyword not found error */
+ else
+ pc_exists = 1; /* found at least 1 PC_ keyword */
+
+ if (pc_exists) /* convert PCi_j back to CDELTn */
+ {
+ /* there are 2 ways to compute the angle: */
+ phia = atan2( pc21, pc11);
+ phib = atan2(-pc12, pc22);
+
+ /* ensure that phia <= phib */
+ temp = minvalue(phia, phib);
+ phib = maxvalue(phia, phib);
+ phia = temp;
+
+ /* there is a possible 180 degree ambiguity in the angles */
+ /* so add 180 degress to the smaller value if the values */
+ /* differ by more than 90 degrees = pi/2 radians. */
+ /* (Later, we may decide to take the other solution by */
+ /* subtracting 180 degrees from the larger value). */
+
+ if ((phib - phia) > (pi / 2.))
+ phia += pi;
+
+ if (fabs(phia - phib) > toler)
+ {
+ /* angles don't agree, so looks like there is some skewness */
+ /* between the axes. Return with an error to be safe. */
+ *status = APPROX_WCS_KEY;
+ }
+
+ phia = (phia + phib) /2.; /* use the average of the 2 values */
+ *rot = phia * 180. / pi;
+ }
+ }
+ }
+
+ /* get the type of projection, if any */
+ tstat = 0;
+ strcpy(keyname, "CTYPE1");
+ strcat(keyname, alt);
+ if (ffgkys(fptr, keyname, ctype, NULL, &tstat))
+ type[0] = '\0';
+ else
+ {
+ /* copy the projection type string */
+ strncpy(type, &ctype[4], 4);
+ type[4] = '\0';
+
+ /* check if RA and DEC are inverted */
+ if (!strncmp(ctype, "DEC-", 4) || !strncmp(ctype+1, "LAT", 3))
+ {
+ /* the latitudinal axis is given first, so swap them */
+
+ *rot = 90. - (*rot);
+
+ /* Empirical tests with ds9 show the y-axis sign must be negated */
+ /* and the xinc and yinc values must NOT be swapped. */
+ *yinc = -(*yinc);
+
+ temp = *xrval;
+ *xrval = *yrval;
+ *yrval = temp;
+ }
+ }
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtcs(fitsfile *fptr, /* I - FITS file pointer */
+ int xcol, /* I - column containing the RA coordinate */
+ int ycol, /* I - column containing the DEC coordinate */
+ double *xrval, /* O - X reference value */
+ double *yrval, /* O - Y reference value */
+ double *xrpix, /* O - X reference pixel */
+ double *yrpix, /* O - Y reference pixel */
+ double *xinc, /* O - X increment per pixel */
+ double *yinc, /* O - Y increment per pixel */
+ double *rot, /* O - rotation angle (degrees) */
+ char *type, /* O - type of projection ('-sin') */
+ int *status) /* IO - error status */
+/*
+ read the values of the celestial coordinate system keywords
+ from a FITS table where the X and Y or RA and DEC coordinates
+ are stored in separate column. Do this by converting the
+ table to a temporary FITS image, then reading the keywords
+ from the image file.
+ These values may be used as input to the subroutines that
+ calculate celestial coordinates. (ffxypx, ffwldp)
+*/
+{
+ int colnum[2];
+ long naxes[2];
+ fitsfile *tptr;
+
+ if (*status > 0)
+ return(*status);
+
+ colnum[0] = xcol;
+ colnum[1] = ycol;
+ naxes[0] = 10;
+ naxes[1] = 10;
+
+ /* create temporary FITS file, in memory */
+ ffinit(&tptr, "mem://", status);
+
+ /* create a temporary image; the datatype and size are not important */
+ ffcrim(tptr, 32, 2, naxes, status);
+
+ /* now copy the relevant keywords from the table to the image */
+ fits_copy_pixlist2image(fptr, tptr, 9, 2, colnum, status);
+
+ /* write default WCS keywords, if they are not present */
+ fits_write_keys_histo(fptr, tptr, 2, colnum, status);
+
+ if (*status > 0)
+ return(*status);
+
+ /* read the WCS keyword values from the temporary image */
+ ffgics(tptr, xrval, yrval, xrpix, yrpix, xinc, yinc, rot, type, status);
+
+ if (*status > 0)
+ {
+ ffpmsg
+ ("ffgtcs could not find all the celestial coordinate keywords");
+ return(*status = NO_WCS_KEY);
+ }
+
+ /* delete the temporary file */
+ fits_delete_file(tptr, status);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffgtwcs(fitsfile *fptr, /* I - FITS file pointer */
+ int xcol, /* I - column number for the X column */
+ int ycol, /* I - column number for the Y column */
+ char **header, /* O - string of all the WCS keywords */
+ int *status) /* IO - error status */
+/*
+ int fits_get_table_wcs_keys
+ Return string containing all the WCS keywords appropriate for the
+ pair of X and Y columns containing the coordinate
+ of each event in an event list table. This string may then be passed
+ to Doug Mink's WCS library wcsinit routine, to create and initialize the
+ WCS structure. The calling routine must free the header character string
+ when it is no longer needed.
+
+ THIS ROUTINE IS DEPRECATED. USE fits_hdr2str INSTEAD
+*/
+{
+ int hdutype, ncols, tstatus, length;
+ int naxis1 = 1, naxis2 = 1;
+ long tlmin, tlmax;
+ char keyname[FLEN_KEYWORD];
+ char valstring[FLEN_VALUE];
+ char comm[2];
+ char *cptr;
+ /* construct a string of 80 blanks, for adding fill to the keywords */
+ /* 12345678901234567890123456789012345678901234567890123456789012345678901234567890 */
+ char blanks[] = " ";
+
+ if (*status > 0)
+ return(*status);
+
+ fits_get_hdu_type(fptr, &hdutype, status);
+ if (hdutype == IMAGE_HDU)
+ {
+ ffpmsg("Can't read table WSC keywords. This HDU is not a table");
+ return(*status = NOT_TABLE);
+ }
+
+ fits_get_num_cols(fptr, &ncols, status);
+
+ if (xcol < 1 || xcol > ncols)
+ {
+ ffpmsg("illegal X axis column number in fftwcs");
+ return(*status = BAD_COL_NUM);
+ }
+
+ if (ycol < 1 || ycol > ncols)
+ {
+ ffpmsg("illegal Y axis column number in fftwcs");
+ return(*status = BAD_COL_NUM);
+ }
+
+ /* allocate character string for all the WCS keywords */
+ *header = calloc(1, 2401); /* room for up to 30 keywords */
+ if (*header == 0)
+ {
+ ffpmsg("error allocating memory for WCS header keywords (fftwcs)");
+ return(*status = MEMORY_ALLOCATION);
+ }
+
+ cptr = *header;
+ comm[0] = '\0';
+
+ tstatus = 0;
+ ffkeyn("TLMIN",xcol,keyname,status);
+ ffgkyj(fptr,keyname, &tlmin,NULL,&tstatus);
+
+ if (!tstatus)
+ {
+ ffkeyn("TLMAX",xcol,keyname,status);
+ ffgkyj(fptr,keyname, &tlmax,NULL,&tstatus);
+ }
+
+ if (!tstatus)
+ {
+ naxis1 = tlmax - tlmin + 1;
+ }
+
+ tstatus = 0;
+ ffkeyn("TLMIN",ycol,keyname,status);
+ ffgkyj(fptr,keyname, &tlmin,NULL,&tstatus);
+
+ if (!tstatus)
+ {
+ ffkeyn("TLMAX",ycol,keyname,status);
+ ffgkyj(fptr,keyname, &tlmax,NULL,&tstatus);
+ }
+
+ if (!tstatus)
+ {
+ naxis2 = tlmax - tlmin + 1;
+ }
+
+ /* 123456789012345678901234567890 */
+ strcat(cptr, "NAXIS = 2");
+ strncat(cptr, blanks, 50);
+ cptr += 80;
+
+ ffi2c(naxis1, valstring, status); /* convert to formatted string */
+ ffmkky("NAXIS1", valstring, comm, cptr, status); /* construct the keyword*/
+ strncat(cptr, blanks, 50); /* pad with blanks */
+ cptr += 80;
+
+ strcpy(keyname, "NAXIS2");
+ ffi2c(naxis2, valstring, status); /* convert to formatted string */
+ ffmkky(keyname, valstring, comm, cptr, status); /* construct the keyword*/
+ strncat(cptr, blanks, 50); /* pad with blanks */
+ cptr += 80;
+
+ /* read the required header keywords (use defaults if not found) */
+
+ /* CTYPE1 keyword */
+ tstatus = 0;
+ ffkeyn("TCTYP",xcol,keyname,status);
+ if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) )
+ valstring[0] = '\0';
+ ffmkky("CTYPE1", valstring, comm, cptr, status); /* construct the keyword*/
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+
+ /* CTYPE2 keyword */
+ tstatus = 0;
+ ffkeyn("TCTYP",ycol,keyname,status);
+ if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) )
+ valstring[0] = '\0';
+ ffmkky("CTYPE2", valstring, comm, cptr, status); /* construct the keyword*/
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+
+ /* CRPIX1 keyword */
+ tstatus = 0;
+ ffkeyn("TCRPX",xcol,keyname,status);
+ if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) )
+ strcpy(valstring, "1");
+ ffmkky("CRPIX1", valstring, comm, cptr, status); /* construct the keyword*/
+ strncat(cptr, blanks, 50); /* pad with blanks */
+ cptr += 80;
+
+ /* CRPIX2 keyword */
+ tstatus = 0;
+ ffkeyn("TCRPX",ycol,keyname,status);
+ if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) )
+ strcpy(valstring, "1");
+ ffmkky("CRPIX2", valstring, comm, cptr, status); /* construct the keyword*/
+ strncat(cptr, blanks, 50); /* pad with blanks */
+ cptr += 80;
+
+ /* CRVAL1 keyword */
+ tstatus = 0;
+ ffkeyn("TCRVL",xcol,keyname,status);
+ if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) )
+ strcpy(valstring, "1");
+ ffmkky("CRVAL1", valstring, comm, cptr, status); /* construct the keyword*/
+ strncat(cptr, blanks, 50); /* pad with blanks */
+ cptr += 80;
+
+ /* CRVAL2 keyword */
+ tstatus = 0;
+ ffkeyn("TCRVL",ycol,keyname,status);
+ if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) )
+ strcpy(valstring, "1");
+ ffmkky("CRVAL2", valstring, comm, cptr, status); /* construct the keyword*/
+ strncat(cptr, blanks, 50); /* pad with blanks */
+ cptr += 80;
+
+ /* CDELT1 keyword */
+ tstatus = 0;
+ ffkeyn("TCDLT",xcol,keyname,status);
+ if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) )
+ strcpy(valstring, "1");
+ ffmkky("CDELT1", valstring, comm, cptr, status); /* construct the keyword*/
+ strncat(cptr, blanks, 50); /* pad with blanks */
+ cptr += 80;
+
+ /* CDELT2 keyword */
+ tstatus = 0;
+ ffkeyn("TCDLT",ycol,keyname,status);
+ if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) )
+ strcpy(valstring, "1");
+ ffmkky("CDELT2", valstring, comm, cptr, status); /* construct the keyword*/
+ strncat(cptr, blanks, 50); /* pad with blanks */
+ cptr += 80;
+
+ /* the following keywords may not exist */
+
+ /* CROTA2 keyword */
+ tstatus = 0;
+ ffkeyn("TCROT",ycol,keyname,status);
+ if (ffgkey(fptr, keyname, valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("CROTA2", valstring, comm, cptr, status); /* construct keyword*/
+ strncat(cptr, blanks, 50); /* pad with blanks */
+ cptr += 80;
+ }
+
+ /* EPOCH keyword */
+ tstatus = 0;
+ if (ffgkey(fptr, "EPOCH", valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("EPOCH", valstring, comm, cptr, status); /* construct keyword*/
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+ }
+
+ /* EQUINOX keyword */
+ tstatus = 0;
+ if (ffgkey(fptr, "EQUINOX", valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("EQUINOX", valstring, comm, cptr, status); /* construct keyword*/
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+ }
+
+ /* RADECSYS keyword */
+ tstatus = 0;
+ if (ffgkey(fptr, "RADECSYS", valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("RADECSYS", valstring, comm, cptr, status); /*construct keyword*/
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+ }
+
+ /* TELESCOPE keyword */
+ tstatus = 0;
+ if (ffgkey(fptr, "TELESCOP", valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("TELESCOP", valstring, comm, cptr, status);
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+ }
+
+ /* INSTRUME keyword */
+ tstatus = 0;
+ if (ffgkey(fptr, "INSTRUME", valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("INSTRUME", valstring, comm, cptr, status);
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+ }
+
+ /* DETECTOR keyword */
+ tstatus = 0;
+ if (ffgkey(fptr, "DETECTOR", valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("DETECTOR", valstring, comm, cptr, status);
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+ }
+
+ /* MJD-OBS keyword */
+ tstatus = 0;
+ if (ffgkey(fptr, "MJD-OBS", valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("MJD-OBS", valstring, comm, cptr, status);
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+ }
+
+ /* DATE-OBS keyword */
+ tstatus = 0;
+ if (ffgkey(fptr, "DATE-OBS", valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("DATE-OBS", valstring, comm, cptr, status);
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+ }
+
+ /* DATE keyword */
+ tstatus = 0;
+ if (ffgkey(fptr, "DATE", valstring, NULL, &tstatus) == 0 )
+ {
+ ffmkky("DATE", valstring, comm, cptr, status);
+ length = strlen(cptr);
+ strncat(cptr, blanks, 80 - length); /* pad with blanks */
+ cptr += 80;
+ }
+
+ strcat(cptr, "END");
+ strncat(cptr, blanks, 77);
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/wcsutil.c b/src/plugins/cfitsio/wcsutil.c
new file mode 100644
index 0000000..01d80f9
--- /dev/null
+++ b/src/plugins/cfitsio/wcsutil.c
@@ -0,0 +1,502 @@
+#include <math.h>
+#include "fitsio2.h"
+#define D2R 0.01745329252
+#define TWOPI 6.28318530717959
+
+/*--------------------------------------------------------------------------*/
+int ffwldp(double xpix, double ypix, double xref, double yref,
+ double xrefpix, double yrefpix, double xinc, double yinc, double rot,
+ char *type, double *xpos, double *ypos, int *status)
+
+/* This routine is based on the classic AIPS WCS routine.
+
+ It converts from pixel location to RA,Dec for 9 projective geometries:
+ "-CAR", "-SIN", "-TAN", "-ARC", "-NCP", "-GLS", "-MER", "-AIT" and "-STG".
+*/
+
+/*-----------------------------------------------------------------------*/
+/* routine to determine accurate position for pixel coordinates */
+/* returns 0 if successful otherwise: */
+/* 501 = angle too large for projection; */
+/* does: -CAR, -SIN, -TAN, -ARC, -NCP, -GLS, -MER, -AIT -STG projections*/
+/* Input: */
+/* f xpix x pixel number (RA or long without rotation) */
+/* f ypiy y pixel number (dec or lat without rotation) */
+/* d xref x reference coordinate value (deg) */
+/* d yref y reference coordinate value (deg) */
+/* f xrefpix x reference pixel */
+/* f yrefpix y reference pixel */
+/* f xinc x coordinate increment (deg) */
+/* f yinc y coordinate increment (deg) */
+/* f rot rotation (deg) (from N through E) */
+/* c *type projection type code e.g. "-SIN"; */
+/* Output: */
+/* d *xpos x (RA) coordinate (deg) */
+/* d *ypos y (dec) coordinate (deg) */
+/*-----------------------------------------------------------------------*/
+ {double cosr, sinr, dx, dy, dz, temp, x, y, z;
+ double sins, coss, dect, rat, dt, l, m, mg, da, dd, cos0, sin0;
+ double dec0, ra0;
+ double geo1, geo2, geo3;
+ double deps = 1.0e-5;
+ char *cptr;
+
+ if (*status > 0)
+ return(*status);
+
+/* Offset from ref pixel */
+ dx = (xpix-xrefpix) * xinc;
+ dy = (ypix-yrefpix) * yinc;
+
+/* Take out rotation */
+ cosr = cos(rot * D2R);
+ sinr = sin(rot * D2R);
+ if (rot != 0.0) {
+ temp = dx * cosr - dy * sinr;
+ dy = dy * cosr + dx * sinr;
+ dx = temp;
+ }
+
+/* convert to radians */
+ ra0 = xref * D2R;
+ dec0 = yref * D2R;
+
+ l = dx * D2R;
+ m = dy * D2R;
+ sins = l*l + m*m;
+ cos0 = cos(dec0);
+ sin0 = sin(dec0);
+
+ if (*type != '-') { /* unrecognized projection code */
+ return(*status = 504);
+ }
+
+ cptr = type + 1;
+
+ if (*cptr == 'C') { /* linear -CAR */
+ if (*(cptr + 1) != 'A' || *(cptr + 2) != 'R') {
+ return(*status = 504);
+ }
+ rat = ra0 + l;
+ dect = dec0 + m;
+
+ } else if (*cptr == 'T') { /* -TAN */
+ if (*(cptr + 1) != 'A' || *(cptr + 2) != 'N') {
+ return(*status = 504);
+ }
+ x = cos0*cos(ra0) - l*sin(ra0) - m*cos(ra0)*sin0;
+ y = cos0*sin(ra0) + l*cos(ra0) - m*sin(ra0)*sin0;
+ z = sin0 + m* cos0;
+ rat = atan2( y, x );
+ dect = atan ( z / sqrt(x*x+y*y) );
+
+ } else if (*cptr == 'S') {
+
+ if (*(cptr + 1) == 'I' && *(cptr + 2) == 'N') { /* -SIN */
+ if (sins>1.0)
+ return(*status = 501);
+ coss = sqrt (1.0 - sins);
+ dt = sin0 * coss + cos0 * m;
+ if ((dt>1.0) || (dt<-1.0))
+ return(*status = 501);
+ dect = asin (dt);
+ rat = cos0 * coss - sin0 * m;
+ if ((rat==0.0) && (l==0.0))
+ return(*status = 501);
+ rat = atan2 (l, rat) + ra0;
+
+ } else if (*(cptr + 1) == 'T' && *(cptr + 2) == 'G') { /* -STG Sterographic*/
+ dz = (4.0 - sins) / (4.0 + sins);
+ if (fabs(dz)>1.0)
+ return(*status = 501);
+ dect = dz * sin0 + m * cos0 * (1.0+dz) / 2.0;
+ if (fabs(dect)>1.0)
+ return(*status = 501);
+ dect = asin (dect);
+ rat = cos(dect);
+ if (fabs(rat)<deps)
+ return(*status = 501);
+ rat = l * (1.0+dz) / (2.0 * rat);
+ if (fabs(rat)>1.0)
+ return(*status = 501);
+ rat = asin (rat);
+ mg = 1.0 + sin(dect) * sin0 + cos(dect) * cos0 * cos(rat);
+ if (fabs(mg)<deps)
+ return(*status = 501);
+ mg = 2.0 * (sin(dect) * cos0 - cos(dect) * sin0 * cos(rat)) / mg;
+ if (fabs(mg-m)>deps)
+ rat = TWOPI /2.0 - rat;
+ rat = ra0 + rat;
+ } else {
+ return(*status = 504);
+ }
+
+ } else if (*cptr == 'A') {
+
+ if (*(cptr + 1) == 'R' && *(cptr + 2) == 'C') { /* ARC */
+ if (sins>=TWOPI*TWOPI/4.0)
+ return(*status = 501);
+ sins = sqrt(sins);
+ coss = cos (sins);
+ if (sins!=0.0)
+ sins = sin (sins) / sins;
+ else
+ sins = 1.0;
+ dt = m * cos0 * sins + sin0 * coss;
+ if ((dt>1.0) || (dt<-1.0))
+ return(*status = 501);
+ dect = asin (dt);
+ da = coss - dt * sin0;
+ dt = l * sins * cos0;
+ if ((da==0.0) && (dt==0.0))
+ return(*status = 501);
+ rat = ra0 + atan2 (dt, da);
+
+ } else if (*(cptr + 1) == 'I' && *(cptr + 2) == 'T') { /* -AIT Aitoff */
+ dt = yinc*cosr + xinc*sinr;
+ if (dt==0.0)
+ dt = 1.0;
+ dt = dt * D2R;
+ dy = yref * D2R;
+ dx = sin(dy+dt)/sqrt((1.0+cos(dy+dt))/2.0) -
+ sin(dy)/sqrt((1.0+cos(dy))/2.0);
+ if (dx==0.0)
+ dx = 1.0;
+ geo2 = dt / dx;
+ dt = xinc*cosr - yinc* sinr;
+ if (dt==0.0)
+ dt = 1.0;
+ dt = dt * D2R;
+ dx = 2.0 * cos(dy) * sin(dt/2.0);
+ if (dx==0.0) dx = 1.0;
+ geo1 = dt * sqrt((1.0+cos(dy)*cos(dt/2.0))/2.0) / dx;
+ geo3 = geo2 * sin(dy) / sqrt((1.0+cos(dy))/2.0);
+ rat = ra0;
+ dect = dec0;
+ if ((l != 0.0) || (m != 0.0)) {
+ dz = 4.0 - l*l/(4.0*geo1*geo1) - ((m+geo3)/geo2)*((m+geo3)/geo2) ;
+ if ((dz>4.0) || (dz<2.0)) return(*status = 501);
+ dz = 0.5 * sqrt (dz);
+ dd = (m+geo3) * dz / geo2;
+ if (fabs(dd)>1.0) return(*status = 501);
+ dd = asin (dd);
+ if (fabs(cos(dd))<deps) return(*status = 501);
+ da = l * dz / (2.0 * geo1 * cos(dd));
+ if (fabs(da)>1.0) return(*status = 501);
+ da = asin (da);
+ rat = ra0 + 2.0 * da;
+ dect = dd;
+ }
+ } else {
+ return(*status = 504);
+ }
+
+ } else if (*cptr == 'N') { /* -NCP North celestial pole*/
+ if (*(cptr + 1) != 'C' || *(cptr + 2) != 'P') {
+ return(*status = 504);
+ }
+ dect = cos0 - m * sin0;
+ if (dect==0.0)
+ return(*status = 501);
+ rat = ra0 + atan2 (l, dect);
+ dt = cos (rat-ra0);
+ if (dt==0.0)
+ return(*status = 501);
+ dect = dect / dt;
+ if ((dect>1.0) || (dect<-1.0))
+ return(*status = 501);
+ dect = acos (dect);
+ if (dec0<0.0) dect = -dect;
+
+ } else if (*cptr == 'G') { /* -GLS global sinusoid */
+ if (*(cptr + 1) != 'L' || *(cptr + 2) != 'S') {
+ return(*status = 504);
+ }
+ dect = dec0 + m;
+ if (fabs(dect)>TWOPI/4.0)
+ return(*status = 501);
+ coss = cos (dect);
+ if (fabs(l)>TWOPI*coss/2.0)
+ return(*status = 501);
+ rat = ra0;
+ if (coss>deps) rat = rat + l / coss;
+
+ } else if (*cptr == 'M') { /* -MER mercator*/
+ if (*(cptr + 1) != 'E' || *(cptr + 2) != 'R') {
+ return(*status = 504);
+ }
+ dt = yinc * cosr + xinc * sinr;
+ if (dt==0.0) dt = 1.0;
+ dy = (yref/2.0 + 45.0) * D2R;
+ dx = dy + dt / 2.0 * D2R;
+ dy = log (tan (dy));
+ dx = log (tan (dx));
+ geo2 = dt * D2R / (dx - dy);
+ geo3 = geo2 * dy;
+ geo1 = cos (yref*D2R);
+ if (geo1<=0.0) geo1 = 1.0;
+ rat = l / geo1 + ra0;
+ if (fabs(rat - ra0) > TWOPI)
+ return(*status = 501);
+ dt = 0.0;
+ if (geo2!=0.0) dt = (m + geo3) / geo2;
+ dt = exp (dt);
+ dect = 2.0 * atan (dt) - TWOPI / 4.0;
+
+ } else {
+ return(*status = 504);
+ }
+
+ /* correct for RA rollover */
+ if (rat-ra0>TWOPI/2.0) rat = rat - TWOPI;
+ if (rat-ra0<-TWOPI/2.0) rat = rat + TWOPI;
+ if (rat < 0.0) rat += TWOPI;
+
+ /* convert to degrees */
+ *xpos = rat / D2R;
+ *ypos = dect / D2R;
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int ffxypx(double xpos, double ypos, double xref, double yref,
+ double xrefpix, double yrefpix, double xinc, double yinc, double rot,
+ char *type, double *xpix, double *ypix, int *status)
+
+/* This routine is based on the classic AIPS WCS routine.
+
+ It converts from RA,Dec to pixel location to for 9 projective geometries:
+ "-CAR", "-SIN", "-TAN", "-ARC", "-NCP", "-GLS", "-MER", "-AIT" and "-STG".
+*/
+/*-----------------------------------------------------------------------*/
+/* routine to determine accurate pixel coordinates for an RA and Dec */
+/* returns 0 if successful otherwise: */
+/* 501 = angle too large for projection; */
+/* 502 = bad values */
+/* does: -SIN, -TAN, -ARC, -NCP, -GLS, -MER, -AIT projections */
+/* anything else is linear */
+/* Input: */
+/* d xpos x (RA) coordinate (deg) */
+/* d ypos y (dec) coordinate (deg) */
+/* d xref x reference coordinate value (deg) */
+/* d yref y reference coordinate value (deg) */
+/* f xrefpix x reference pixel */
+/* f yrefpix y reference pixel */
+/* f xinc x coordinate increment (deg) */
+/* f yinc y coordinate increment (deg) */
+/* f rot rotation (deg) (from N through E) */
+/* c *type projection type code e.g. "-SIN"; */
+/* Output: */
+/* f *xpix x pixel number (RA or long without rotation) */
+/* f *ypiy y pixel number (dec or lat without rotation) */
+/*-----------------------------------------------------------------------*/
+ {
+ double dx, dy, dz, r, ra0, dec0, ra, dec, coss, sins, dt, da, dd, sint;
+ double l, m, geo1, geo2, geo3, sinr, cosr, cos0, sin0;
+ double deps=1.0e-5;
+ char *cptr;
+
+ if (*type != '-') { /* unrecognized projection code */
+ return(*status = 504);
+ }
+
+ cptr = type + 1;
+
+ dt = (xpos - xref);
+ if (dt > 180) xpos -= 360;
+ if (dt < -180) xpos += 360;
+ /* NOTE: changing input argument xpos is OK (call-by-value in C!) */
+
+ /* default values - linear */
+ dx = xpos - xref;
+ dy = ypos - yref;
+
+ /* Correct for rotation */
+ r = rot * D2R;
+ cosr = cos (r);
+ sinr = sin (r);
+ dz = dx*cosr + dy*sinr;
+ dy = dy*cosr - dx*sinr;
+ dx = dz;
+
+ /* check axis increments - bail out if either 0 */
+ if ((xinc==0.0) || (yinc==0.0)) {*xpix=0.0; *ypix=0.0;
+ return(*status = 502);}
+
+ /* convert to pixels */
+ *xpix = dx / xinc + xrefpix;
+ *ypix = dy / yinc + yrefpix;
+
+ if (*cptr == 'C') { /* linear -CAR */
+ if (*(cptr + 1) != 'A' || *(cptr + 2) != 'R') {
+ return(*status = 504);
+ }
+
+ return(*status); /* done if linear */
+ }
+
+ /* Non linear position */
+ ra0 = xref * D2R;
+ dec0 = yref * D2R;
+ ra = xpos * D2R;
+ dec = ypos * D2R;
+
+ /* compute direction cosine */
+ coss = cos (dec);
+ sins = sin (dec);
+ cos0 = cos (dec0);
+ sin0 = sin (dec0);
+ l = sin(ra-ra0) * coss;
+ sint = sins * sin0 + coss * cos0 * cos(ra-ra0);
+
+ /* process by case */
+ if (*cptr == 'T') { /* -TAN tan */
+ if (*(cptr + 1) != 'A' || *(cptr + 2) != 'N') {
+ return(*status = 504);
+ }
+
+ if (sint<=0.0)
+ return(*status = 501);
+ if( cos0<0.001 ) {
+ /* Do a first order expansion around pole */
+ m = (coss * cos(ra-ra0)) / (sins * sin0);
+ m = (-m + cos0 * (1.0 + m*m)) / sin0;
+ } else {
+ m = ( sins/sint - sin0 ) / cos0;
+ }
+ if( fabs(sin(ra0)) < 0.3 ) {
+ l = coss*sin(ra)/sint - cos0*sin(ra0) + m*sin(ra0)*sin0;
+ l /= cos(ra0);
+ } else {
+ l = coss*cos(ra)/sint - cos0*cos(ra0) + m*cos(ra0)*sin0;
+ l /= -sin(ra0);
+ }
+
+ } else if (*cptr == 'S') {
+
+ if (*(cptr + 1) == 'I' && *(cptr + 2) == 'N') { /* -SIN */
+ if (sint<0.0)
+ return(*status = 501);
+ m = sins * cos(dec0) - coss * sin(dec0) * cos(ra-ra0);
+
+ } else if (*(cptr + 1) == 'T' && *(cptr + 2) == 'G') { /* -STG Sterographic*/
+ da = ra - ra0;
+ if (fabs(dec)>TWOPI/4.0)
+ return(*status = 501);
+ dd = 1.0 + sins * sin(dec0) + coss * cos(dec0) * cos(da);
+ if (fabs(dd)<deps)
+ return(*status = 501);
+ dd = 2.0 / dd;
+ l = l * dd;
+ m = dd * (sins * cos(dec0) - coss * sin(dec0) * cos(da));
+
+ } else {
+ return(*status = 504);
+ }
+
+ } else if (*cptr == 'A') {
+
+ if (*(cptr + 1) == 'R' && *(cptr + 2) == 'C') { /* ARC */
+ m = sins * sin(dec0) + coss * cos(dec0) * cos(ra-ra0);
+ if (m<-1.0) m = -1.0;
+ if (m>1.0) m = 1.0;
+ m = acos (m);
+ if (m!=0)
+ m = m / sin(m);
+ else
+ m = 1.0;
+ l = l * m;
+ m = (sins * cos(dec0) - coss * sin(dec0) * cos(ra-ra0)) * m;
+
+ } else if (*(cptr + 1) == 'I' && *(cptr + 2) == 'T') { /* -AIT Aitoff */
+ da = (ra - ra0) / 2.0;
+ if (fabs(da)>TWOPI/4.0)
+ return(*status = 501);
+ dt = yinc*cosr + xinc*sinr;
+ if (dt==0.0) dt = 1.0;
+ dt = dt * D2R;
+ dy = yref * D2R;
+ dx = sin(dy+dt)/sqrt((1.0+cos(dy+dt))/2.0) -
+ sin(dy)/sqrt((1.0+cos(dy))/2.0);
+ if (dx==0.0) dx = 1.0;
+ geo2 = dt / dx;
+ dt = xinc*cosr - yinc* sinr;
+ if (dt==0.0) dt = 1.0;
+ dt = dt * D2R;
+ dx = 2.0 * cos(dy) * sin(dt/2.0);
+ if (dx==0.0) dx = 1.0;
+ geo1 = dt * sqrt((1.0+cos(dy)*cos(dt/2.0))/2.0) / dx;
+ geo3 = geo2 * sin(dy) / sqrt((1.0+cos(dy))/2.0);
+ dt = sqrt ((1.0 + cos(dec) * cos(da))/2.0);
+ if (fabs(dt)<deps)
+ return(*status = 503);
+ l = 2.0 * geo1 * cos(dec) * sin(da) / dt;
+ m = geo2 * sin(dec) / dt - geo3;
+
+ } else {
+ return(*status = 504);
+ }
+
+ } else if (*cptr == 'N') { /* -NCP North celestial pole*/
+ if (*(cptr + 1) != 'C' || *(cptr + 2) != 'P') {
+ return(*status = 504);
+ }
+
+ if (dec0==0.0)
+ return(*status = 501); /* can't stand the equator */
+ else
+ m = (cos(dec0) - coss * cos(ra-ra0)) / sin(dec0);
+
+ } else if (*cptr == 'G') { /* -GLS global sinusoid */
+ if (*(cptr + 1) != 'L' || *(cptr + 2) != 'S') {
+ return(*status = 504);
+ }
+
+ dt = ra - ra0;
+ if (fabs(dec)>TWOPI/4.0)
+ return(*status = 501);
+ if (fabs(dec0)>TWOPI/4.0)
+ return(*status = 501);
+ m = dec - dec0;
+ l = dt * coss;
+
+ } else if (*cptr == 'M') { /* -MER mercator*/
+ if (*(cptr + 1) != 'E' || *(cptr + 2) != 'R') {
+ return(*status = 504);
+ }
+
+ dt = yinc * cosr + xinc * sinr;
+ if (dt==0.0) dt = 1.0;
+ dy = (yref/2.0 + 45.0) * D2R;
+ dx = dy + dt / 2.0 * D2R;
+ dy = log (tan (dy));
+ dx = log (tan (dx));
+ geo2 = dt * D2R / (dx - dy);
+ geo3 = geo2 * dy;
+ geo1 = cos (yref*D2R);
+ if (geo1<=0.0) geo1 = 1.0;
+ dt = ra - ra0;
+ l = geo1 * dt;
+ dt = dec / 2.0 + TWOPI / 8.0;
+ dt = tan (dt);
+ if (dt<deps)
+ return(*status = 502);
+ m = geo2 * log (dt) - geo3;
+
+ } else {
+ return(*status = 504);
+ }
+
+ /* convert to degrees */
+ dx = l / D2R;
+ dy = m / D2R;
+
+ /* Correct for rotation */
+ dz = dx*cosr + dy*sinr;
+ dy = dy*cosr - dx*sinr;
+ dx = dz;
+
+ /* convert to pixels */
+ *xpix = dx / xinc + xrefpix;
+ *ypix = dy / yinc + yrefpix;
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/zcompress.c b/src/plugins/cfitsio/zcompress.c
new file mode 100644
index 0000000..b8d7e79
--- /dev/null
+++ b/src/plugins/cfitsio/zcompress.c
@@ -0,0 +1,504 @@
+#include <stdio.h>
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+#include "zlib.h"
+
+unsigned int GZBUFSIZE = 115200; /* 40 FITS blocks */
+int BUFFINCR = 28800; /* 10 FITS blocks */
+
+/* prototype for the following functions */
+int uncompress2mem(char *filename,
+ FILE *diskfile,
+ char **buffptr,
+ size_t *buffsize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ size_t *filesize,
+ int *status);
+
+int uncompress2mem_from_mem(
+ char *inmemptr,
+ size_t inmemsize,
+ char **buffptr,
+ size_t *buffsize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ size_t *filesize,
+ int *status);
+
+int uncompress2file(char *filename,
+ FILE *indiskfile,
+ FILE *outdiskfile,
+ int *status);
+
+
+int compress2mem_from_mem(
+ char *inmemptr,
+ size_t inmemsize,
+ char **buffptr,
+ size_t *buffsize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ size_t *filesize,
+ int *status);
+
+int compress2file_from_mem(
+ char *inmemptr,
+ size_t inmemsize,
+ FILE *outdiskfile,
+ size_t *filesize, /* O - size of file, in bytes */
+ int *status);
+
+
+/*--------------------------------------------------------------------------*/
+int uncompress2mem(char *filename, /* name of input file */
+ FILE *diskfile, /* I - file pointer */
+ char **buffptr, /* IO - memory pointer */
+ size_t *buffsize, /* IO - size of buffer, in bytes */
+ void *(*mem_realloc)(void *p, size_t newsize), /* function */
+ size_t *filesize, /* O - size of file, in bytes */
+ int *status) /* IO - error status */
+
+/*
+ Uncompress the disk file into memory. Fill whatever amount of memory has
+ already been allocated, then realloc more memory, using the supplied
+ input function, if necessary.
+*/
+{
+ int err, len;
+ char *filebuff;
+ z_stream d_stream; /* decompression stream */
+
+ if (*status > 0)
+ return(*status);
+
+ /* Allocate memory to hold compressed bytes read from the file. */
+ filebuff = (char*)malloc(GZBUFSIZE);
+ if (!filebuff) return(*status = 113); /* memory error */
+
+ d_stream.zalloc = (alloc_func)0;
+ d_stream.zfree = (free_func)0;
+ d_stream.opaque = (voidpf)0;
+ d_stream.next_out = (unsigned char*) *buffptr;
+ d_stream.avail_out = *buffsize;
+
+ /* Initialize the decompression. The argument (15+16) tells the
+ decompressor that we are to use the gzip algorithm */
+
+ err = inflateInit2(&d_stream, (15+16));
+ if (err != Z_OK) return(*status = 414);
+
+ /* loop through the file, reading a buffer and uncompressing it */
+ for (;;)
+ {
+ len = fread(filebuff, 1, GZBUFSIZE, diskfile);
+ if (ferror(diskfile)) {
+ inflateEnd(&d_stream);
+ free(filebuff);
+ return(*status = 414);
+ }
+
+ if (len == 0) break; /* no more data */
+
+ d_stream.next_in = (unsigned char*)filebuff;
+ d_stream.avail_in = len;
+
+ for (;;) {
+ /* uncompress as much of the input as will fit in the output */
+ err = inflate(&d_stream, Z_NO_FLUSH);
+
+ if (err == Z_STREAM_END ) { /* We reached the end of the input */
+ break;
+ } else if (err == Z_OK ) {
+
+ if (!d_stream.avail_in) break; /* need more input */
+
+ /* need more space in output buffer */
+ if (mem_realloc) {
+ *buffptr = mem_realloc(*buffptr,*buffsize + BUFFINCR);
+ if (*buffptr == NULL){
+ inflateEnd(&d_stream);
+ free(filebuff);
+ return(*status = 414); /* memory allocation failed */
+ }
+
+ d_stream.avail_out = BUFFINCR;
+ d_stream.next_out = (unsigned char*) (*buffptr + *buffsize);
+ *buffsize = *buffsize + BUFFINCR;
+ } else { /* error: no realloc function available */
+ inflateEnd(&d_stream);
+ free(filebuff);
+ return(*status = 414);
+ }
+ } else { /* some other error */
+ inflateEnd(&d_stream);
+ free(filebuff);
+ return(*status = 414);
+ }
+ }
+
+ if (feof(diskfile)) break;
+
+ d_stream.next_out = (unsigned char*) (*buffptr + d_stream.total_out);
+ d_stream.avail_out = *buffsize - d_stream.total_out;
+ }
+
+ /* Set the output file size to be the total output data */
+ *filesize = d_stream.total_out;
+
+ free(filebuff); /* free temporary output data buffer */
+
+ err = inflateEnd(&d_stream); /* End the decompression */
+ if (err != Z_OK) return(*status = 414);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int uncompress2mem_from_mem(
+ char *inmemptr, /* I - memory pointer to compressed bytes */
+ size_t inmemsize, /* I - size of input compressed file */
+ char **buffptr, /* IO - memory pointer */
+ size_t *buffsize, /* IO - size of buffer, in bytes */
+ void *(*mem_realloc)(void *p, size_t newsize), /* function */
+ size_t *filesize, /* O - size of file, in bytes */
+ int *status) /* IO - error status */
+
+/*
+ Uncompress the file in memory into memory. Fill whatever amount of memory has
+ already been allocated, then realloc more memory, using the supplied
+ input function, if necessary.
+*/
+{
+ int err;
+ z_stream d_stream; /* decompression stream */
+
+ if (*status > 0)
+ return(*status);
+
+ d_stream.zalloc = (alloc_func)0;
+ d_stream.zfree = (free_func)0;
+ d_stream.opaque = (voidpf)0;
+
+ /* Initialize the decompression. The argument (15+16) tells the
+ decompressor that we are to use the gzip algorithm */
+ err = inflateInit2(&d_stream, (15+16));
+ if (err != Z_OK) return(*status = 414);
+
+ d_stream.next_in = (unsigned char*)inmemptr;
+ d_stream.avail_in = inmemsize;
+
+ d_stream.next_out = (unsigned char*) *buffptr;
+ d_stream.avail_out = *buffsize;
+
+ for (;;) {
+ /* uncompress as much of the input as will fit in the output */
+ err = inflate(&d_stream, Z_NO_FLUSH);
+
+ if (err == Z_STREAM_END) { /* We reached the end of the input */
+ break;
+ } else if (err == Z_OK ) { /* need more space in output buffer */
+
+ if (mem_realloc) {
+ *buffptr = mem_realloc(*buffptr,*buffsize + BUFFINCR);
+ if (*buffptr == NULL){
+ inflateEnd(&d_stream);
+ return(*status = 414); /* memory allocation failed */
+ }
+
+ d_stream.avail_out = BUFFINCR;
+ d_stream.next_out = (unsigned char*) (*buffptr + *buffsize);
+ *buffsize = *buffsize + BUFFINCR;
+
+ } else { /* error: no realloc function available */
+ inflateEnd(&d_stream);
+ return(*status = 414);
+ }
+ } else { /* some other error */
+ inflateEnd(&d_stream);
+ return(*status = 414);
+ }
+ }
+
+ /* Set the output file size to be the total output data */
+ if (filesize) *filesize = d_stream.total_out;
+
+ /* End the decompression */
+ err = inflateEnd(&d_stream);
+
+ if (err != Z_OK) return(*status = 414);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int uncompress2file(char *filename, /* name of input file */
+ FILE *indiskfile, /* I - input file pointer */
+ FILE *outdiskfile, /* I - output file pointer */
+ int *status) /* IO - error status */
+/*
+ Uncompress the file into another file.
+*/
+{
+ int err, len;
+ unsigned long bytes_out = 0;
+ char *infilebuff, *outfilebuff;
+ z_stream d_stream; /* decompression stream */
+
+ if (*status > 0)
+ return(*status);
+
+ /* Allocate buffers to hold compressed and uncompressed */
+ infilebuff = (char*)malloc(GZBUFSIZE);
+ if (!infilebuff) return(*status = 113); /* memory error */
+
+ outfilebuff = (char*)malloc(GZBUFSIZE);
+ if (!outfilebuff) return(*status = 113); /* memory error */
+
+ d_stream.zalloc = (alloc_func)0;
+ d_stream.zfree = (free_func)0;
+ d_stream.opaque = (voidpf)0;
+
+ d_stream.next_out = (unsigned char*) outfilebuff;
+ d_stream.avail_out = GZBUFSIZE;
+
+ /* Initialize the decompression. The argument (15+16) tells the
+ decompressor that we are to use the gzip algorithm */
+
+ err = inflateInit2(&d_stream, (15+16));
+ if (err != Z_OK) return(*status = 414);
+
+ /* loop through the file, reading a buffer and uncompressing it */
+ for (;;)
+ {
+ len = fread(infilebuff, 1, GZBUFSIZE, indiskfile);
+ if (ferror(indiskfile)) {
+ inflateEnd(&d_stream);
+ free(infilebuff);
+ free(outfilebuff);
+ return(*status = 414);
+ }
+
+ if (len == 0) break; /* no more data */
+
+ d_stream.next_in = (unsigned char*)infilebuff;
+ d_stream.avail_in = len;
+
+ for (;;) {
+ /* uncompress as much of the input as will fit in the output */
+ err = inflate(&d_stream, Z_NO_FLUSH);
+
+ if (err == Z_STREAM_END ) { /* We reached the end of the input */
+ break;
+ } else if (err == Z_OK ) {
+
+ if (!d_stream.avail_in) break; /* need more input */
+
+ /* flush out the full output buffer */
+ if ((int)fwrite(outfilebuff, 1, GZBUFSIZE, outdiskfile) != GZBUFSIZE) {
+ inflateEnd(&d_stream);
+ free(infilebuff);
+ free(outfilebuff);
+ return(*status = 414);
+ }
+ bytes_out += GZBUFSIZE;
+ d_stream.next_out = (unsigned char*) outfilebuff;
+ d_stream.avail_out = GZBUFSIZE;
+
+ } else { /* some other error */
+ inflateEnd(&d_stream);
+ free(infilebuff);
+ free(outfilebuff);
+ return(*status = 414);
+ }
+ }
+
+ if (feof(indiskfile)) break;
+ }
+
+ /* write out any remaining bytes in the buffer */
+ if (d_stream.total_out > bytes_out) {
+ if ((int)fwrite(outfilebuff, 1, (d_stream.total_out - bytes_out), outdiskfile)
+ != (d_stream.total_out - bytes_out)) {
+ inflateEnd(&d_stream);
+ free(infilebuff);
+ free(outfilebuff);
+ return(*status = 414);
+ }
+ }
+
+ free(infilebuff); /* free temporary output data buffer */
+ free(outfilebuff); /* free temporary output data buffer */
+
+ err = inflateEnd(&d_stream); /* End the decompression */
+ if (err != Z_OK) return(*status = 414);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int compress2mem_from_mem(
+ char *inmemptr, /* I - memory pointer to uncompressed bytes */
+ size_t inmemsize, /* I - size of input uncompressed file */
+ char **buffptr, /* IO - memory pointer for compressed file */
+ size_t *buffsize, /* IO - size of buffer, in bytes */
+ void *(*mem_realloc)(void *p, size_t newsize), /* function */
+ size_t *filesize, /* O - size of file, in bytes */
+ int *status) /* IO - error status */
+
+/*
+ Compress the file into memory. Fill whatever amount of memory has
+ already been allocated, then realloc more memory, using the supplied
+ input function, if necessary.
+*/
+{
+ int err;
+ z_stream c_stream; /* compression stream */
+
+ if (*status > 0)
+ return(*status);
+
+ c_stream.zalloc = (alloc_func)0;
+ c_stream.zfree = (free_func)0;
+ c_stream.opaque = (voidpf)0;
+
+ /* Initialize the compression. The argument (15+16) tells the
+ compressor that we are to use the gzip algorythm.
+ Also use Z_BEST_SPEED for maximum speed with very minor loss
+ in compression factor. */
+ err = deflateInit2(&c_stream, Z_BEST_SPEED, Z_DEFLATED,
+ (15+16), 8, Z_DEFAULT_STRATEGY);
+
+ if (err != Z_OK) return(*status = 413);
+
+ c_stream.next_in = (unsigned char*)inmemptr;
+ c_stream.avail_in = inmemsize;
+
+ c_stream.next_out = (unsigned char*) *buffptr;
+ c_stream.avail_out = *buffsize;
+
+ for (;;) {
+ /* compress as much of the input as will fit in the output */
+ err = deflate(&c_stream, Z_FINISH);
+
+ if (err == Z_STREAM_END) { /* We reached the end of the input */
+ break;
+ } else if (err == Z_OK ) { /* need more space in output buffer */
+
+ if (mem_realloc) {
+ *buffptr = mem_realloc(*buffptr,*buffsize + BUFFINCR);
+ if (*buffptr == NULL){
+ deflateEnd(&c_stream);
+ return(*status = 413); /* memory allocation failed */
+ }
+
+ c_stream.avail_out = BUFFINCR;
+ c_stream.next_out = (unsigned char*) (*buffptr + *buffsize);
+ *buffsize = *buffsize + BUFFINCR;
+
+ } else { /* error: no realloc function available */
+ deflateEnd(&c_stream);
+ return(*status = 413);
+ }
+ } else { /* some other error */
+ deflateEnd(&c_stream);
+ return(*status = 413);
+ }
+ }
+
+ /* Set the output file size to be the total output data */
+ if (filesize) *filesize = c_stream.total_out;
+
+ /* End the compression */
+ err = deflateEnd(&c_stream);
+
+ if (err != Z_OK) return(*status = 413);
+
+ return(*status);
+}
+/*--------------------------------------------------------------------------*/
+int compress2file_from_mem(
+ char *inmemptr, /* I - memory pointer to uncompressed bytes */
+ size_t inmemsize, /* I - size of input uncompressed file */
+ FILE *outdiskfile,
+ size_t *filesize, /* O - size of file, in bytes */
+ int *status)
+
+/*
+ Compress the memory file into disk file.
+*/
+{
+ int err;
+ unsigned long bytes_out = 0;
+ char *outfilebuff;
+ z_stream c_stream; /* compression stream */
+
+ if (*status > 0)
+ return(*status);
+
+ /* Allocate buffer to hold compressed bytes */
+ outfilebuff = (char*)malloc(GZBUFSIZE);
+ if (!outfilebuff) return(*status = 113); /* memory error */
+
+ c_stream.zalloc = (alloc_func)0;
+ c_stream.zfree = (free_func)0;
+ c_stream.opaque = (voidpf)0;
+
+ /* Initialize the compression. The argument (15+16) tells the
+ compressor that we are to use the gzip algorythm.
+ Also use Z_BEST_SPEED for maximum speed with very minor loss
+ in compression factor. */
+ err = deflateInit2(&c_stream, Z_BEST_SPEED, Z_DEFLATED,
+ (15+16), 8, Z_DEFAULT_STRATEGY);
+
+ if (err != Z_OK) return(*status = 413);
+
+ c_stream.next_in = (unsigned char*)inmemptr;
+ c_stream.avail_in = inmemsize;
+
+ c_stream.next_out = (unsigned char*) outfilebuff;
+ c_stream.avail_out = GZBUFSIZE;
+
+ for (;;) {
+ /* compress as much of the input as will fit in the output */
+ err = deflate(&c_stream, Z_FINISH);
+
+ if (err == Z_STREAM_END) { /* We reached the end of the input */
+ break;
+ } else if (err == Z_OK ) { /* need more space in output buffer */
+
+ /* flush out the full output buffer */
+ if ((int)fwrite(outfilebuff, 1, GZBUFSIZE, outdiskfile) != GZBUFSIZE) {
+ deflateEnd(&c_stream);
+ free(outfilebuff);
+ return(*status = 413);
+ }
+ bytes_out += GZBUFSIZE;
+ c_stream.next_out = (unsigned char*) outfilebuff;
+ c_stream.avail_out = GZBUFSIZE;
+
+
+ } else { /* some other error */
+ deflateEnd(&c_stream);
+ free(outfilebuff);
+ return(*status = 413);
+ }
+ }
+
+ /* write out any remaining bytes in the buffer */
+ if (c_stream.total_out > bytes_out) {
+ if ((int)fwrite(outfilebuff, 1, (c_stream.total_out - bytes_out), outdiskfile)
+ != (c_stream.total_out - bytes_out)) {
+ deflateEnd(&c_stream);
+ free(outfilebuff);
+ return(*status = 413);
+ }
+ }
+
+ free(outfilebuff); /* free temporary output data buffer */
+
+ /* Set the output file size to be the total output data */
+ if (filesize) *filesize = c_stream.total_out;
+
+ /* End the compression */
+ err = deflateEnd(&c_stream);
+
+ if (err != Z_OK) return(*status = 413);
+
+ return(*status);
+}
diff --git a/src/plugins/cfitsio/zconf.h b/src/plugins/cfitsio/zconf.h
new file mode 100644
index 0000000..142c330
--- /dev/null
+++ b/src/plugins/cfitsio/zconf.h
@@ -0,0 +1,426 @@
+/* zconf.h -- configuration of the zlib compression library
+ * Copyright (C) 1995-2010 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#ifndef ZCONF_H
+#define ZCONF_H
+
+/*
+ * If you *really* need a unique prefix for all types and library functions,
+ * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it.
+ * Even better than compiling with -DZ_PREFIX would be to use configure to set
+ * this permanently in zconf.h using "./configure --zprefix".
+ */
+#ifdef Z_PREFIX /* may be set to #if 1 by ./configure */
+
+/* all linked symbols */
+# define _dist_code z__dist_code
+# define _length_code z__length_code
+# define _tr_align z__tr_align
+# define _tr_flush_block z__tr_flush_block
+# define _tr_init z__tr_init
+# define _tr_stored_block z__tr_stored_block
+# define _tr_tally z__tr_tally
+# define adler32 z_adler32
+# define adler32_combine z_adler32_combine
+# define adler32_combine64 z_adler32_combine64
+# define compress z_compress
+# define compress2 z_compress2
+# define compressBound z_compressBound
+# define crc32 z_crc32
+# define crc32_combine z_crc32_combine
+# define crc32_combine64 z_crc32_combine64
+# define deflate z_deflate
+# define deflateBound z_deflateBound
+# define deflateCopy z_deflateCopy
+# define deflateEnd z_deflateEnd
+# define deflateInit2_ z_deflateInit2_
+# define deflateInit_ z_deflateInit_
+# define deflateParams z_deflateParams
+# define deflatePrime z_deflatePrime
+# define deflateReset z_deflateReset
+# define deflateSetDictionary z_deflateSetDictionary
+# define deflateSetHeader z_deflateSetHeader
+# define deflateTune z_deflateTune
+# define deflate_copyright z_deflate_copyright
+# define get_crc_table z_get_crc_table
+# define gz_error z_gz_error
+# define gz_intmax z_gz_intmax
+# define gz_strwinerror z_gz_strwinerror
+# define gzbuffer z_gzbuffer
+# define gzclearerr z_gzclearerr
+# define gzclose z_gzclose
+# define gzclose_r z_gzclose_r
+# define gzclose_w z_gzclose_w
+# define gzdirect z_gzdirect
+# define gzdopen z_gzdopen
+# define gzeof z_gzeof
+# define gzerror z_gzerror
+# define gzflush z_gzflush
+# define gzgetc z_gzgetc
+# define gzgets z_gzgets
+# define gzoffset z_gzoffset
+# define gzoffset64 z_gzoffset64
+# define gzopen z_gzopen
+# define gzopen64 z_gzopen64
+# define gzprintf z_gzprintf
+# define gzputc z_gzputc
+# define gzputs z_gzputs
+# define gzread z_gzread
+# define gzrewind z_gzrewind
+# define gzseek z_gzseek
+# define gzseek64 z_gzseek64
+# define gzsetparams z_gzsetparams
+# define gztell z_gztell
+# define gztell64 z_gztell64
+# define gzungetc z_gzungetc
+# define gzwrite z_gzwrite
+# define inflate z_inflate
+# define inflateBack z_inflateBack
+# define inflateBackEnd z_inflateBackEnd
+# define inflateBackInit_ z_inflateBackInit_
+# define inflateCopy z_inflateCopy
+# define inflateEnd z_inflateEnd
+# define inflateGetHeader z_inflateGetHeader
+# define inflateInit2_ z_inflateInit2_
+# define inflateInit_ z_inflateInit_
+# define inflateMark z_inflateMark
+# define inflatePrime z_inflatePrime
+# define inflateReset z_inflateReset
+# define inflateReset2 z_inflateReset2
+# define inflateSetDictionary z_inflateSetDictionary
+# define inflateSync z_inflateSync
+# define inflateSyncPoint z_inflateSyncPoint
+# define inflateUndermine z_inflateUndermine
+# define inflate_copyright z_inflate_copyright
+# define inflate_fast z_inflate_fast
+# define inflate_table z_inflate_table
+# define uncompress z_uncompress
+# define zError z_zError
+# define zcalloc z_zcalloc
+# define zcfree z_zcfree
+# define zlibCompileFlags z_zlibCompileFlags
+# define zlibVersion z_zlibVersion
+
+/* all zlib typedefs in zlib.h and zconf.h */
+# define Byte z_Byte
+# define Bytef z_Bytef
+# define alloc_func z_alloc_func
+# define charf z_charf
+# define free_func z_free_func
+# define gzFile z_gzFile
+# define gz_header z_gz_header
+# define gz_headerp z_gz_headerp
+# define in_func z_in_func
+# define intf z_intf
+# define out_func z_out_func
+# define uInt z_uInt
+# define uIntf z_uIntf
+# define uLong z_uLong
+# define uLongf z_uLongf
+# define voidp z_voidp
+# define voidpc z_voidpc
+# define voidpf z_voidpf
+
+/* all zlib structs in zlib.h and zconf.h */
+# define gz_header_s z_gz_header_s
+# define internal_state z_internal_state
+
+#endif
+
+#if defined(__MSDOS__) && !defined(MSDOS)
+# define MSDOS
+#endif
+#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2)
+# define OS2
+#endif
+#if defined(_WINDOWS) && !defined(WINDOWS)
+# define WINDOWS
+#endif
+#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__)
+# ifndef WIN32
+# define WIN32
+# endif
+#endif
+#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32)
+# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__)
+# ifndef SYS16BIT
+# define SYS16BIT
+# endif
+# endif
+#endif
+
+/*
+ * Compile with -DMAXSEG_64K if the alloc function cannot allocate more
+ * than 64k bytes at a time (needed on systems with 16-bit int).
+ */
+#ifdef SYS16BIT
+# define MAXSEG_64K
+#endif
+#ifdef MSDOS
+# define UNALIGNED_OK
+#endif
+
+#ifdef __STDC_VERSION__
+# ifndef STDC
+# define STDC
+# endif
+# if __STDC_VERSION__ >= 199901L
+# ifndef STDC99
+# define STDC99
+# endif
+# endif
+#endif
+#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__))
+# define STDC
+#endif
+
+#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */
+# define STDC
+#endif
+
+#ifndef STDC
+# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */
+# define const /* note: need a more gentle solution here */
+# endif
+#endif
+
+/* Some Mac compilers merge all .h files incorrectly: */
+#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__)
+# define NO_DUMMY_DECL
+#endif
+
+/* Maximum value for memLevel in deflateInit2 */
+#ifndef MAX_MEM_LEVEL
+# ifdef MAXSEG_64K
+# define MAX_MEM_LEVEL 8
+# else
+# define MAX_MEM_LEVEL 9
+# endif
+#endif
+
+/* Maximum value for windowBits in deflateInit2 and inflateInit2.
+ * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files
+ * created by gzip. (Files created by minigzip can still be extracted by
+ * gzip.)
+ */
+#ifndef MAX_WBITS
+# define MAX_WBITS 15 /* 32K LZ77 window */
+#endif
+
+/* The memory requirements for deflate are (in bytes):
+ (1 << (windowBits+2)) + (1 << (memLevel+9))
+ that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values)
+ plus a few kilobytes for small objects. For example, if you want to reduce
+ the default memory requirements from 256K to 128K, compile with
+ make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7"
+ Of course this will generally degrade compression (there's no free lunch).
+
+ The memory requirements for inflate are (in bytes) 1 << windowBits
+ that is, 32K for windowBits=15 (default value) plus a few kilobytes
+ for small objects.
+*/
+
+ /* Type declarations */
+
+#ifndef OF /* function prototypes */
+# ifdef STDC
+# define OF(args) args
+# else
+# define OF(args) ()
+# endif
+#endif
+
+/* The following definitions for FAR are needed only for MSDOS mixed
+ * model programming (small or medium model with some far allocations).
+ * This was tested only with MSC; for other MSDOS compilers you may have
+ * to define NO_MEMCPY in zutil.h. If you don't need the mixed model,
+ * just define FAR to be empty.
+ */
+#ifdef SYS16BIT
+# if defined(M_I86SM) || defined(M_I86MM)
+ /* MSC small or medium model */
+# define SMALL_MEDIUM
+# ifdef _MSC_VER
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+# if (defined(__SMALL__) || defined(__MEDIUM__))
+ /* Turbo C small or medium model */
+# define SMALL_MEDIUM
+# ifdef __BORLANDC__
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+#endif
+
+#if defined(WINDOWS) || defined(WIN32)
+ /* If building or using zlib as a DLL, define ZLIB_DLL.
+ * This is not mandatory, but it offers a little performance increase.
+ */
+# ifdef ZLIB_DLL
+# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500))
+# ifdef ZLIB_INTERNAL
+# define ZEXTERN extern __declspec(dllexport)
+# else
+# define ZEXTERN extern __declspec(dllimport)
+# endif
+# endif
+# endif /* ZLIB_DLL */
+ /* If building or using zlib with the WINAPI/WINAPIV calling convention,
+ * define ZLIB_WINAPI.
+ * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI.
+ */
+# ifdef ZLIB_WINAPI
+# ifdef FAR
+# undef FAR
+# endif
+# include <windows.h>
+ /* No need for _export, use ZLIB.DEF instead. */
+ /* For complete Windows compatibility, use WINAPI, not __stdcall. */
+# define ZEXPORT WINAPI
+# ifdef WIN32
+# define ZEXPORTVA WINAPIV
+# else
+# define ZEXPORTVA FAR CDECL
+# endif
+# endif
+#endif
+
+#if defined (__BEOS__)
+# ifdef ZLIB_DLL
+# ifdef ZLIB_INTERNAL
+# define ZEXPORT __declspec(dllexport)
+# define ZEXPORTVA __declspec(dllexport)
+# else
+# define ZEXPORT __declspec(dllimport)
+# define ZEXPORTVA __declspec(dllimport)
+# endif
+# endif
+#endif
+
+#ifndef ZEXTERN
+# define ZEXTERN extern
+#endif
+#ifndef ZEXPORT
+# define ZEXPORT
+#endif
+#ifndef ZEXPORTVA
+# define ZEXPORTVA
+#endif
+
+#ifndef FAR
+# define FAR
+#endif
+
+#if !defined(__MACTYPES__)
+typedef unsigned char Byte; /* 8 bits */
+#endif
+typedef unsigned int uInt; /* 16 bits or more */
+typedef unsigned long uLong; /* 32 bits or more */
+
+#ifdef SMALL_MEDIUM
+ /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */
+# define Bytef Byte FAR
+#else
+ typedef Byte FAR Bytef;
+#endif
+typedef char FAR charf;
+typedef int FAR intf;
+typedef uInt FAR uIntf;
+typedef uLong FAR uLongf;
+
+#ifdef STDC
+ typedef void const *voidpc;
+ typedef void FAR *voidpf;
+ typedef void *voidp;
+#else
+ typedef Byte const *voidpc;
+ typedef Byte FAR *voidpf;
+ typedef Byte *voidp;
+#endif
+
+#if !defined(MSDOS) && !defined(WINDOWS) && !defined(WIN32)
+# define Z_HAVE_UNISTD_H
+#endif
+
+#ifdef STDC
+# include <sys/types.h> /* for off_t */
+#endif
+
+/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
+ * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even
+ * though the former does not conform to the LFS document), but considering
+ * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
+ * equivalently requesting no 64-bit operations
+ */
+#if -_LARGEFILE64_SOURCE - -1 == 1
+# undef _LARGEFILE64_SOURCE
+#endif
+
+#if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE)
+# include <unistd.h> /* for SEEK_* and off_t */
+# ifdef VMS
+# include <unixio.h> /* for off_t */
+# endif
+# ifndef z_off_t
+# define z_off_t off_t
+# endif
+#endif
+
+#ifndef SEEK_SET
+# define SEEK_SET 0 /* Seek from beginning of file. */
+# define SEEK_CUR 1 /* Seek from current position. */
+# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */
+#endif
+
+#ifndef z_off_t
+# define z_off_t long
+#endif
+
+#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0
+# define z_off64_t off64_t
+#else
+# define z_off64_t z_off_t
+#endif
+
+#if defined(__OS400__)
+# define NO_vsnprintf
+#endif
+
+#if defined(__MVS__)
+# define NO_vsnprintf
+#endif
+
+/* MVS linker does not support external names larger than 8 bytes */
+#if defined(__MVS__)
+ #pragma map(deflateInit_,"DEIN")
+ #pragma map(deflateInit2_,"DEIN2")
+ #pragma map(deflateEnd,"DEEND")
+ #pragma map(deflateBound,"DEBND")
+ #pragma map(inflateInit_,"ININ")
+ #pragma map(inflateInit2_,"ININ2")
+ #pragma map(inflateEnd,"INEND")
+ #pragma map(inflateSync,"INSY")
+ #pragma map(inflateSetDictionary,"INSEDI")
+ #pragma map(compressBound,"CMBND")
+ #pragma map(inflate_table,"INTABL")
+ #pragma map(inflate_fast,"INFA")
+ #pragma map(inflate_copyright,"INCOPY")
+#endif
+
+#endif /* ZCONF_H */
diff --git a/src/plugins/cfitsio/zlib.h b/src/plugins/cfitsio/zlib.h
new file mode 100644
index 0000000..bfbba83
--- /dev/null
+++ b/src/plugins/cfitsio/zlib.h
@@ -0,0 +1,1613 @@
+/* zlib.h -- interface of the 'zlib' general purpose compression library
+ version 1.2.5, April 19th, 2010
+
+ Copyright (C) 1995-2010 Jean-loup Gailly and Mark Adler
+
+ This software is provided 'as-is', without any express or implied
+ warranty. In no event will the authors be held liable for any damages
+ arising from the use of this software.
+
+ Permission is granted to anyone to use this software for any purpose,
+ including commercial applications, and to alter it and redistribute it
+ freely, subject to the following restrictions:
+
+ 1. The origin of this software must not be misrepresented; you must not
+ claim that you wrote the original software. If you use this software
+ in a product, an acknowledgment in the product documentation would be
+ appreciated but is not required.
+ 2. Altered source versions must be plainly marked as such, and must not be
+ misrepresented as being the original software.
+ 3. This notice may not be removed or altered from any source distribution.
+
+ Jean-loup Gailly Mark Adler
+ jloup gzip org madler alumni caltech edu
+
+
+ The data format used by the zlib library is described by RFCs (Request for
+ Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt
+ (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format).
+*/
+
+#ifndef ZLIB_H
+#define ZLIB_H
+
+#include "zconf.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define ZLIB_VERSION "1.2.5"
+#define ZLIB_VERNUM 0x1250
+#define ZLIB_VER_MAJOR 1
+#define ZLIB_VER_MINOR 2
+#define ZLIB_VER_REVISION 5
+#define ZLIB_VER_SUBREVISION 0
+
+/*
+ The 'zlib' compression library provides in-memory compression and
+ decompression functions, including integrity checks of the uncompressed data.
+ This version of the library supports only one compression method (deflation)
+ but other algorithms will be added later and will have the same stream
+ interface.
+
+ Compression can be done in a single step if the buffers are large enough,
+ or can be done by repeated calls of the compression function. In the latter
+ case, the application must provide more input and/or consume the output
+ (providing more output space) before each call.
+
+ The compressed data format used by default by the in-memory functions is
+ the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped
+ around a deflate stream, which is itself documented in RFC 1951.
+
+ The library also supports reading and writing files in gzip (.gz) format
+ with an interface similar to that of stdio using the functions that start
+ with "gz". The gzip format is different from the zlib format. gzip is a
+ gzip wrapper, documented in RFC 1952, wrapped around a deflate stream.
+
+ This library can optionally read and write gzip streams in memory as well.
+
+ The zlib format was designed to be compact and fast for use in memory
+ and on communications channels. The gzip format was designed for single-
+ file compression on file systems, has a larger header than zlib to maintain
+ directory information, and uses a different, slower check method than zlib.
+
+ The library does not install any signal handler. The decoder checks
+ the consistency of the compressed data, so the library should never crash
+ even in case of corrupted input.
+*/
+
+typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size));
+typedef void (*free_func) OF((voidpf opaque, voidpf address));
+
+struct internal_state;
+
+typedef struct z_stream_s {
+ Bytef *next_in; /* next input byte */
+ uInt avail_in; /* number of bytes available at next_in */
+ uLong total_in; /* total nb of input bytes read so far */
+
+ Bytef *next_out; /* next output byte should be put there */
+ uInt avail_out; /* remaining free space at next_out */
+ uLong total_out; /* total nb of bytes output so far */
+
+ char *msg; /* last error message, NULL if no error */
+ struct internal_state FAR *state; /* not visible by applications */
+
+ alloc_func zalloc; /* used to allocate the internal state */
+ free_func zfree; /* used to free the internal state */
+ voidpf opaque; /* private data object passed to zalloc and zfree */
+
+ int data_type; /* best guess about the data type: binary or text */
+ uLong adler; /* adler32 value of the uncompressed data */
+ uLong reserved; /* reserved for future use */
+} z_stream;
+
+typedef z_stream FAR *z_streamp;
+
+/*
+ gzip header information passed to and from zlib routines. See RFC 1952
+ for more details on the meanings of these fields.
+*/
+typedef struct gz_header_s {
+ int text; /* true if compressed data believed to be text */
+ uLong time; /* modification time */
+ int xflags; /* extra flags (not used when writing a gzip file) */
+ int os; /* operating system */
+ Bytef *extra; /* pointer to extra field or Z_NULL if none */
+ uInt extra_len; /* extra field length (valid if extra != Z_NULL) */
+ uInt extra_max; /* space at extra (only when reading header) */
+ Bytef *name; /* pointer to zero-terminated file name or Z_NULL */
+ uInt name_max; /* space at name (only when reading header) */
+ Bytef *comment; /* pointer to zero-terminated comment or Z_NULL */
+ uInt comm_max; /* space at comment (only when reading header) */
+ int hcrc; /* true if there was or will be a header crc */
+ int done; /* true when done reading gzip header (not used
+ when writing a gzip file) */
+} gz_header;
+
+typedef gz_header FAR *gz_headerp;
+
+/*
+ The application must update next_in and avail_in when avail_in has dropped
+ to zero. It must update next_out and avail_out when avail_out has dropped
+ to zero. The application must initialize zalloc, zfree and opaque before
+ calling the init function. All other fields are set by the compression
+ library and must not be updated by the application.
+
+ The opaque value provided by the application will be passed as the first
+ parameter for calls of zalloc and zfree. This can be useful for custom
+ memory management. The compression library attaches no meaning to the
+ opaque value.
+
+ zalloc must return Z_NULL if there is not enough memory for the object.
+ If zlib is used in a multi-threaded application, zalloc and zfree must be
+ thread safe.
+
+ On 16-bit systems, the functions zalloc and zfree must be able to allocate
+ exactly 65536 bytes, but will not be required to allocate more than this if
+ the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, pointers
+ returned by zalloc for objects of exactly 65536 bytes *must* have their
+ offset normalized to zero. The default allocation function provided by this
+ library ensures this (see zutil.c). To reduce memory requirements and avoid
+ any allocation of 64K objects, at the expense of compression ratio, compile
+ the library with -DMAX_WBITS=14 (see zconf.h).
+
+ The fields total_in and total_out can be used for statistics or progress
+ reports. After compression, total_in holds the total size of the
+ uncompressed data and may be saved for use in the decompressor (particularly
+ if the decompressor wants to decompress everything in a single step).
+*/
+
+ /* constants */
+
+#define Z_NO_FLUSH 0
+#define Z_PARTIAL_FLUSH 1
+#define Z_SYNC_FLUSH 2
+#define Z_FULL_FLUSH 3
+#define Z_FINISH 4
+#define Z_BLOCK 5
+#define Z_TREES 6
+/* Allowed flush values; see deflate() and inflate() below for details */
+
+#define Z_OK 0
+#define Z_STREAM_END 1
+#define Z_NEED_DICT 2
+#define Z_ERRNO (-1)
+#define Z_STREAM_ERROR (-2)
+#define Z_DATA_ERROR (-3)
+#define Z_MEM_ERROR (-4)
+#define Z_BUF_ERROR (-5)
+#define Z_VERSION_ERROR (-6)
+/* Return codes for the compression/decompression functions. Negative values
+ * are errors, positive values are used for special but normal events.
+ */
+
+#define Z_NO_COMPRESSION 0
+#define Z_BEST_SPEED 1
+#define Z_BEST_COMPRESSION 9
+#define Z_DEFAULT_COMPRESSION (-1)
+/* compression levels */
+
+#define Z_FILTERED 1
+#define Z_HUFFMAN_ONLY 2
+#define Z_RLE 3
+#define Z_FIXED 4
+#define Z_DEFAULT_STRATEGY 0
+/* compression strategy; see deflateInit2() below for details */
+
+#define Z_BINARY 0
+#define Z_TEXT 1
+#define Z_ASCII Z_TEXT /* for compatibility with 1.2.2 and earlier */
+#define Z_UNKNOWN 2
+/* Possible values of the data_type field (though see inflate()) */
+
+#define Z_DEFLATED 8
+/* The deflate compression method (the only one supported in this version) */
+
+#define Z_NULL 0 /* for initializing zalloc, zfree, opaque */
+
+#define zlib_version zlibVersion()
+/* for compatibility with versions < 1.0.2 */
+
+
+ /* basic functions */
+
+ZEXTERN const char * ZEXPORT zlibVersion OF((void));
+/* The application can compare zlibVersion and ZLIB_VERSION for consistency.
+ If the first character differs, the library code actually used is not
+ compatible with the zlib.h header file used by the application. This check
+ is automatically made by deflateInit and inflateInit.
+ */
+
+/*
+ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level));
+
+ Initializes the internal stream state for compression. The fields
+ zalloc, zfree and opaque must be initialized before by the caller. If
+ zalloc and zfree are set to Z_NULL, deflateInit updates them to use default
+ allocation functions.
+
+ The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9:
+ 1 gives best speed, 9 gives best compression, 0 gives no compression at all
+ (the input data is simply copied a block at a time). Z_DEFAULT_COMPRESSION
+ requests a default compromise between speed and compression (currently
+ equivalent to level 6).
+
+ deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_STREAM_ERROR if level is not a valid compression level, or
+ Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible
+ with the version assumed by the caller (ZLIB_VERSION). msg is set to null
+ if there is no error message. deflateInit does not perform any compression:
+ this will be done by deflate().
+*/
+
+
+ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush));
+/*
+ deflate compresses as much data as possible, and stops when the input
+ buffer becomes empty or the output buffer becomes full. It may introduce
+ some output latency (reading input without producing any output) except when
+ forced to flush.
+
+ The detailed semantics are as follows. deflate performs one or both of the
+ following actions:
+
+ - Compress more input starting at next_in and update next_in and avail_in
+ accordingly. If not all input can be processed (because there is not
+ enough room in the output buffer), next_in and avail_in are updated and
+ processing will resume at this point for the next call of deflate().
+
+ - Provide more output starting at next_out and update next_out and avail_out
+ accordingly. This action is forced if the parameter flush is non zero.
+ Forcing flush frequently degrades the compression ratio, so this parameter
+ should be set only when necessary (in interactive applications). Some
+ output may be provided even if flush is not set.
+
+ Before the call of deflate(), the application should ensure that at least
+ one of the actions is possible, by providing more input and/or consuming more
+ output, and updating avail_in or avail_out accordingly; avail_out should
+ never be zero before the call. The application can consume the compressed
+ output when it wants, for example when the output buffer is full (avail_out
+ == 0), or after each call of deflate(). If deflate returns Z_OK and with
+ zero avail_out, it must be called again after making room in the output
+ buffer because there might be more output pending.
+
+ Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to
+ decide how much data to accumulate before producing output, in order to
+ maximize compression.
+
+ If the parameter flush is set to Z_SYNC_FLUSH, all pending output is
+ flushed to the output buffer and the output is aligned on a byte boundary, so
+ that the decompressor can get all input data available so far. (In
+ particular avail_in is zero after the call if enough output space has been
+ provided before the call.) Flushing may degrade compression for some
+ compression algorithms and so it should be used only when necessary. This
+ completes the current deflate block and follows it with an empty stored block
+ that is three bits plus filler bits to the next byte, followed by four bytes
+ (00 00 ff ff).
+
+ If flush is set to Z_PARTIAL_FLUSH, all pending output is flushed to the
+ output buffer, but the output is not aligned to a byte boundary. All of the
+ input data so far will be available to the decompressor, as for Z_SYNC_FLUSH.
+ This completes the current deflate block and follows it with an empty fixed
+ codes block that is 10 bits long. This assures that enough bytes are output
+ in order for the decompressor to finish the block before the empty fixed code
+ block.
+
+ If flush is set to Z_BLOCK, a deflate block is completed and emitted, as
+ for Z_SYNC_FLUSH, but the output is not aligned on a byte boundary, and up to
+ seven bits of the current block are held to be written as the next byte after
+ the next deflate block is completed. In this case, the decompressor may not
+ be provided enough bits at this point in order to complete decompression of
+ the data provided so far to the compressor. It may need to wait for the next
+ block to be emitted. This is for advanced applications that need to control
+ the emission of deflate blocks.
+
+ If flush is set to Z_FULL_FLUSH, all output is flushed as with
+ Z_SYNC_FLUSH, and the compression state is reset so that decompression can
+ restart from this point if previous compressed data has been damaged or if
+ random access is desired. Using Z_FULL_FLUSH too often can seriously degrade
+ compression.
+
+ If deflate returns with avail_out == 0, this function must be called again
+ with the same value of the flush parameter and more output space (updated
+ avail_out), until the flush is complete (deflate returns with non-zero
+ avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that
+ avail_out is greater than six to avoid repeated flush markers due to
+ avail_out == 0 on return.
+
+ If the parameter flush is set to Z_FINISH, pending input is processed,
+ pending output is flushed and deflate returns with Z_STREAM_END if there was
+ enough output space; if deflate returns with Z_OK, this function must be
+ called again with Z_FINISH and more output space (updated avail_out) but no
+ more input data, until it returns with Z_STREAM_END or an error. After
+ deflate has returned Z_STREAM_END, the only possible operations on the stream
+ are deflateReset or deflateEnd.
+
+ Z_FINISH can be used immediately after deflateInit if all the compression
+ is to be done in a single step. In this case, avail_out must be at least the
+ value returned by deflateBound (see below). If deflate does not return
+ Z_STREAM_END, then it must be called again as described above.
+
+ deflate() sets strm->adler to the adler32 checksum of all input read
+ so far (that is, total_in bytes).
+
+ deflate() may update strm->data_type if it can make a good guess about
+ the input data type (Z_BINARY or Z_TEXT). In doubt, the data is considered
+ binary. This field is only for information purposes and does not affect the
+ compression algorithm in any manner.
+
+ deflate() returns Z_OK if some progress has been made (more input
+ processed or more output produced), Z_STREAM_END if all input has been
+ consumed and all output has been produced (only when flush is set to
+ Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example
+ if next_in or next_out was Z_NULL), Z_BUF_ERROR if no progress is possible
+ (for example avail_in or avail_out was zero). Note that Z_BUF_ERROR is not
+ fatal, and deflate() can be called again with more input and more output
+ space to continue compressing.
+*/
+
+
+ZEXTERN int ZEXPORT deflateEnd OF((z_streamp strm));
+/*
+ All dynamically allocated data structures for this stream are freed.
+ This function discards any unprocessed input and does not flush any pending
+ output.
+
+ deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the
+ stream state was inconsistent, Z_DATA_ERROR if the stream was freed
+ prematurely (some input or output was discarded). In the error case, msg
+ may be set but then points to a static string (which must not be
+ deallocated).
+*/
+
+
+/*
+ZEXTERN int ZEXPORT inflateInit OF((z_streamp strm));
+
+ Initializes the internal stream state for decompression. The fields
+ next_in, avail_in, zalloc, zfree and opaque must be initialized before by
+ the caller. If next_in is not Z_NULL and avail_in is large enough (the
+ exact value depends on the compression method), inflateInit determines the
+ compression method from the zlib header and allocates all data structures
+ accordingly; otherwise the allocation will be deferred to the first call of
+ inflate. If zalloc and zfree are set to Z_NULL, inflateInit updates them to
+ use default allocation functions.
+
+ inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_VERSION_ERROR if the zlib library version is incompatible with the
+ version assumed by the caller, or Z_STREAM_ERROR if the parameters are
+ invalid, such as a null pointer to the structure. msg is set to null if
+ there is no error message. inflateInit does not perform any decompression
+ apart from possibly reading the zlib header if present: actual decompression
+ will be done by inflate(). (So next_in and avail_in may be modified, but
+ next_out and avail_out are unused and unchanged.) The current implementation
+ of inflateInit() does not process any header information -- that is deferred
+ until inflate() is called.
+*/
+
+
+ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush));
+/*
+ inflate decompresses as much data as possible, and stops when the input
+ buffer becomes empty or the output buffer becomes full. It may introduce
+ some output latency (reading input without producing any output) except when
+ forced to flush.
+
+ The detailed semantics are as follows. inflate performs one or both of the
+ following actions:
+
+ - Decompress more input starting at next_in and update next_in and avail_in
+ accordingly. If not all input can be processed (because there is not
+ enough room in the output buffer), next_in is updated and processing will
+ resume at this point for the next call of inflate().
+
+ - Provide more output starting at next_out and update next_out and avail_out
+ accordingly. inflate() provides as much output as possible, until there is
+ no more input data or no more space in the output buffer (see below about
+ the flush parameter).
+
+ Before the call of inflate(), the application should ensure that at least
+ one of the actions is possible, by providing more input and/or consuming more
+ output, and updating the next_* and avail_* values accordingly. The
+ application can consume the uncompressed output when it wants, for example
+ when the output buffer is full (avail_out == 0), or after each call of
+ inflate(). If inflate returns Z_OK and with zero avail_out, it must be
+ called again after making room in the output buffer because there might be
+ more output pending.
+
+ The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, Z_FINISH,
+ Z_BLOCK, or Z_TREES. Z_SYNC_FLUSH requests that inflate() flush as much
+ output as possible to the output buffer. Z_BLOCK requests that inflate()
+ stop if and when it gets to the next deflate block boundary. When decoding
+ the zlib or gzip format, this will cause inflate() to return immediately
+ after the header and before the first block. When doing a raw inflate,
+ inflate() will go ahead and process the first block, and will return when it
+ gets to the end of that block, or when it runs out of data.
+
+ The Z_BLOCK option assists in appending to or combining deflate streams.
+ Also to assist in this, on return inflate() will set strm->data_type to the
+ number of unused bits in the last byte taken from strm->next_in, plus 64 if
+ inflate() is currently decoding the last block in the deflate stream, plus
+ 128 if inflate() returned immediately after decoding an end-of-block code or
+ decoding the complete header up to just before the first byte of the deflate
+ stream. The end-of-block will not be indicated until all of the uncompressed
+ data from that block has been written to strm->next_out. The number of
+ unused bits may in general be greater than seven, except when bit 7 of
+ data_type is set, in which case the number of unused bits will be less than
+ eight. data_type is set as noted here every time inflate() returns for all
+ flush options, and so can be used to determine the amount of currently
+ consumed input in bits.
+
+ The Z_TREES option behaves as Z_BLOCK does, but it also returns when the
+ end of each deflate block header is reached, before any actual data in that
+ block is decoded. This allows the caller to determine the length of the
+ deflate block header for later use in random access within a deflate block.
+ 256 is added to the value of strm->data_type when inflate() returns
+ immediately after reaching the end of the deflate block header.
+
+ inflate() should normally be called until it returns Z_STREAM_END or an
+ error. However if all decompression is to be performed in a single step (a
+ single call of inflate), the parameter flush should be set to Z_FINISH. In
+ this case all pending input is processed and all pending output is flushed;
+ avail_out must be large enough to hold all the uncompressed data. (The size
+ of the uncompressed data may have been saved by the compressor for this
+ purpose.) The next operation on this stream must be inflateEnd to deallocate
+ the decompression state. The use of Z_FINISH is never required, but can be
+ used to inform inflate that a faster approach may be used for the single
+ inflate() call.
+
+ In this implementation, inflate() always flushes as much output as
+ possible to the output buffer, and always uses the faster approach on the
+ first call. So the only effect of the flush parameter in this implementation
+ is on the return value of inflate(), as noted below, or when it returns early
+ because Z_BLOCK or Z_TREES is used.
+
+ If a preset dictionary is needed after this call (see inflateSetDictionary
+ below), inflate sets strm->adler to the adler32 checksum of the dictionary
+ chosen by the compressor and returns Z_NEED_DICT; otherwise it sets
+ strm->adler to the adler32 checksum of all output produced so far (that is,
+ total_out bytes) and returns Z_OK, Z_STREAM_END or an error code as described
+ below. At the end of the stream, inflate() checks that its computed adler32
+ checksum is equal to that saved by the compressor and returns Z_STREAM_END
+ only if the checksum is correct.
+
+ inflate() can decompress and check either zlib-wrapped or gzip-wrapped
+ deflate data. The header type is detected automatically, if requested when
+ initializing with inflateInit2(). Any information contained in the gzip
+ header is not retained, so applications that need that information should
+ instead use raw inflate, see inflateInit2() below, or inflateBack() and
+ perform their own processing of the gzip header and trailer.
+
+ inflate() returns Z_OK if some progress has been made (more input processed
+ or more output produced), Z_STREAM_END if the end of the compressed data has
+ been reached and all uncompressed output has been produced, Z_NEED_DICT if a
+ preset dictionary is needed at this point, Z_DATA_ERROR if the input data was
+ corrupted (input stream not conforming to the zlib format or incorrect check
+ value), Z_STREAM_ERROR if the stream structure was inconsistent (for example
+ next_in or next_out was Z_NULL), Z_MEM_ERROR if there was not enough memory,
+ Z_BUF_ERROR if no progress is possible or if there was not enough room in the
+ output buffer when Z_FINISH is used. Note that Z_BUF_ERROR is not fatal, and
+ inflate() can be called again with more input and more output space to
+ continue decompressing. If Z_DATA_ERROR is returned, the application may
+ then call inflateSync() to look for a good compression block if a partial
+ recovery of the data is desired.
+*/
+
+
+ZEXTERN int ZEXPORT inflateEnd OF((z_streamp strm));
+/*
+ All dynamically allocated data structures for this stream are freed.
+ This function discards any unprocessed input and does not flush any pending
+ output.
+
+ inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state
+ was inconsistent. In the error case, msg may be set but then points to a
+ static string (which must not be deallocated).
+*/
+
+
+ /* Advanced functions */
+
+/*
+ The following functions are needed only in some special applications.
+*/
+
+/*
+ZEXTERN int ZEXPORT deflateInit2 OF((z_streamp strm,
+ int level,
+ int method,
+ int windowBits,
+ int memLevel,
+ int strategy));
+
+ This is another version of deflateInit with more compression options. The
+ fields next_in, zalloc, zfree and opaque must be initialized before by the
+ caller.
+
+ The method parameter is the compression method. It must be Z_DEFLATED in
+ this version of the library.
+
+ The windowBits parameter is the base two logarithm of the window size
+ (the size of the history buffer). It should be in the range 8..15 for this
+ version of the library. Larger values of this parameter result in better
+ compression at the expense of memory usage. The default value is 15 if
+ deflateInit is used instead.
+
+ windowBits can also be -8..-15 for raw deflate. In this case, -windowBits
+ determines the window size. deflate() will then generate raw deflate data
+ with no zlib header or trailer, and will not compute an adler32 check value.
+
+ windowBits can also be greater than 15 for optional gzip encoding. Add
+ 16 to windowBits to write a simple gzip header and trailer around the
+ compressed data instead of a zlib wrapper. The gzip header will have no
+ file name, no extra data, no comment, no modification time (set to zero), no
+ header crc, and the operating system will be set to 255 (unknown). If a
+ gzip stream is being written, strm->adler is a crc32 instead of an adler32.
+
+ The memLevel parameter specifies how much memory should be allocated
+ for the internal compression state. memLevel=1 uses minimum memory but is
+ slow and reduces compression ratio; memLevel=9 uses maximum memory for
+ optimal speed. The default value is 8. See zconf.h for total memory usage
+ as a function of windowBits and memLevel.
+
+ The strategy parameter is used to tune the compression algorithm. Use the
+ value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a
+ filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no
+ string match), or Z_RLE to limit match distances to one (run-length
+ encoding). Filtered data consists mostly of small values with a somewhat
+ random distribution. In this case, the compression algorithm is tuned to
+ compress them better. The effect of Z_FILTERED is to force more Huffman
+ coding and less string matching; it is somewhat intermediate between
+ Z_DEFAULT_STRATEGY and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as
+ fast as Z_HUFFMAN_ONLY, but give better compression for PNG image data. The
+ strategy parameter only affects the compression ratio but not the
+ correctness of the compressed output even if it is not set appropriately.
+ Z_FIXED prevents the use of dynamic Huffman codes, allowing for a simpler
+ decoder for special applications.
+
+ deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_STREAM_ERROR if any parameter is invalid (such as an invalid
+ method), or Z_VERSION_ERROR if the zlib library version (zlib_version) is
+ incompatible with the version assumed by the caller (ZLIB_VERSION). msg is
+ set to null if there is no error message. deflateInit2 does not perform any
+ compression: this will be done by deflate().
+*/
+
+ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm,
+ const Bytef *dictionary,
+ uInt dictLength));
+/*
+ Initializes the compression dictionary from the given byte sequence
+ without producing any compressed output. This function must be called
+ immediately after deflateInit, deflateInit2 or deflateReset, before any call
+ of deflate. The compressor and decompressor must use exactly the same
+ dictionary (see inflateSetDictionary).
+
+ The dictionary should consist of strings (byte sequences) that are likely
+ to be encountered later in the data to be compressed, with the most commonly
+ used strings preferably put towards the end of the dictionary. Using a
+ dictionary is most useful when the data to be compressed is short and can be
+ predicted with good accuracy; the data can then be compressed better than
+ with the default empty dictionary.
+
+ Depending on the size of the compression data structures selected by
+ deflateInit or deflateInit2, a part of the dictionary may in effect be
+ discarded, for example if the dictionary is larger than the window size
+ provided in deflateInit or deflateInit2. Thus the strings most likely to be
+ useful should be put at the end of the dictionary, not at the front. In
+ addition, the current implementation of deflate will use at most the window
+ size minus 262 bytes of the provided dictionary.
+
+ Upon return of this function, strm->adler is set to the adler32 value
+ of the dictionary; the decompressor may later use this value to determine
+ which dictionary has been used by the compressor. (The adler32 value
+ applies to the whole dictionary even if only a subset of the dictionary is
+ actually used by the compressor.) If a raw deflate was requested, then the
+ adler32 value is not computed and strm->adler is not set.
+
+ deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a
+ parameter is invalid (e.g. dictionary being Z_NULL) or the stream state is
+ inconsistent (for example if deflate has already been called for this stream
+ or if the compression method is bsort). deflateSetDictionary does not
+ perform any compression: this will be done by deflate().
+*/
+
+ZEXTERN int ZEXPORT deflateCopy OF((z_streamp dest,
+ z_streamp source));
+/*
+ Sets the destination stream as a complete copy of the source stream.
+
+ This function can be useful when several compression strategies will be
+ tried, for example when there are several ways of pre-processing the input
+ data with a filter. The streams that will be discarded should then be freed
+ by calling deflateEnd. Note that deflateCopy duplicates the internal
+ compression state which can be quite large, so this strategy is slow and can
+ consume lots of memory.
+
+ deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not
+ enough memory, Z_STREAM_ERROR if the source stream state was inconsistent
+ (such as zalloc being Z_NULL). msg is left unchanged in both source and
+ destination.
+*/
+
+ZEXTERN int ZEXPORT deflateReset OF((z_streamp strm));
+/*
+ This function is equivalent to deflateEnd followed by deflateInit,
+ but does not free and reallocate all the internal compression state. The
+ stream will keep the same compression level and any other attributes that
+ may have been set by deflateInit2.
+
+ deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent (such as zalloc or state being Z_NULL).
+*/
+
+ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm,
+ int level,
+ int strategy));
+/*
+ Dynamically update the compression level and compression strategy. The
+ interpretation of level and strategy is as in deflateInit2. This can be
+ used to switch between compression and straight copy of the input data, or
+ to switch to a different kind of input data requiring a different strategy.
+ If the compression level is changed, the input available so far is
+ compressed with the old level (and may be flushed); the new level will take
+ effect only at the next call of deflate().
+
+ Before the call of deflateParams, the stream state must be set as for
+ a call of deflate(), since the currently available input may have to be
+ compressed and flushed. In particular, strm->avail_out must be non-zero.
+
+ deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source
+ stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR if
+ strm->avail_out was zero.
+*/
+
+ZEXTERN int ZEXPORT deflateTune OF((z_streamp strm,
+ int good_length,
+ int max_lazy,
+ int nice_length,
+ int max_chain));
+/*
+ Fine tune deflate's internal compression parameters. This should only be
+ used by someone who understands the algorithm used by zlib's deflate for
+ searching for the best matching string, and even then only by the most
+ fanatic optimizer trying to squeeze out the last compressed bit for their
+ specific input data. Read the deflate.c source code for the meaning of the
+ max_lazy, good_length, nice_length, and max_chain parameters.
+
+ deflateTune() can be called after deflateInit() or deflateInit2(), and
+ returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream.
+ */
+
+ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm,
+ uLong sourceLen));
+/*
+ deflateBound() returns an upper bound on the compressed size after
+ deflation of sourceLen bytes. It must be called after deflateInit() or
+ deflateInit2(), and after deflateSetHeader(), if used. This would be used
+ to allocate an output buffer for deflation in a single pass, and so would be
+ called before deflate().
+*/
+
+ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm,
+ int bits,
+ int value));
+/*
+ deflatePrime() inserts bits in the deflate output stream. The intent
+ is that this function is used to start off the deflate output with the bits
+ leftover from a previous deflate stream when appending to it. As such, this
+ function can only be used for raw deflate, and must be used before the first
+ deflate() call after a deflateInit2() or deflateReset(). bits must be less
+ than or equal to 16, and that many of the least significant bits of value
+ will be inserted in the output.
+
+ deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm,
+ gz_headerp head));
+/*
+ deflateSetHeader() provides gzip header information for when a gzip
+ stream is requested by deflateInit2(). deflateSetHeader() may be called
+ after deflateInit2() or deflateReset() and before the first call of
+ deflate(). The text, time, os, extra field, name, and comment information
+ in the provided gz_header structure are written to the gzip header (xflag is
+ ignored -- the extra flags are set according to the compression level). The
+ caller must assure that, if not Z_NULL, name and comment are terminated with
+ a zero byte, and that if extra is not Z_NULL, that extra_len bytes are
+ available there. If hcrc is true, a gzip header crc is included. Note that
+ the current versions of the command-line version of gzip (up through version
+ 1.3.x) do not support header crc's, and will report that it is a "multi-part
+ gzip file" and give up.
+
+ If deflateSetHeader is not used, the default gzip header has text false,
+ the time set to zero, and os set to 255, with no extra, name, or comment
+ fields. The gzip header is returned to the default state by deflateReset().
+
+ deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+/*
+ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm,
+ int windowBits));
+
+ This is another version of inflateInit with an extra parameter. The
+ fields next_in, avail_in, zalloc, zfree and opaque must be initialized
+ before by the caller.
+
+ The windowBits parameter is the base two logarithm of the maximum window
+ size (the size of the history buffer). It should be in the range 8..15 for
+ this version of the library. The default value is 15 if inflateInit is used
+ instead. windowBits must be greater than or equal to the windowBits value
+ provided to deflateInit2() while compressing, or it must be equal to 15 if
+ deflateInit2() was not used. If a compressed stream with a larger window
+ size is given as input, inflate() will return with the error code
+ Z_DATA_ERROR instead of trying to allocate a larger window.
+
+ windowBits can also be zero to request that inflate use the window size in
+ the zlib header of the compressed stream.
+
+ windowBits can also be -8..-15 for raw inflate. In this case, -windowBits
+ determines the window size. inflate() will then process raw deflate data,
+ not looking for a zlib or gzip header, not generating a check value, and not
+ looking for any check values for comparison at the end of the stream. This
+ is for use with other formats that use the deflate compressed data format
+ such as zip. Those formats provide their own check values. If a custom
+ format is developed using the raw deflate format for compressed data, it is
+ recommended that a check value such as an adler32 or a crc32 be applied to
+ the uncompressed data as is done in the zlib, gzip, and zip formats. For
+ most applications, the zlib format should be used as is. Note that comments
+ above on the use in deflateInit2() applies to the magnitude of windowBits.
+
+ windowBits can also be greater than 15 for optional gzip decoding. Add
+ 32 to windowBits to enable zlib and gzip decoding with automatic header
+ detection, or add 16 to decode only the gzip format (the zlib format will
+ return a Z_DATA_ERROR). If a gzip stream is being decoded, strm->adler is a
+ crc32 instead of an adler32.
+
+ inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_VERSION_ERROR if the zlib library version is incompatible with the
+ version assumed by the caller, or Z_STREAM_ERROR if the parameters are
+ invalid, such as a null pointer to the structure. msg is set to null if
+ there is no error message. inflateInit2 does not perform any decompression
+ apart from possibly reading the zlib header if present: actual decompression
+ will be done by inflate(). (So next_in and avail_in may be modified, but
+ next_out and avail_out are unused and unchanged.) The current implementation
+ of inflateInit2() does not process any header information -- that is
+ deferred until inflate() is called.
+*/
+
+ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm,
+ const Bytef *dictionary,
+ uInt dictLength));
+/*
+ Initializes the decompression dictionary from the given uncompressed byte
+ sequence. This function must be called immediately after a call of inflate,
+ if that call returned Z_NEED_DICT. The dictionary chosen by the compressor
+ can be determined from the adler32 value returned by that call of inflate.
+ The compressor and decompressor must use exactly the same dictionary (see
+ deflateSetDictionary). For raw inflate, this function can be called
+ immediately after inflateInit2() or inflateReset() and before any call of
+ inflate() to set the dictionary. The application must insure that the
+ dictionary that was used for compression is provided.
+
+ inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a
+ parameter is invalid (e.g. dictionary being Z_NULL) or the stream state is
+ inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the
+ expected one (incorrect adler32 value). inflateSetDictionary does not
+ perform any decompression: this will be done by subsequent calls of
+ inflate().
+*/
+
+ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm));
+/*
+ Skips invalid compressed data until a full flush point (see above the
+ description of deflate with Z_FULL_FLUSH) can be found, or until all
+ available input is skipped. No output is provided.
+
+ inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR
+ if no more input was provided, Z_DATA_ERROR if no flush point has been
+ found, or Z_STREAM_ERROR if the stream structure was inconsistent. In the
+ success case, the application may save the current current value of total_in
+ which indicates where valid compressed data was found. In the error case,
+ the application may repeatedly call inflateSync, providing more input each
+ time, until success or end of the input data.
+*/
+
+ZEXTERN int ZEXPORT inflateCopy OF((z_streamp dest,
+ z_streamp source));
+/*
+ Sets the destination stream as a complete copy of the source stream.
+
+ This function can be useful when randomly accessing a large stream. The
+ first pass through the stream can periodically record the inflate state,
+ allowing restarting inflate at those points when randomly accessing the
+ stream.
+
+ inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not
+ enough memory, Z_STREAM_ERROR if the source stream state was inconsistent
+ (such as zalloc being Z_NULL). msg is left unchanged in both source and
+ destination.
+*/
+
+ZEXTERN int ZEXPORT inflateReset OF((z_streamp strm));
+/*
+ This function is equivalent to inflateEnd followed by inflateInit,
+ but does not free and reallocate all the internal decompression state. The
+ stream will keep attributes that may have been set by inflateInit2.
+
+ inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent (such as zalloc or state being Z_NULL).
+*/
+
+ZEXTERN int ZEXPORT inflateReset2 OF((z_streamp strm,
+ int windowBits));
+/*
+ This function is the same as inflateReset, but it also permits changing
+ the wrap and window size requests. The windowBits parameter is interpreted
+ the same as it is for inflateInit2.
+
+ inflateReset2 returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent (such as zalloc or state being Z_NULL), or if
+ the windowBits parameter is invalid.
+*/
+
+ZEXTERN int ZEXPORT inflatePrime OF((z_streamp strm,
+ int bits,
+ int value));
+/*
+ This function inserts bits in the inflate input stream. The intent is
+ that this function is used to start inflating at a bit position in the
+ middle of a byte. The provided bits will be used before any bytes are used
+ from next_in. This function should only be used with raw inflate, and
+ should be used before the first inflate() call after inflateInit2() or
+ inflateReset(). bits must be less than or equal to 16, and that many of the
+ least significant bits of value will be inserted in the input.
+
+ If bits is negative, then the input stream bit buffer is emptied. Then
+ inflatePrime() can be called again to put bits in the buffer. This is used
+ to clear out bits leftover after feeding inflate a block description prior
+ to feeding inflate codes.
+
+ inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+ZEXTERN long ZEXPORT inflateMark OF((z_streamp strm));
+/*
+ This function returns two values, one in the lower 16 bits of the return
+ value, and the other in the remaining upper bits, obtained by shifting the
+ return value down 16 bits. If the upper value is -1 and the lower value is
+ zero, then inflate() is currently decoding information outside of a block.
+ If the upper value is -1 and the lower value is non-zero, then inflate is in
+ the middle of a stored block, with the lower value equaling the number of
+ bytes from the input remaining to copy. If the upper value is not -1, then
+ it is the number of bits back from the current bit position in the input of
+ the code (literal or length/distance pair) currently being processed. In
+ that case the lower value is the number of bytes already emitted for that
+ code.
+
+ A code is being processed if inflate is waiting for more input to complete
+ decoding of the code, or if it has completed decoding but is waiting for
+ more output space to write the literal or match data.
+
+ inflateMark() is used to mark locations in the input data for random
+ access, which may be at bit positions, and to note those cases where the
+ output of a code may span boundaries of random access blocks. The current
+ location in the input stream can be determined from avail_in and data_type
+ as noted in the description for the Z_BLOCK flush parameter for inflate.
+
+ inflateMark returns the value noted above or -1 << 16 if the provided
+ source stream state was inconsistent.
+*/
+
+ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm,
+ gz_headerp head));
+/*
+ inflateGetHeader() requests that gzip header information be stored in the
+ provided gz_header structure. inflateGetHeader() may be called after
+ inflateInit2() or inflateReset(), and before the first call of inflate().
+ As inflate() processes the gzip stream, head->done is zero until the header
+ is completed, at which time head->done is set to one. If a zlib stream is
+ being decoded, then head->done is set to -1 to indicate that there will be
+ no gzip header information forthcoming. Note that Z_BLOCK or Z_TREES can be
+ used to force inflate() to return immediately after header processing is
+ complete and before any actual data is decompressed.
+
+ The text, time, xflags, and os fields are filled in with the gzip header
+ contents. hcrc is set to true if there is a header CRC. (The header CRC
+ was valid if done is set to one.) If extra is not Z_NULL, then extra_max
+ contains the maximum number of bytes to write to extra. Once done is true,
+ extra_len contains the actual extra field length, and extra contains the
+ extra field, or that field truncated if extra_max is less than extra_len.
+ If name is not Z_NULL, then up to name_max characters are written there,
+ terminated with a zero unless the length is greater than name_max. If
+ comment is not Z_NULL, then up to comm_max characters are written there,
+ terminated with a zero unless the length is greater than comm_max. When any
+ of extra, name, or comment are not Z_NULL and the respective field is not
+ present in the header, then that field is set to Z_NULL to signal its
+ absence. This allows the use of deflateSetHeader() with the returned
+ structure to duplicate the header. However if those fields are set to
+ allocated memory, then the application will need to save those pointers
+ elsewhere so that they can be eventually freed.
+
+ If inflateGetHeader is not used, then the header information is simply
+ discarded. The header is always checked for validity, including the header
+ CRC if present. inflateReset() will reset the process to discard the header
+ information. The application would need to call inflateGetHeader() again to
+ retrieve the header from the next gzip stream.
+
+ inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+/*
+ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits,
+ unsigned char FAR *window));
+
+ Initialize the internal stream state for decompression using inflateBack()
+ calls. The fields zalloc, zfree and opaque in strm must be initialized
+ before the call. If zalloc and zfree are Z_NULL, then the default library-
+ derived memory allocation routines are used. windowBits is the base two
+ logarithm of the window size, in the range 8..15. window is a caller
+ supplied buffer of that size. Except for special applications where it is
+ assured that deflate was used with small window sizes, windowBits must be 15
+ and a 32K byte window must be supplied to be able to decompress general
+ deflate streams.
+
+ See inflateBack() for the usage of these routines.
+
+ inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of
+ the paramaters are invalid, Z_MEM_ERROR if the internal state could not be
+ allocated, or Z_VERSION_ERROR if the version of the library does not match
+ the version of the header file.
+*/
+
+typedef unsigned (*in_func) OF((void FAR *, unsigned char FAR * FAR *));
+typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned));
+
+ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm,
+ in_func in, void FAR *in_desc,
+ out_func out, void FAR *out_desc));
+/*
+ inflateBack() does a raw inflate with a single call using a call-back
+ interface for input and output. This is more efficient than inflate() for
+ file i/o applications in that it avoids copying between the output and the
+ sliding window by simply making the window itself the output buffer. This
+ function trusts the application to not change the output buffer passed by
+ the output function, at least until inflateBack() returns.
+
+ inflateBackInit() must be called first to allocate the internal state
+ and to initialize the state with the user-provided window buffer.
+ inflateBack() may then be used multiple times to inflate a complete, raw
+ deflate stream with each call. inflateBackEnd() is then called to free the
+ allocated state.
+
+ A raw deflate stream is one with no zlib or gzip header or trailer.
+ This routine would normally be used in a utility that reads zip or gzip
+ files and writes out uncompressed files. The utility would decode the
+ header and process the trailer on its own, hence this routine expects only
+ the raw deflate stream to decompress. This is different from the normal
+ behavior of inflate(), which expects either a zlib or gzip header and
+ trailer around the deflate stream.
+
+ inflateBack() uses two subroutines supplied by the caller that are then
+ called by inflateBack() for input and output. inflateBack() calls those
+ routines until it reads a complete deflate stream and writes out all of the
+ uncompressed data, or until it encounters an error. The function's
+ parameters and return types are defined above in the in_func and out_func
+ typedefs. inflateBack() will call in(in_desc, &buf) which should return the
+ number of bytes of provided input, and a pointer to that input in buf. If
+ there is no input available, in() must return zero--buf is ignored in that
+ case--and inflateBack() will return a buffer error. inflateBack() will call
+ out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out()
+ should return zero on success, or non-zero on failure. If out() returns
+ non-zero, inflateBack() will return with an error. Neither in() nor out()
+ are permitted to change the contents of the window provided to
+ inflateBackInit(), which is also the buffer that out() uses to write from.
+ The length written by out() will be at most the window size. Any non-zero
+ amount of input may be provided by in().
+
+ For convenience, inflateBack() can be provided input on the first call by
+ setting strm->next_in and strm->avail_in. If that input is exhausted, then
+ in() will be called. Therefore strm->next_in must be initialized before
+ calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called
+ immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in
+ must also be initialized, and then if strm->avail_in is not zero, input will
+ initially be taken from strm->next_in[0 .. strm->avail_in - 1].
+
+ The in_desc and out_desc parameters of inflateBack() is passed as the
+ first parameter of in() and out() respectively when they are called. These
+ descriptors can be optionally used to pass any information that the caller-
+ supplied in() and out() functions need to do their job.
+
+ On return, inflateBack() will set strm->next_in and strm->avail_in to
+ pass back any unused input that was provided by the last in() call. The
+ return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR
+ if in() or out() returned an error, Z_DATA_ERROR if there was a format error
+ in the deflate stream (in which case strm->msg is set to indicate the nature
+ of the error), or Z_STREAM_ERROR if the stream was not properly initialized.
+ In the case of Z_BUF_ERROR, an input or output error can be distinguished
+ using strm->next_in which will be Z_NULL only if in() returned an error. If
+ strm->next_in is not Z_NULL, then the Z_BUF_ERROR was due to out() returning
+ non-zero. (in() will always be called before out(), so strm->next_in is
+ assured to be defined if out() returns non-zero.) Note that inflateBack()
+ cannot return Z_OK.
+*/
+
+ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm));
+/*
+ All memory allocated by inflateBackInit() is freed.
+
+ inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream
+ state was inconsistent.
+*/
+
+ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void));
+/* Return flags indicating compile-time options.
+
+ Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other:
+ 1.0: size of uInt
+ 3.2: size of uLong
+ 5.4: size of voidpf (pointer)
+ 7.6: size of z_off_t
+
+ Compiler, assembler, and debug options:
+ 8: DEBUG
+ 9: ASMV or ASMINF -- use ASM code
+ 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention
+ 11: 0 (reserved)
+
+ One-time table building (smaller code, but not thread-safe if true):
+ 12: BUILDFIXED -- build static block decoding tables when needed
+ 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed
+ 14,15: 0 (reserved)
+
+ Library content (indicates missing functionality):
+ 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking
+ deflate code when not needed)
+ 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect
+ and decode gzip streams (to avoid linking crc code)
+ 18-19: 0 (reserved)
+
+ Operation variations (changes in library functionality):
+ 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate
+ 21: FASTEST -- deflate algorithm with only one, lowest compression level
+ 22,23: 0 (reserved)
+
+ The sprintf variant used by gzprintf (zero is best):
+ 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format
+ 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure!
+ 26: 0 = returns value, 1 = void -- 1 means inferred string length returned
+
+ Remainder:
+ 27-31: 0 (reserved)
+ */
+
+
+ /* utility functions */
+
+/*
+ The following utility functions are implemented on top of the basic
+ stream-oriented functions. To simplify the interface, some default options
+ are assumed (compression level and memory usage, standard memory allocation
+ functions). The source code of these utility functions can be modified if
+ you need special options.
+*/
+
+ZEXTERN int ZEXPORT compress OF((Bytef *dest, uLongf *destLen,
+ const Bytef *source, uLong sourceLen));
+/*
+ Compresses the source buffer into the destination buffer. sourceLen is
+ the byte length of the source buffer. Upon entry, destLen is the total size
+ of the destination buffer, which must be at least the value returned by
+ compressBound(sourceLen). Upon exit, destLen is the actual size of the
+ compressed buffer.
+
+ compress returns Z_OK if success, Z_MEM_ERROR if there was not
+ enough memory, Z_BUF_ERROR if there was not enough room in the output
+ buffer.
+*/
+
+ZEXTERN int ZEXPORT compress2 OF((Bytef *dest, uLongf *destLen,
+ const Bytef *source, uLong sourceLen,
+ int level));
+/*
+ Compresses the source buffer into the destination buffer. The level
+ parameter has the same meaning as in deflateInit. sourceLen is the byte
+ length of the source buffer. Upon entry, destLen is the total size of the
+ destination buffer, which must be at least the value returned by
+ compressBound(sourceLen). Upon exit, destLen is the actual size of the
+ compressed buffer.
+
+ compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_BUF_ERROR if there was not enough room in the output buffer,
+ Z_STREAM_ERROR if the level parameter is invalid.
+*/
+
+ZEXTERN uLong ZEXPORT compressBound OF((uLong sourceLen));
+/*
+ compressBound() returns an upper bound on the compressed size after
+ compress() or compress2() on sourceLen bytes. It would be used before a
+ compress() or compress2() call to allocate the destination buffer.
+*/
+
+ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen,
+ const Bytef *source, uLong sourceLen));
+/*
+ Decompresses the source buffer into the destination buffer. sourceLen is
+ the byte length of the source buffer. Upon entry, destLen is the total size
+ of the destination buffer, which must be large enough to hold the entire
+ uncompressed data. (The size of the uncompressed data must have been saved
+ previously by the compressor and transmitted to the decompressor by some
+ mechanism outside the scope of this compression library.) Upon exit, destLen
+ is the actual size of the uncompressed buffer.
+
+ uncompress returns Z_OK if success, Z_MEM_ERROR if there was not
+ enough memory, Z_BUF_ERROR if there was not enough room in the output
+ buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete.
+*/
+
+
+ /* gzip file access functions */
+
+/*
+ This library supports reading and writing files in gzip (.gz) format with
+ an interface similar to that of stdio, using the functions that start with
+ "gz". The gzip format is different from the zlib format. gzip is a gzip
+ wrapper, documented in RFC 1952, wrapped around a deflate stream.
+*/
+
+typedef voidp gzFile; /* opaque gzip file descriptor */
+
+/*
+ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode));
+
+ Opens a gzip (.gz) file for reading or writing. The mode parameter is as
+ in fopen ("rb" or "wb") but can also include a compression level ("wb9") or
+ a strategy: 'f' for filtered data as in "wb6f", 'h' for Huffman-only
+ compression as in "wb1h", 'R' for run-length encoding as in "wb1R", or 'F'
+ for fixed code compression as in "wb9F". (See the description of
+ deflateInit2 for more information about the strategy parameter.) Also "a"
+ can be used instead of "w" to request that the gzip stream that will be
+ written be appended to the file. "+" will result in an error, since reading
+ and writing to the same gzip file is not supported.
+
+ gzopen can be used to read a file which is not in gzip format; in this
+ case gzread will directly read from the file without decompression.
+
+ gzopen returns NULL if the file could not be opened, if there was
+ insufficient memory to allocate the gzFile state, or if an invalid mode was
+ specified (an 'r', 'w', or 'a' was not provided, or '+' was provided).
+ errno can be checked to determine if the reason gzopen failed was that the
+ file could not be opened.
+*/
+
+ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode));
+/*
+ gzdopen associates a gzFile with the file descriptor fd. File descriptors
+ are obtained from calls like open, dup, creat, pipe or fileno (if the file
+ has been previously opened with fopen). The mode parameter is as in gzopen.
+
+ The next call of gzclose on the returned gzFile will also close the file
+ descriptor fd, just like fclose(fdopen(fd, mode)) closes the file descriptor
+ fd. If you want to keep fd open, use fd = dup(fd_keep); gz = gzdopen(fd,
+ mode);. The duplicated descriptor should be saved to avoid a leak, since
+ gzdopen does not close fd if it fails.
+
+ gzdopen returns NULL if there was insufficient memory to allocate the
+ gzFile state, if an invalid mode was specified (an 'r', 'w', or 'a' was not
+ provided, or '+' was provided), or if fd is -1. The file descriptor is not
+ used until the next gz* read, write, seek, or close operation, so gzdopen
+ will not detect if fd is invalid (unless fd is -1).
+*/
+
+ZEXTERN int ZEXPORT gzbuffer OF((gzFile file, unsigned size));
+/*
+ Set the internal buffer size used by this library's functions. The
+ default buffer size is 8192 bytes. This function must be called after
+ gzopen() or gzdopen(), and before any other calls that read or write the
+ file. The buffer memory allocation is always deferred to the first read or
+ write. Two buffers are allocated, either both of the specified size when
+ writing, or one of the specified size and the other twice that size when
+ reading. A larger buffer size of, for example, 64K or 128K bytes will
+ noticeably increase the speed of decompression (reading).
+
+ The new buffer size also affects the maximum length for gzprintf().
+
+ gzbuffer() returns 0 on success, or -1 on failure, such as being called
+ too late.
+*/
+
+ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy));
+/*
+ Dynamically update the compression level or strategy. See the description
+ of deflateInit2 for the meaning of these parameters.
+
+ gzsetparams returns Z_OK if success, or Z_STREAM_ERROR if the file was not
+ opened for writing.
+*/
+
+ZEXTERN int ZEXPORT gzread OF((gzFile file, voidp buf, unsigned len));
+/*
+ Reads the given number of uncompressed bytes from the compressed file. If
+ the input file was not in gzip format, gzread copies the given number of
+ bytes into the buffer.
+
+ After reaching the end of a gzip stream in the input, gzread will continue
+ to read, looking for another gzip stream, or failing that, reading the rest
+ of the input file directly without decompression. The entire input file
+ will be read if gzread is called until it returns less than the requested
+ len.
+
+ gzread returns the number of uncompressed bytes actually read, less than
+ len for end of file, or -1 for error.
+*/
+
+ZEXTERN int ZEXPORT gzwrite OF((gzFile file,
+ voidpc buf, unsigned len));
+/*
+ Writes the given number of uncompressed bytes into the compressed file.
+ gzwrite returns the number of uncompressed bytes written or 0 in case of
+ error.
+*/
+
+ZEXTERN int ZEXPORTVA gzprintf OF((gzFile file, const char *format, ...));
+/*
+ Converts, formats, and writes the arguments to the compressed file under
+ control of the format string, as in fprintf. gzprintf returns the number of
+ uncompressed bytes actually written, or 0 in case of error. The number of
+ uncompressed bytes written is limited to 8191, or one less than the buffer
+ size given to gzbuffer(). The caller should assure that this limit is not
+ exceeded. If it is exceeded, then gzprintf() will return an error (0) with
+ nothing written. In this case, there may also be a buffer overflow with
+ unpredictable consequences, which is possible only if zlib was compiled with
+ the insecure functions sprintf() or vsprintf() because the secure snprintf()
+ or vsnprintf() functions were not available. This can be determined using
+ zlibCompileFlags().
+*/
+
+ZEXTERN int ZEXPORT gzputs OF((gzFile file, const char *s));
+/*
+ Writes the given null-terminated string to the compressed file, excluding
+ the terminating null character.
+
+ gzputs returns the number of characters written, or -1 in case of error.
+*/
+
+ZEXTERN char * ZEXPORT gzgets OF((gzFile file, char *buf, int len));
+/*
+ Reads bytes from the compressed file until len-1 characters are read, or a
+ newline character is read and transferred to buf, or an end-of-file
+ condition is encountered. If any characters are read or if len == 1, the
+ string is terminated with a null character. If no characters are read due
+ to an end-of-file or len < 1, then the buffer is left untouched.
+
+ gzgets returns buf which is a null-terminated string, or it returns NULL
+ for end-of-file or in case of error. If there was an error, the contents at
+ buf are indeterminate.
+*/
+
+ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c));
+/*
+ Writes c, converted to an unsigned char, into the compressed file. gzputc
+ returns the value that was written, or -1 in case of error.
+*/
+
+ZEXTERN int ZEXPORT gzgetc OF((gzFile file));
+/*
+ Reads one byte from the compressed file. gzgetc returns this byte or -1
+ in case of end of file or error.
+*/
+
+ZEXTERN int ZEXPORT gzungetc OF((int c, gzFile file));
+/*
+ Push one character back onto the stream to be read as the first character
+ on the next read. At least one character of push-back is allowed.
+ gzungetc() returns the character pushed, or -1 on failure. gzungetc() will
+ fail if c is -1, and may fail if a character has been pushed but not read
+ yet. If gzungetc is used immediately after gzopen or gzdopen, at least the
+ output buffer size of pushed characters is allowed. (See gzbuffer above.)
+ The pushed character will be discarded if the stream is repositioned with
+ gzseek() or gzrewind().
+*/
+
+ZEXTERN int ZEXPORT gzflush OF((gzFile file, int flush));
+/*
+ Flushes all pending output into the compressed file. The parameter flush
+ is as in the deflate() function. The return value is the zlib error number
+ (see function gzerror below). gzflush is only permitted when writing.
+
+ If the flush parameter is Z_FINISH, the remaining data is written and the
+ gzip stream is completed in the output. If gzwrite() is called again, a new
+ gzip stream will be started in the output. gzread() is able to read such
+ concatented gzip streams.
+
+ gzflush should be called only when strictly necessary because it will
+ degrade compression if called too often.
+*/
+
+/*
+ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile file,
+ z_off_t offset, int whence));
+
+ Sets the starting position for the next gzread or gzwrite on the given
+ compressed file. The offset represents a number of bytes in the
+ uncompressed data stream. The whence parameter is defined as in lseek(2);
+ the value SEEK_END is not supported.
+
+ If the file is opened for reading, this function is emulated but can be
+ extremely slow. If the file is opened for writing, only forward seeks are
+ supported; gzseek then compresses a sequence of zeroes up to the new
+ starting position.
+
+ gzseek returns the resulting offset location as measured in bytes from
+ the beginning of the uncompressed stream, or -1 in case of error, in
+ particular if the file is opened for writing and the new starting position
+ would be before the current position.
+*/
+
+ZEXTERN int ZEXPORT gzrewind OF((gzFile file));
+/*
+ Rewinds the given file. This function is supported only for reading.
+
+ gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET)
+*/
+
+/*
+ZEXTERN z_off_t ZEXPORT gztell OF((gzFile file));
+
+ Returns the starting position for the next gzread or gzwrite on the given
+ compressed file. This position represents a number of bytes in the
+ uncompressed data stream, and is zero when starting, even if appending or
+ reading a gzip stream from the middle of a file using gzdopen().
+
+ gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR)
+*/
+
+/*
+ZEXTERN z_off_t ZEXPORT gzoffset OF((gzFile file));
+
+ Returns the current offset in the file being read or written. This offset
+ includes the count of bytes that precede the gzip stream, for example when
+ appending or when using gzdopen() for reading. When reading, the offset
+ does not include as yet unused buffered input. This information can be used
+ for a progress indicator. On error, gzoffset() returns -1.
+*/
+
+ZEXTERN int ZEXPORT gzeof OF((gzFile file));
+/*
+ Returns true (1) if the end-of-file indicator has been set while reading,
+ false (0) otherwise. Note that the end-of-file indicator is set only if the
+ read tried to go past the end of the input, but came up short. Therefore,
+ just like feof(), gzeof() may return false even if there is no more data to
+ read, in the event that the last read request was for the exact number of
+ bytes remaining in the input file. This will happen if the input file size
+ is an exact multiple of the buffer size.
+
+ If gzeof() returns true, then the read functions will return no more data,
+ unless the end-of-file indicator is reset by gzclearerr() and the input file
+ has grown since the previous end of file was detected.
+*/
+
+ZEXTERN int ZEXPORT gzdirect OF((gzFile file));
+/*
+ Returns true (1) if file is being copied directly while reading, or false
+ (0) if file is a gzip stream being decompressed. This state can change from
+ false to true while reading the input file if the end of a gzip stream is
+ reached, but is followed by data that is not another gzip stream.
+
+ If the input file is empty, gzdirect() will return true, since the input
+ does not contain a gzip stream.
+
+ If gzdirect() is used immediately after gzopen() or gzdopen() it will
+ cause buffers to be allocated to allow reading the file to determine if it
+ is a gzip file. Therefore if gzbuffer() is used, it should be called before
+ gzdirect().
+*/
+
+ZEXTERN int ZEXPORT gzclose OF((gzFile file));
+/*
+ Flushes all pending output if necessary, closes the compressed file and
+ deallocates the (de)compression state. Note that once file is closed, you
+ cannot call gzerror with file, since its structures have been deallocated.
+ gzclose must not be called more than once on the same file, just as free
+ must not be called more than once on the same allocation.
+
+ gzclose will return Z_STREAM_ERROR if file is not valid, Z_ERRNO on a
+ file operation error, or Z_OK on success.
+*/
+
+ZEXTERN int ZEXPORT gzclose_r OF((gzFile file));
+ZEXTERN int ZEXPORT gzclose_w OF((gzFile file));
+/*
+ Same as gzclose(), but gzclose_r() is only for use when reading, and
+ gzclose_w() is only for use when writing or appending. The advantage to
+ using these instead of gzclose() is that they avoid linking in zlib
+ compression or decompression code that is not used when only reading or only
+ writing respectively. If gzclose() is used, then both compression and
+ decompression code will be included the application when linking to a static
+ zlib library.
+*/
+
+ZEXTERN const char * ZEXPORT gzerror OF((gzFile file, int *errnum));
+/*
+ Returns the error message for the last error which occurred on the given
+ compressed file. errnum is set to zlib error number. If an error occurred
+ in the file system and not in the compression library, errnum is set to
+ Z_ERRNO and the application may consult errno to get the exact error code.
+
+ The application must not modify the returned string. Future calls to
+ this function may invalidate the previously returned string. If file is
+ closed, then the string previously returned by gzerror will no longer be
+ available.
+
+ gzerror() should be used to distinguish errors from end-of-file for those
+ functions above that do not distinguish those cases in their return values.
+*/
+
+ZEXTERN void ZEXPORT gzclearerr OF((gzFile file));
+/*
+ Clears the error and end-of-file flags for file. This is analogous to the
+ clearerr() function in stdio. This is useful for continuing to read a gzip
+ file that is being written concurrently.
+*/
+
+
+ /* checksum functions */
+
+/*
+ These functions are not related to compression but are exported
+ anyway because they might be useful in applications using the compression
+ library.
+*/
+
+ZEXTERN uLong ZEXPORT adler32 OF((uLong adler, const Bytef *buf, uInt len));
+/*
+ Update a running Adler-32 checksum with the bytes buf[0..len-1] and
+ return the updated checksum. If buf is Z_NULL, this function returns the
+ required initial value for the checksum.
+
+ An Adler-32 checksum is almost as reliable as a CRC32 but can be computed
+ much faster.
+
+ Usage example:
+
+ uLong adler = adler32(0L, Z_NULL, 0);
+
+ while (read_buffer(buffer, length) != EOF) {
+ adler = adler32(adler, buffer, length);
+ }
+ if (adler != original_adler) error();
+*/
+
+/*
+ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2,
+ z_off_t len2));
+
+ Combine two Adler-32 checksums into one. For two sequences of bytes, seq1
+ and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for
+ each, adler1 and adler2. adler32_combine() returns the Adler-32 checksum of
+ seq1 and seq2 concatenated, requiring only adler1, adler2, and len2.
+*/
+
+ZEXTERN uLong ZEXPORT crc32 OF((uLong crc, const Bytef *buf, uInt len));
+/*
+ Update a running CRC-32 with the bytes buf[0..len-1] and return the
+ updated CRC-32. If buf is Z_NULL, this function returns the required
+ initial value for the for the crc. Pre- and post-conditioning (one's
+ complement) is performed within this function so it shouldn't be done by the
+ application.
+
+ Usage example:
+
+ uLong crc = crc32(0L, Z_NULL, 0);
+
+ while (read_buffer(buffer, length) != EOF) {
+ crc = crc32(crc, buffer, length);
+ }
+ if (crc != original_crc) error();
+*/
+
+/*
+ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2));
+
+ Combine two CRC-32 check values into one. For two sequences of bytes,
+ seq1 and seq2 with lengths len1 and len2, CRC-32 check values were
+ calculated for each, crc1 and crc2. crc32_combine() returns the CRC-32
+ check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and
+ len2.
+*/
+
+
+ /* various hacks, don't look :) */
+
+/* deflateInit and inflateInit are macros to allow checking the zlib version
+ * and the compiler's view of z_stream:
+ */
+ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level,
+ const char *version, int stream_size));
+ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm,
+ const char *version, int stream_size));
+ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int level, int method,
+ int windowBits, int memLevel,
+ int strategy, const char *version,
+ int stream_size));
+ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int windowBits,
+ const char *version, int stream_size));
+ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits,
+ unsigned char FAR *window,
+ const char *version,
+ int stream_size));
+#define deflateInit(strm, level) \
+ deflateInit_((strm), (level), ZLIB_VERSION, sizeof(z_stream))
+#define inflateInit(strm) \
+ inflateInit_((strm), ZLIB_VERSION, sizeof(z_stream))
+#define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \
+ deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\
+ (strategy), ZLIB_VERSION, sizeof(z_stream))
+#define inflateInit2(strm, windowBits) \
+ inflateInit2_((strm), (windowBits), ZLIB_VERSION, sizeof(z_stream))
+#define inflateBackInit(strm, windowBits, window) \
+ inflateBackInit_((strm), (windowBits), (window), \
+ ZLIB_VERSION, sizeof(z_stream))
+
+/* provide 64-bit offset functions if _LARGEFILE64_SOURCE defined, and/or
+ * change the regular functions to 64 bits if _FILE_OFFSET_BITS is 64 (if
+ * both are true, the application gets the *64 functions, and the regular
+ * functions are changed to 64 bits) -- in case these are set on systems
+ * without large file support, _LFS64_LARGEFILE must also be true
+ */
+#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0
+ ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *));
+ ZEXTERN z_off64_t ZEXPORT gzseek64 OF((gzFile, z_off64_t, int));
+ ZEXTERN z_off64_t ZEXPORT gztell64 OF((gzFile));
+ ZEXTERN z_off64_t ZEXPORT gzoffset64 OF((gzFile));
+ ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off64_t));
+ ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off64_t));
+#endif
+
+#if !defined(ZLIB_INTERNAL) && _FILE_OFFSET_BITS-0 == 64 && _LFS64_LARGEFILE-0
+# define gzopen gzopen64
+# define gzseek gzseek64
+# define gztell gztell64
+# define gzoffset gzoffset64
+# define adler32_combine adler32_combine64
+# define crc32_combine crc32_combine64
+# ifdef _LARGEFILE64_SOURCE
+ ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *));
+ ZEXTERN z_off_t ZEXPORT gzseek64 OF((gzFile, z_off_t, int));
+ ZEXTERN z_off_t ZEXPORT gztell64 OF((gzFile));
+ ZEXTERN z_off_t ZEXPORT gzoffset64 OF((gzFile));
+ ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off_t));
+ ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off_t));
+# endif
+#else
+ ZEXTERN gzFile ZEXPORT gzopen OF((const char *, const char *));
+ ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile, z_off_t, int));
+ ZEXTERN z_off_t ZEXPORT gztell OF((gzFile));
+ ZEXTERN z_off_t ZEXPORT gzoffset OF((gzFile));
+ ZEXTERN uLong ZEXPORT adler32_combine OF((uLong, uLong, z_off_t));
+ ZEXTERN uLong ZEXPORT crc32_combine OF((uLong, uLong, z_off_t));
+#endif
+
+/* hack for buggy compilers */
+#if !defined(ZUTIL_H) && !defined(NO_DUMMY_DECL)
+ struct internal_state {int dummy;};
+#endif
+
+/* undocumented functions */
+ZEXTERN const char * ZEXPORT zError OF((int));
+ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp));
+ZEXTERN const uLongf * ZEXPORT get_crc_table OF((void));
+ZEXTERN int ZEXPORT inflateUndermine OF((z_streamp, int));
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* ZLIB_H */
diff --git a/src/plugins/cfitsio/zuncompress.c b/src/plugins/cfitsio/zuncompress.c
new file mode 100644
index 0000000..c73ee6d
--- /dev/null
+++ b/src/plugins/cfitsio/zuncompress.c
@@ -0,0 +1,603 @@
+/* gzcompress.h -- definitions for the .Z decompression routine used in CFITSIO */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+
+#define get_char() get_byte()
+
+/* gzip.h -- common declarations for all gzip modules */
+
+#define OF(args) args
+typedef void *voidp;
+
+#define memzero(s, n) memset ((voidp)(s), 0, (n))
+
+typedef unsigned char uch;
+typedef unsigned short ush;
+typedef unsigned long ulg;
+
+/* private version of MIN function */
+#define MINZIP(a,b) ((a) <= (b) ? (a) : (b))
+
+/* Return codes from gzip */
+#define OK 0
+#define ERROR 1
+#define COMPRESSED 1
+#define DEFLATED 8
+#define INBUFSIZ 0x8000 /* input buffer size */
+#define INBUF_EXTRA 64 /* required by unlzw() */
+#define OUTBUFSIZ 16384 /* output buffer size */
+#define OUTBUF_EXTRA 2048 /* required by unlzw() */
+#define DIST_BUFSIZE 0x8000 /* buffer for distances, see trees.c */
+#define WSIZE 0x8000 /* window size--must be a power of two, and */
+#define DECLARE(type, array, size) type array[size]
+#define tab_suffix window
+#define tab_prefix prev /* hash link (see deflate.c) */
+#define head (prev+WSIZE) /* hash head (see deflate.c) */
+#define LZW_MAGIC "\037\235" /* Magic header for lzw files, 1F 9D */
+#define get_byte() (inptr < insize ? inbuf[inptr++] : fill_inbuf(0))
+
+/* Diagnostic functions */
+# define Assert(cond,msg)
+# define Trace(x)
+# define Tracev(x)
+# define Tracevv(x)
+# define Tracec(c,x)
+# define Tracecv(c,x)
+
+/* lzw.h -- define the lzw functions. */
+
+#ifndef BITS
+# define BITS 16
+#endif
+#define INIT_BITS 9 /* Initial number of bits per code */
+#define BIT_MASK 0x1f /* Mask for 'number of compression bits' */
+#define BLOCK_MODE 0x80
+#define LZW_RESERVED 0x60 /* reserved bits */
+#define CLEAR 256 /* flush the dictionary */
+#define FIRST (CLEAR+1) /* first free entry */
+
+/* prototypes */
+
+#define local static
+void ffpmsg(const char *err_message);
+
+local int fill_inbuf OF((int eof_ok));
+local void write_buf OF((voidp buf, unsigned cnt));
+local void error OF((char *m));
+local int unlzw OF((FILE *in, FILE *out));
+
+typedef int file_t; /* Do not use stdio */
+
+int (*work) OF((FILE *infile, FILE *outfile)) = unlzw; /* function to call */
+
+local void error OF((char *m));
+
+ /* global buffers */
+
+static DECLARE(uch, inbuf, INBUFSIZ +INBUF_EXTRA);
+static DECLARE(uch, outbuf, OUTBUFSIZ+OUTBUF_EXTRA);
+static DECLARE(ush, d_buf, DIST_BUFSIZE);
+static DECLARE(uch, window, 2L*WSIZE);
+
+#ifndef MAXSEG_64K
+ static DECLARE(ush, tab_prefix, 1L<<BITS);
+#else
+ static DECLARE(ush, tab_prefix0, 1L<<(BITS-1));
+ static DECLARE(ush, tab_prefix1, 1L<<(BITS-1));
+#endif
+
+ /* local variables */
+
+/* 11/25/98: added 'static' to local variable definitions, to avoid */
+/* conflict with external source files */
+
+static int maxbits = BITS; /* max bits per code for LZW */
+static int method = DEFLATED;/* compression method */
+static int exit_code = OK; /* program exit code */
+static int last_member; /* set for .zip and .Z files */
+static long bytes_in; /* number of input bytes */
+static long bytes_out; /* number of output bytes */
+static char ifname[128]; /* input file name */
+static FILE *ifd; /* input file descriptor */
+static FILE *ofd; /* output file descriptor */
+static void **memptr; /* memory location for uncompressed file */
+static size_t *memsize; /* size (bytes) of memory allocated for file */
+void *(*realloc_fn)(void *p, size_t newsize); /* reallocation function */
+static unsigned insize; /* valid bytes in inbuf */
+static unsigned inptr; /* index of next byte to be processed in inbuf */
+
+/* prototype for the following functions */
+int zuncompress2mem(char *filename,
+ FILE *diskfile,
+ char **buffptr,
+ size_t *buffsize,
+ void *(*mem_realloc)(void *p, size_t newsize),
+ size_t *filesize,
+ int *status);
+
+/*--------------------------------------------------------------------------*/
+int zuncompress2mem(char *filename, /* name of input file */
+ FILE *indiskfile, /* I - file pointer */
+ char **buffptr, /* IO - memory pointer */
+ size_t *buffsize, /* IO - size of buffer, in bytes */
+ void *(*mem_realloc)(void *p, size_t newsize), /* function */
+ size_t *filesize, /* O - size of file, in bytes */
+ int *status) /* IO - error status */
+
+/*
+ Uncompress the file into memory. Fill whatever amount of memory has
+ already been allocated, then realloc more memory, using the supplied
+ input function, if necessary.
+*/
+{
+ char magic[2]; /* magic header */
+
+ if (*status > 0)
+ return(*status);
+
+ /* save input parameters into global variables */
+ ifname[0] = '\0';
+ strncat(ifname, filename, 127);
+ ifd = indiskfile;
+ memptr = (void **) buffptr;
+ memsize = buffsize;
+ realloc_fn = mem_realloc;
+
+ /* clear input and output buffers */
+
+ insize = inptr = 0;
+ bytes_in = bytes_out = 0L;
+
+ magic[0] = (char)get_byte();
+ magic[1] = (char)get_byte();
+
+ if (memcmp(magic, LZW_MAGIC, 2) != 0) {
+ error("ERROR: input .Z file is in unrecognized compression format.\n");
+ return(-1);
+ }
+
+ work = unlzw;
+ method = COMPRESSED;
+ last_member = 1;
+
+ /* do the uncompression */
+ if ((*work)(ifd, ofd) != OK) {
+ method = -1; /* force cleanup */
+ *status = 414; /* report some sort of decompression error */
+ }
+
+ if (filesize) *filesize = bytes_out;
+
+ return(*status);
+}
+/*=========================================================================*/
+/*=========================================================================*/
+/* this marks the begining of the original file 'unlzw.c' */
+/*=========================================================================*/
+/*=========================================================================*/
+
+/* unlzw.c -- decompress files in LZW format.
+ * The code in this file is directly derived from the public domain 'compress'
+ * written by Spencer Thomas, Joe Orost, James Woods, Jim McKie, Steve Davies,
+ * Ken Turkowski, Dave Mack and Peter Jannesen.
+ */
+
+typedef unsigned char char_type;
+typedef long code_int;
+typedef unsigned long count_int;
+typedef unsigned short count_short;
+typedef unsigned long cmp_code_int;
+
+#define MAXCODE(n) (1L << (n))
+
+#ifndef REGISTERS
+# define REGISTERS 2
+#endif
+#define REG1
+#define REG2
+#define REG3
+#define REG4
+#define REG5
+#define REG6
+#define REG7
+#define REG8
+#define REG9
+#define REG10
+#define REG11
+#define REG12
+#define REG13
+#define REG14
+#define REG15
+#define REG16
+#if REGISTERS >= 1
+# undef REG1
+# define REG1 register
+#endif
+#if REGISTERS >= 2
+# undef REG2
+# define REG2 register
+#endif
+#if REGISTERS >= 3
+# undef REG3
+# define REG3 register
+#endif
+#if REGISTERS >= 4
+# undef REG4
+# define REG4 register
+#endif
+#if REGISTERS >= 5
+# undef REG5
+# define REG5 register
+#endif
+#if REGISTERS >= 6
+# undef REG6
+# define REG6 register
+#endif
+#if REGISTERS >= 7
+# undef REG7
+# define REG7 register
+#endif
+#if REGISTERS >= 8
+# undef REG8
+# define REG8 register
+#endif
+#if REGISTERS >= 9
+# undef REG9
+# define REG9 register
+#endif
+#if REGISTERS >= 10
+# undef REG10
+# define REG10 register
+#endif
+#if REGISTERS >= 11
+# undef REG11
+# define REG11 register
+#endif
+#if REGISTERS >= 12
+# undef REG12
+# define REG12 register
+#endif
+#if REGISTERS >= 13
+# undef REG13
+# define REG13 register
+#endif
+#if REGISTERS >= 14
+# undef REG14
+# define REG14 register
+#endif
+#if REGISTERS >= 15
+# undef REG15
+# define REG15 register
+#endif
+#if REGISTERS >= 16
+# undef REG16
+# define REG16 register
+#endif
+
+#ifndef BYTEORDER
+# define BYTEORDER 0000
+#endif
+
+#ifndef NOALLIGN
+# define NOALLIGN 0
+#endif
+
+
+union bytes {
+ long word;
+ struct {
+#if BYTEORDER == 4321
+ char_type b1;
+ char_type b2;
+ char_type b3;
+ char_type b4;
+#else
+#if BYTEORDER == 1234
+ char_type b4;
+ char_type b3;
+ char_type b2;
+ char_type b1;
+#else
+# undef BYTEORDER
+ int dummy;
+#endif
+#endif
+ } bytes;
+};
+
+#if BYTEORDER == 4321 && NOALLIGN == 1
+# define input(b,o,c,n,m){ \
+ (c) = (*(long *)(&(b)[(o)>>3])>>((o)&0x7))&(m); \
+ (o) += (n); \
+ }
+#else
+# define input(b,o,c,n,m){ \
+ REG1 char_type *p = &(b)[(o)>>3]; \
+ (c) = ((((long)(p[0]))|((long)(p[1])<<8)| \
+ ((long)(p[2])<<16))>>((o)&0x7))&(m); \
+ (o) += (n); \
+ }
+#endif
+
+#ifndef MAXSEG_64K
+ /* DECLARE(ush, tab_prefix, (1<<BITS)); -- prefix code */
+# define tab_prefixof(i) tab_prefix[i]
+# define clear_tab_prefixof() memzero(tab_prefix, 256);
+#else
+ /* DECLARE(ush, tab_prefix0, (1<<(BITS-1)); -- prefix for even codes */
+ /* DECLARE(ush, tab_prefix1, (1<<(BITS-1)); -- prefix for odd codes */
+ ush *tab_prefix[2];
+# define tab_prefixof(i) tab_prefix[(i)&1][(i)>>1]
+# define clear_tab_prefixof() \
+ memzero(tab_prefix0, 128), \
+ memzero(tab_prefix1, 128);
+#endif
+#define de_stack ((char_type *)(&d_buf[DIST_BUFSIZE-1]))
+#define tab_suffixof(i) tab_suffix[i]
+
+int block_mode = BLOCK_MODE; /* block compress mode -C compatible with 2.0 */
+
+/* ============================================================================
+ * Decompress in to out. This routine adapts to the codes in the
+ * file building the "string" table on-the-fly; requiring no table to
+ * be stored in the compressed file.
+ * IN assertions: the buffer inbuf contains already the beginning of
+ * the compressed data, from offsets iptr to insize-1 included.
+ * The magic header has already been checked and skipped.
+ * bytes_in and bytes_out have been initialized.
+ */
+local int unlzw(FILE *in, FILE *out)
+ /* input and output file descriptors */
+{
+ REG2 char_type *stackp;
+ REG3 code_int code;
+ REG4 int finchar;
+ REG5 code_int oldcode;
+ REG6 code_int incode;
+ REG7 long inbits;
+ REG8 long posbits;
+ REG9 int outpos;
+/* REG10 int insize; (global) */
+ REG11 unsigned bitmask;
+ REG12 code_int free_ent;
+ REG13 code_int maxcode;
+ REG14 code_int maxmaxcode;
+ REG15 int n_bits;
+ REG16 int rsize;
+
+ ofd = out;
+
+#ifdef MAXSEG_64K
+ tab_prefix[0] = tab_prefix0;
+ tab_prefix[1] = tab_prefix1;
+#endif
+ maxbits = get_byte();
+ block_mode = maxbits & BLOCK_MODE;
+ if ((maxbits & LZW_RESERVED) != 0) {
+ error( "warning, unknown flags in unlzw decompression");
+ }
+ maxbits &= BIT_MASK;
+ maxmaxcode = MAXCODE(maxbits);
+
+ if (maxbits > BITS) {
+ error("compressed with too many bits; cannot handle file");
+ exit_code = ERROR;
+ return ERROR;
+ }
+ rsize = insize;
+ maxcode = MAXCODE(n_bits = INIT_BITS)-1;
+ bitmask = (1<<n_bits)-1;
+ oldcode = -1;
+ finchar = 0;
+ outpos = 0;
+ posbits = inptr<<3;
+
+ free_ent = ((block_mode) ? FIRST : 256);
+
+ clear_tab_prefixof(); /* Initialize the first 256 entries in the table. */
+
+ for (code = 255 ; code >= 0 ; --code) {
+ tab_suffixof(code) = (char_type)code;
+ }
+ do {
+ REG1 int i;
+ int e;
+ int o;
+
+ resetbuf:
+ e = insize-(o = (posbits>>3));
+
+ for (i = 0 ; i < e ; ++i) {
+ inbuf[i] = inbuf[i+o];
+ }
+ insize = e;
+ posbits = 0;
+
+ if (insize < INBUF_EXTRA) {
+/* modified to use fread instead of read - WDP 10/22/97 */
+/* if ((rsize = read(in, (char*)inbuf+insize, INBUFSIZ)) == EOF) { */
+
+ if ((rsize = fread((char*)inbuf+insize, 1, INBUFSIZ, in)) == EOF) {
+ error("unexpected end of file");
+ exit_code = ERROR;
+ return ERROR;
+ }
+ insize += rsize;
+ bytes_in += (ulg)rsize;
+ }
+ inbits = ((rsize != 0) ? ((long)insize - insize%n_bits)<<3 :
+ ((long)insize<<3)-(n_bits-1));
+
+ while (inbits > posbits) {
+ if (free_ent > maxcode) {
+ posbits = ((posbits-1) +
+ ((n_bits<<3)-(posbits-1+(n_bits<<3))%(n_bits<<3)));
+ ++n_bits;
+ if (n_bits == maxbits) {
+ maxcode = maxmaxcode;
+ } else {
+ maxcode = MAXCODE(n_bits)-1;
+ }
+ bitmask = (1<<n_bits)-1;
+ goto resetbuf;
+ }
+ input(inbuf,posbits,code,n_bits,bitmask);
+ Tracev((stderr, "%d ", code));
+
+ if (oldcode == -1) {
+ if (code >= 256) {
+ error("corrupt input.");
+ exit_code = ERROR;
+ return ERROR;
+ }
+
+ outbuf[outpos++] = (char_type)(finchar = (int)(oldcode=code));
+ continue;
+ }
+ if (code == CLEAR && block_mode) {
+ clear_tab_prefixof();
+ free_ent = FIRST - 1;
+ posbits = ((posbits-1) +
+ ((n_bits<<3)-(posbits-1+(n_bits<<3))%(n_bits<<3)));
+ maxcode = MAXCODE(n_bits = INIT_BITS)-1;
+ bitmask = (1<<n_bits)-1;
+ goto resetbuf;
+ }
+ incode = code;
+ stackp = de_stack;
+
+ if (code >= free_ent) { /* Special case for KwKwK string. */
+ if (code > free_ent) {
+ if (outpos > 0) {
+ write_buf((char*)outbuf, outpos);
+ bytes_out += (ulg)outpos;
+ }
+ error("corrupt input.");
+ exit_code = ERROR;
+ return ERROR;
+
+ }
+ *--stackp = (char_type)finchar;
+ code = oldcode;
+ }
+
+ while ((cmp_code_int)code >= (cmp_code_int)256) {
+ /* Generate output characters in reverse order */
+ *--stackp = tab_suffixof(code);
+ code = tab_prefixof(code);
+ }
+ *--stackp = (char_type)(finchar = tab_suffixof(code));
+
+ /* And put them out in forward order */
+ {
+ /* REG1 int i; already defined above (WDP) */
+
+ if (outpos+(i = (de_stack-stackp)) >= OUTBUFSIZ) {
+ do {
+ if (i > OUTBUFSIZ-outpos) i = OUTBUFSIZ-outpos;
+
+ if (i > 0) {
+ memcpy(outbuf+outpos, stackp, i);
+ outpos += i;
+ }
+ if (outpos >= OUTBUFSIZ) {
+ write_buf((char*)outbuf, outpos);
+ bytes_out += (ulg)outpos;
+ outpos = 0;
+ }
+ stackp+= i;
+ } while ((i = (de_stack-stackp)) > 0);
+ } else {
+ memcpy(outbuf+outpos, stackp, i);
+ outpos += i;
+ }
+ }
+
+ if ((code = free_ent) < maxmaxcode) { /* Generate the new entry. */
+
+ tab_prefixof(code) = (unsigned short)oldcode;
+ tab_suffixof(code) = (char_type)finchar;
+ free_ent = code+1;
+ }
+ oldcode = incode; /* Remember previous code. */
+ }
+ } while (rsize != 0);
+
+ if (outpos > 0) {
+ write_buf((char*)outbuf, outpos);
+ bytes_out += (ulg)outpos;
+ }
+ return OK;
+}
+/* ========================================================================*/
+/* this marks the start of the code from 'util.c' */
+
+local int fill_inbuf(int eof_ok)
+ /* set if EOF acceptable as a result */
+{
+ int len;
+
+ /* Read as much as possible from file */
+ insize = 0;
+ do {
+ len = fread((char*)inbuf+insize, 1, INBUFSIZ-insize, ifd);
+ if (len == 0 || len == EOF) break;
+ insize += len;
+ } while (insize < INBUFSIZ);
+
+ if (insize == 0) {
+ if (eof_ok) return EOF;
+ error("unexpected end of file");
+ exit_code = ERROR;
+ return ERROR;
+ }
+
+ bytes_in += (ulg)insize;
+ inptr = 1;
+ return inbuf[0];
+}
+/* =========================================================================== */
+local void write_buf(voidp buf, unsigned cnt)
+/* copy buffer into memory; allocate more memory if required*/
+{
+ if (!realloc_fn)
+ {
+ /* append buffer to file */
+ /* added 'unsigned' to get rid of compiler warning (WDP 1/1/99) */
+ if ((unsigned long) fwrite(buf, 1, cnt, ofd) != cnt)
+ {
+ error
+ ("failed to write buffer to uncompressed output file (write_buf)");
+ exit_code = ERROR;
+ return;
+ }
+ }
+ else
+ {
+ /* get more memory if current buffer is too small */
+ if (bytes_out + cnt > *memsize)
+ {
+ *memptr = realloc_fn(*memptr, bytes_out + cnt);
+ *memsize = bytes_out + cnt; /* new memory buffer size */
+
+ if (!(*memptr))
+ {
+ error("malloc failed while uncompressing (write_buf)");
+ exit_code = ERROR;
+ return;
+ }
+ }
+ /* copy into memory buffer */
+ memcpy((char *) *memptr + bytes_out, (char *) buf, cnt);
+ }
+}
+/* ======================================================================== */
+local void error(char *m)
+/* Error handler */
+{
+ ffpmsg(ifname);
+ ffpmsg(m);
+}
diff --git a/src/plugins/cfitsio/zutil.c b/src/plugins/cfitsio/zutil.c
new file mode 100644
index 0000000..15645c5
--- /dev/null
+++ b/src/plugins/cfitsio/zutil.c
@@ -0,0 +1,316 @@
+/* zutil.c -- target dependent utility functions for the compression library
+ * Copyright (C) 1995-2005, 2010 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+#include "zutil.h"
+
+#ifndef NO_DUMMY_DECL
+struct internal_state {int dummy;}; /* for buggy compilers */
+#endif
+
+const char * const z_errmsg[10] = {
+"need dictionary", /* Z_NEED_DICT 2 */
+"stream end", /* Z_STREAM_END 1 */
+"", /* Z_OK 0 */
+"file error", /* Z_ERRNO (-1) */
+"stream error", /* Z_STREAM_ERROR (-2) */
+"data error", /* Z_DATA_ERROR (-3) */
+"insufficient memory", /* Z_MEM_ERROR (-4) */
+"buffer error", /* Z_BUF_ERROR (-5) */
+"incompatible version",/* Z_VERSION_ERROR (-6) */
+""};
+
+
+const char * ZEXPORT zlibVersion()
+{
+ return ZLIB_VERSION;
+}
+
+uLong ZEXPORT zlibCompileFlags()
+{
+ uLong flags;
+
+ flags = 0;
+ switch ((int)(sizeof(uInt))) {
+ case 2: break;
+ case 4: flags += 1; break;
+ case 8: flags += 2; break;
+ default: flags += 3;
+ }
+ switch ((int)(sizeof(uLong))) {
+ case 2: break;
+ case 4: flags += 1 << 2; break;
+ case 8: flags += 2 << 2; break;
+ default: flags += 3 << 2;
+ }
+ switch ((int)(sizeof(voidpf))) {
+ case 2: break;
+ case 4: flags += 1 << 4; break;
+ case 8: flags += 2 << 4; break;
+ default: flags += 3 << 4;
+ }
+ switch ((int)(sizeof(z_off_t))) {
+ case 2: break;
+ case 4: flags += 1 << 6; break;
+ case 8: flags += 2 << 6; break;
+ default: flags += 3 << 6;
+ }
+#ifdef DEBUG
+ flags += 1 << 8;
+#endif
+#if defined(ASMV) || defined(ASMINF)
+ flags += 1 << 9;
+#endif
+#ifdef ZLIB_WINAPI
+ flags += 1 << 10;
+#endif
+#ifdef BUILDFIXED
+ flags += 1 << 12;
+#endif
+#ifdef DYNAMIC_CRC_TABLE
+ flags += 1 << 13;
+#endif
+#ifdef NO_GZCOMPRESS
+ flags += 1L << 16;
+#endif
+#ifdef NO_GZIP
+ flags += 1L << 17;
+#endif
+#ifdef PKZIP_BUG_WORKAROUND
+ flags += 1L << 20;
+#endif
+#ifdef FASTEST
+ flags += 1L << 21;
+#endif
+#ifdef STDC
+# ifdef NO_vsnprintf
+ flags += 1L << 25;
+# ifdef HAS_vsprintf_void
+ flags += 1L << 26;
+# endif
+# else
+# ifdef HAS_vsnprintf_void
+ flags += 1L << 26;
+# endif
+# endif
+#else
+ flags += 1L << 24;
+# ifdef NO_snprintf
+ flags += 1L << 25;
+# ifdef HAS_sprintf_void
+ flags += 1L << 26;
+# endif
+# else
+# ifdef HAS_snprintf_void
+ flags += 1L << 26;
+# endif
+# endif
+#endif
+ return flags;
+}
+
+#ifdef DEBUG
+
+# ifndef verbose
+# define verbose 0
+# endif
+int ZLIB_INTERNAL z_verbose = verbose;
+
+void ZLIB_INTERNAL z_error (m)
+ char *m;
+{
+ fprintf(stderr, "%s\n", m);
+ exit(1);
+}
+#endif
+
+/* exported to allow conversion of error code to string for compress() and
+ * uncompress()
+ */
+const char * ZEXPORT zError(err)
+ int err;
+{
+ return ERR_MSG(err);
+}
+
+#if defined(_WIN32_WCE)
+ /* The Microsoft C Run-Time Library for Windows CE doesn't have
+ * errno. We define it as a global variable to simplify porting.
+ * Its value is always 0 and should not be used.
+ */
+ int errno = 0;
+#endif
+
+#ifndef HAVE_MEMCPY
+
+void ZLIB_INTERNAL zmemcpy(dest, source, len)
+ Bytef* dest;
+ const Bytef* source;
+ uInt len;
+{
+ if (len == 0) return;
+ do {
+ *dest++ = *source++; /* ??? to be unrolled */
+ } while (--len != 0);
+}
+
+int ZLIB_INTERNAL zmemcmp(s1, s2, len)
+ const Bytef* s1;
+ const Bytef* s2;
+ uInt len;
+{
+ uInt j;
+
+ for (j = 0; j < len; j++) {
+ if (s1[j] != s2[j]) return 2*(s1[j] > s2[j])-1;
+ }
+ return 0;
+}
+
+void ZLIB_INTERNAL zmemzero(dest, len)
+ Bytef* dest;
+ uInt len;
+{
+ if (len == 0) return;
+ do {
+ *dest++ = 0; /* ??? to be unrolled */
+ } while (--len != 0);
+}
+#endif
+
+
+#ifdef SYS16BIT
+
+#ifdef __TURBOC__
+/* Turbo C in 16-bit mode */
+
+# define MY_ZCALLOC
+
+/* Turbo C malloc() does not allow dynamic allocation of 64K bytes
+ * and farmalloc(64K) returns a pointer with an offset of 8, so we
+ * must fix the pointer. Warning: the pointer must be put back to its
+ * original form in order to free it, use zcfree().
+ */
+
+#define MAX_PTR 10
+/* 10*64K = 640K */
+
+local int next_ptr = 0;
+
+typedef struct ptr_table_s {
+ voidpf org_ptr;
+ voidpf new_ptr;
+} ptr_table;
+
+local ptr_table table[MAX_PTR];
+/* This table is used to remember the original form of pointers
+ * to large buffers (64K). Such pointers are normalized with a zero offset.
+ * Since MSDOS is not a preemptive multitasking OS, this table is not
+ * protected from concurrent access. This hack doesn't work anyway on
+ * a protected system like OS/2. Use Microsoft C instead.
+ */
+
+voidpf ZLIB_INTERNAL zcalloc (voidpf opaque, unsigned items, unsigned size)
+{
+ voidpf buf = opaque; /* just to make some compilers happy */
+ ulg bsize = (ulg)items*size;
+
+ /* If we allocate less than 65520 bytes, we assume that farmalloc
+ * will return a usable pointer which doesn't have to be normalized.
+ */
+ if (bsize < 65520L) {
+ buf = farmalloc(bsize);
+ if (*(ush*)&buf != 0) return buf;
+ } else {
+ buf = farmalloc(bsize + 16L);
+ }
+ if (buf == NULL || next_ptr >= MAX_PTR) return NULL;
+ table[next_ptr].org_ptr = buf;
+
+ /* Normalize the pointer to seg:0 */
+ *((ush*)&buf+1) += ((ush)((uch*)buf-0) + 15) >> 4;
+ *(ush*)&buf = 0;
+ table[next_ptr++].new_ptr = buf;
+ return buf;
+}
+
+void ZLIB_INTERNAL zcfree (voidpf opaque, voidpf ptr)
+{
+ int n;
+ if (*(ush*)&ptr != 0) { /* object < 64K */
+ farfree(ptr);
+ return;
+ }
+ /* Find the original pointer */
+ for (n = 0; n < next_ptr; n++) {
+ if (ptr != table[n].new_ptr) continue;
+
+ farfree(table[n].org_ptr);
+ while (++n < next_ptr) {
+ table[n-1] = table[n];
+ }
+ next_ptr--;
+ return;
+ }
+ ptr = opaque; /* just to make some compilers happy */
+ Assert(0, "zcfree: ptr not found");
+}
+
+#endif /* __TURBOC__ */
+
+
+#ifdef M_I86
+/* Microsoft C in 16-bit mode */
+
+# define MY_ZCALLOC
+
+#if (!defined(_MSC_VER) || (_MSC_VER <= 600))
+# define _halloc halloc
+# define _hfree hfree
+#endif
+
+voidpf ZLIB_INTERNAL zcalloc (voidpf opaque, uInt items, uInt size)
+{
+ if (opaque) opaque = 0; /* to make compiler happy */
+ return _halloc((long)items, size);
+}
+
+void ZLIB_INTERNAL zcfree (voidpf opaque, voidpf ptr)
+{
+ if (opaque) opaque = 0; /* to make compiler happy */
+ _hfree(ptr);
+}
+
+#endif /* M_I86 */
+
+#endif /* SYS16BIT */
+
+
+#ifndef MY_ZCALLOC /* Any system without a special alloc function */
+
+#ifndef STDC
+extern voidp malloc OF((uInt size));
+extern voidp calloc OF((uInt items, uInt size));
+extern void free OF((voidpf ptr));
+#endif
+
+voidpf ZLIB_INTERNAL zcalloc (opaque, items, size)
+ voidpf opaque;
+ unsigned items;
+ unsigned size;
+{
+ if (opaque) items += size - size; /* make compiler happy */
+ return sizeof(uInt) > 2 ? (voidpf)malloc(items * size) :
+ (voidpf)calloc(items, size);
+}
+
+void ZLIB_INTERNAL zcfree (opaque, ptr)
+ voidpf opaque;
+ voidpf ptr;
+{
+ free(ptr);
+ if (opaque) return; /* make compiler happy */
+}
+
+#endif /* MY_ZCALLOC */
diff --git a/src/plugins/cfitsio/zutil.h b/src/plugins/cfitsio/zutil.h
new file mode 100644
index 0000000..1f5a6c0
--- /dev/null
+++ b/src/plugins/cfitsio/zutil.h
@@ -0,0 +1,272 @@
+/* zutil.h -- internal interface and configuration of the compression library
+ * 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 ZUTIL_H
+#define ZUTIL_H
+
+#if ((__GNUC__-0) * 10 + __GNUC_MINOR__-0 >= 33) && !defined(NO_VIZ)
+# define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
+#else
+# define ZLIB_INTERNAL
+#endif
+
+#include "zlib.h"
+
+#ifdef STDC
+# if !(defined(_WIN32_WCE) && defined(_MSC_VER))
+# include <stddef.h>
+# endif
+# include <string.h>
+# include <stdlib.h>
+#endif
+
+#ifndef local
+# define local static
+#endif
+/* compile with -Dlocal if your debugger can't find static symbols */
+
+typedef unsigned char uch;
+typedef uch FAR uchf;
+typedef unsigned short ush;
+typedef ush FAR ushf;
+typedef unsigned long ulg;
+
+extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */
+/* (size given to avoid silly warnings with Visual C++) */
+
+#define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)]
+
+#define ERR_RETURN(strm,err) \
+ return (strm->msg = (char*)ERR_MSG(err), (err))
+/* To be used only when the state is known to be valid */
+
+ /* common constants */
+
+#ifndef DEF_WBITS
+# define DEF_WBITS MAX_WBITS
+#endif
+/* default windowBits for decompression. MAX_WBITS is for compression only */
+
+#if MAX_MEM_LEVEL >= 8
+# define DEF_MEM_LEVEL 8
+#else
+# define DEF_MEM_LEVEL MAX_MEM_LEVEL
+#endif
+/* default memLevel */
+
+#define STORED_BLOCK 0
+#define STATIC_TREES 1
+#define DYN_TREES 2
+/* The three kinds of block type */
+
+#define MIN_MATCH 3
+#define MAX_MATCH 258
+/* The minimum and maximum match lengths */
+
+#define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */
+
+ /* target dependencies */
+
+#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32))
+# define OS_CODE 0x00
+# if defined(__TURBOC__) || defined(__BORLANDC__)
+# if (__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__))
+ /* Allow compilation with ANSI keywords only enabled */
+ void _Cdecl farfree( void *block );
+ void *_Cdecl farmalloc( unsigned long nbytes );
+# else
+# include <alloc.h>
+# endif
+# else /* MSC or DJGPP */
+# include <malloc.h>
+# endif
+#endif
+
+#ifdef AMIGA
+# define OS_CODE 0x01
+#endif
+
+#if defined(VAXC) || defined(VMS)
+# define OS_CODE 0x02
+# define F_OPEN(name, mode) \
+ fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512")
+#endif
+
+#if defined(ATARI) || defined(atarist)
+# define OS_CODE 0x05
+#endif
+
+#ifdef OS2
+# define OS_CODE 0x06
+# ifdef M_I86
+# include <malloc.h>
+# endif
+#endif
+
+#if defined(MACOS) || defined(TARGET_OS_MAC)
+# define OS_CODE 0x07
+# if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os
+# include <unix.h> /* for fdopen */
+# else
+# ifndef fdopen
+# define fdopen(fd,mode) NULL /* No fdopen() */
+# endif
+# endif
+#endif
+
+#ifdef TOPS20
+# define OS_CODE 0x0a
+#endif
+
+#ifdef WIN32
+# ifndef __CYGWIN__ /* Cygwin is Unix, not Win32 */
+# define OS_CODE 0x0b
+# endif
+#endif
+
+#ifdef __50SERIES /* Prime/PRIMOS */
+# define OS_CODE 0x0f
+#endif
+
+#if defined(_BEOS_) || defined(RISCOS)
+# define fdopen(fd,mode) NULL /* No fdopen() */
+#endif
+
+#if (defined(_MSC_VER) && (_MSC_VER > 600)) && !defined __INTERIX
+# if defined(_WIN32_WCE)
+# define fdopen(fd,mode) NULL /* No fdopen() */
+# ifndef _PTRDIFF_T_DEFINED
+ typedef int ptrdiff_t;
+# define _PTRDIFF_T_DEFINED
+# endif
+# else
+# define fdopen(fd,type) _fdopen(fd,type)
+# endif
+#endif
+
+#if defined(__BORLANDC__)
+ #pragma warn -8004
+ #pragma warn -8008
+ #pragma warn -8066
+#endif
+
+/* provide prototypes for these when building zlib without LFS */
+#if !defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0
+ ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off_t));
+ ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off_t));
+#endif
+
+ /* common defaults */
+
+#ifndef OS_CODE
+# define OS_CODE 0x03 /* assume Unix */
+#endif
+
+#ifndef F_OPEN
+# define F_OPEN(name, mode) fopen((name), (mode))
+#endif
+
+ /* functions */
+
+#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550)
+# ifndef HAVE_VSNPRINTF
+# define HAVE_VSNPRINTF
+# endif
+#endif
+#if defined(__CYGWIN__)
+# ifndef HAVE_VSNPRINTF
+# define HAVE_VSNPRINTF
+# endif
+#endif
+#ifndef HAVE_VSNPRINTF
+# ifdef MSDOS
+ /* vsnprintf may exist on some MS-DOS compilers (DJGPP?),
+ but for now we just assume it doesn't. */
+# define NO_vsnprintf
+# endif
+# ifdef __TURBOC__
+# define NO_vsnprintf
+# endif
+# ifdef WIN32
+ /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */
+# if !defined(vsnprintf) && !defined(NO_vsnprintf)
+# if !defined(_MSC_VER) || ( defined(_MSC_VER) && _MSC_VER < 1500 )
+# define vsnprintf _vsnprintf
+# endif
+# endif
+# endif
+# ifdef __SASC
+# define NO_vsnprintf
+# endif
+#endif
+#ifdef VMS
+# define NO_vsnprintf
+#endif
+
+#if defined(pyr)
+# define NO_MEMCPY
+#endif
+#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__)
+ /* Use our own functions for small and medium model with MSC <= 5.0.
+ * You may have to use the same strategy for Borland C (untested).
+ * The __SC__ check is for Symantec.
+ */
+# define NO_MEMCPY
+#endif
+#if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY)
+# define HAVE_MEMCPY
+#endif
+#ifdef HAVE_MEMCPY
+# ifdef SMALL_MEDIUM /* MSDOS small or medium model */
+# define zmemcpy _fmemcpy
+# define zmemcmp _fmemcmp
+# define zmemzero(dest, len) _fmemset(dest, 0, len)
+# else
+# define zmemcpy memcpy
+# define zmemcmp memcmp
+# define zmemzero(dest, len) memset(dest, 0, len)
+# endif
+#else
+ void ZLIB_INTERNAL zmemcpy OF((Bytef* dest, const Bytef* source, uInt len));
+ int ZLIB_INTERNAL zmemcmp OF((const Bytef* s1, const Bytef* s2, uInt len));
+ void ZLIB_INTERNAL zmemzero OF((Bytef* dest, uInt len));
+#endif
+
+/* Diagnostic functions */
+#ifdef DEBUG
+# include <stdio.h>
+ extern int ZLIB_INTERNAL z_verbose;
+ extern void ZLIB_INTERNAL z_error OF((char *m));
+# define Assert(cond,msg) {if(!(cond)) z_error(msg);}
+# define Trace(x) {if (z_verbose>=0) fprintf x ;}
+# define Tracev(x) {if (z_verbose>0) fprintf x ;}
+# define Tracevv(x) {if (z_verbose>1) fprintf x ;}
+# define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;}
+# define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;}
+#else
+# define Assert(cond,msg)
+# define Trace(x)
+# define Tracev(x)
+# define Tracevv(x)
+# define Tracec(c,x)
+# define Tracecv(c,x)
+#endif
+
+
+voidpf ZLIB_INTERNAL zcalloc OF((voidpf opaque, unsigned items,
+ unsigned size));
+void ZLIB_INTERNAL zcfree OF((voidpf opaque, voidpf ptr));
+
+#define ZALLOC(strm, items, size) \
+ (*((strm)->zalloc))((strm)->opaque, (items), (size))
+#define ZFREE(strm, addr) (*((strm)->zfree))((strm)->opaque, (voidpf)(addr))
+#define TRY_FREE(s, p) {if (p) ZFREE(s, p);}
+
+#endif /* ZUTIL_H */
diff --git a/src/plugins/dcmtk/config/include/dcmtk/config/cfwin32.h b/src/plugins/dcmtk/config/include/dcmtk/config/cfwin32.h
index 430d794..100b995 100644
--- a/src/plugins/dcmtk/config/include/dcmtk/config/cfwin32.h
+++ b/src/plugins/dcmtk/config/include/dcmtk/config/cfwin32.h
@@ -343,7 +343,7 @@
#define HAVE_NEW_H 1
/* Define `pid_t' to `int' if <sys/types.h> does not define. */
-#define HAVE_NO_TYPEDEF_PID_T 1
+#undef HAVE_NO_TYPEDEF_PID_T
#ifdef HAVE_NO_TYPEDEF_PID_T
typedef int pid_t;
#endif
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
