From 72de5338731fa0d0196f506b9ef41b0a4271f655 Mon Sep 17 00:00:00 2001 From: Ole Streicher Date: Sat, 16 Mar 2024 13:21:09 +0100 Subject: [PATCH 1/4] Re-add cfitsio in vendor subdir This partially reverts commit d4b7ce02db25bace89ed30e2941cf5c8546586ee. --- Makefile | 11 +- test/files.md | 1 + vendor/Makefile | 23 + vendor/README | 1 + vendor/cfitsio/License.txt | 25 + vendor/cfitsio/Makefile.in | 198 + vendor/cfitsio/README | 109 + vendor/cfitsio/README.IRAF | 3 + vendor/cfitsio/buffers.c | 1377 ++++ vendor/cfitsio/cfileio.c | 8057 +++++++++++++++++++++++ vendor/cfitsio/cfitsio.pc.in | 12 + vendor/cfitsio/checksum.c | 508 ++ vendor/cfitsio/config.guess | 1700 +++++ vendor/cfitsio/config.sub | 1860 ++++++ vendor/cfitsio/configure | 8162 +++++++++++++++++++++++ vendor/cfitsio/drvrfile.c | 1004 +++ vendor/cfitsio/drvrmem.c | 1332 ++++ vendor/cfitsio/drvrnet.c | 4503 +++++++++++++ vendor/cfitsio/drvrsmem.c | 973 +++ vendor/cfitsio/drvrsmem.h | 179 + vendor/cfitsio/editcol.c | 3227 ++++++++++ vendor/cfitsio/edithdu.c | 924 +++ vendor/cfitsio/eval_defs.h | 205 + vendor/cfitsio/eval_f.c | 2954 +++++++++ vendor/cfitsio/eval_l.c | 2962 +++++++++ vendor/cfitsio/eval_tab.h | 130 + vendor/cfitsio/eval_y.c | 8607 +++++++++++++++++++++++++ vendor/cfitsio/fits_hcompress.c | 1859 ++++++ vendor/cfitsio/fits_hdecompress.c | 2614 ++++++++ vendor/cfitsio/fitscore.c | 9889 ++++++++++++++++++++++++++++ vendor/cfitsio/fitsio.h | 2085 ++++++ vendor/cfitsio/fitsio2.h | 1335 ++++ vendor/cfitsio/getcol.c | 1221 ++++ vendor/cfitsio/getcolb.c | 2046 ++++++ vendor/cfitsio/getcold.c | 1721 +++++ vendor/cfitsio/getcole.c | 1724 +++++ vendor/cfitsio/getcoli.c | 1962 ++++++ vendor/cfitsio/getcolj.c | 3855 +++++++++++ vendor/cfitsio/getcolk.c | 1955 ++++++ vendor/cfitsio/getcoll.c | 621 ++ vendor/cfitsio/getcols.c | 992 +++ vendor/cfitsio/getcolsb.c | 2045 ++++++ vendor/cfitsio/getcolui.c | 1967 ++++++ vendor/cfitsio/getcoluj.c | 3895 +++++++++++ vendor/cfitsio/getcoluk.c | 1975 ++++++ vendor/cfitsio/getkey.c | 3539 ++++++++++ vendor/cfitsio/group.c | 6736 +++++++++++++++++++ vendor/cfitsio/group.h | 68 + vendor/cfitsio/grparser.c | 1355 ++++ vendor/cfitsio/grparser.h | 183 + vendor/cfitsio/histo.c | 3252 ++++++++++ vendor/cfitsio/imcompress.c | 9955 +++++++++++++++++++++++++++++ vendor/cfitsio/install-sh | 509 ++ vendor/cfitsio/iraffits.c | 2101 ++++++ vendor/cfitsio/longnam.h | 628 ++ vendor/cfitsio/modkey.c | 1842 ++++++ vendor/cfitsio/pliocomp.c | 331 + vendor/cfitsio/putcol.c | 2186 +++++++ vendor/cfitsio/putcolb.c | 1040 +++ vendor/cfitsio/putcold.c | 1084 ++++ vendor/cfitsio/putcole.c | 1098 ++++ vendor/cfitsio/putcoli.c | 1003 +++ vendor/cfitsio/putcolj.c | 2029 ++++++ vendor/cfitsio/putcolk.c | 1033 +++ vendor/cfitsio/putcoll.c | 372 ++ vendor/cfitsio/putcols.c | 304 + vendor/cfitsio/putcolsb.c | 989 +++ vendor/cfitsio/putcolu.c | 629 ++ vendor/cfitsio/putcolui.c | 982 +++ vendor/cfitsio/putcoluj.c | 1966 ++++++ vendor/cfitsio/putcoluk.c | 1007 +++ vendor/cfitsio/putkey.c | 3335 ++++++++++ vendor/cfitsio/quantize.c | 3955 ++++++++++++ vendor/cfitsio/region.c | 1809 ++++++ vendor/cfitsio/region.h | 82 + vendor/cfitsio/ricecomp.c | 1361 ++++ vendor/cfitsio/scalnull.c | 229 + vendor/cfitsio/simplerng.c | 461 ++ vendor/cfitsio/simplerng.h | 27 + vendor/cfitsio/swapproc.c | 247 + vendor/cfitsio/wcssub.c | 1043 +++ vendor/cfitsio/wcsutil.c | 503 ++ vendor/cfitsio/zcompress.c | 533 ++ vendor/cfitsio/zuncompress.c | 603 ++ vendor/trim_cfitsio.sh | 47 + 85 files changed, 153262 insertions(+), 2 deletions(-) create mode 100644 vendor/Makefile create mode 100644 vendor/README create mode 100644 vendor/cfitsio/License.txt create mode 100644 vendor/cfitsio/Makefile.in create mode 100644 vendor/cfitsio/README create mode 100644 vendor/cfitsio/README.IRAF create mode 100644 vendor/cfitsio/buffers.c create mode 100644 vendor/cfitsio/cfileio.c create mode 100644 vendor/cfitsio/cfitsio.pc.in create mode 100644 vendor/cfitsio/checksum.c create mode 100755 vendor/cfitsio/config.guess create mode 100755 vendor/cfitsio/config.sub create mode 100755 vendor/cfitsio/configure create mode 100644 vendor/cfitsio/drvrfile.c create mode 100644 vendor/cfitsio/drvrmem.c create mode 100644 vendor/cfitsio/drvrnet.c create mode 100644 vendor/cfitsio/drvrsmem.c create mode 100644 vendor/cfitsio/drvrsmem.h create mode 100644 vendor/cfitsio/editcol.c create mode 100644 vendor/cfitsio/edithdu.c create mode 100644 vendor/cfitsio/eval_defs.h create mode 100644 vendor/cfitsio/eval_f.c create mode 100644 vendor/cfitsio/eval_l.c create mode 100644 vendor/cfitsio/eval_tab.h create mode 100644 vendor/cfitsio/eval_y.c create mode 100644 vendor/cfitsio/fits_hcompress.c create mode 100644 vendor/cfitsio/fits_hdecompress.c create mode 100644 vendor/cfitsio/fitscore.c create mode 100644 vendor/cfitsio/fitsio.h create mode 100644 vendor/cfitsio/fitsio2.h create mode 100644 vendor/cfitsio/getcol.c create mode 100644 vendor/cfitsio/getcolb.c create mode 100644 vendor/cfitsio/getcold.c create mode 100644 vendor/cfitsio/getcole.c create mode 100644 vendor/cfitsio/getcoli.c create mode 100644 vendor/cfitsio/getcolj.c create mode 100644 vendor/cfitsio/getcolk.c create mode 100644 vendor/cfitsio/getcoll.c create mode 100644 vendor/cfitsio/getcols.c create mode 100644 vendor/cfitsio/getcolsb.c create mode 100644 vendor/cfitsio/getcolui.c create mode 100644 vendor/cfitsio/getcoluj.c create mode 100644 vendor/cfitsio/getcoluk.c create mode 100644 vendor/cfitsio/getkey.c create mode 100644 vendor/cfitsio/group.c create mode 100644 vendor/cfitsio/group.h create mode 100644 vendor/cfitsio/grparser.c create mode 100644 vendor/cfitsio/grparser.h create mode 100644 vendor/cfitsio/histo.c create mode 100644 vendor/cfitsio/imcompress.c create mode 100755 vendor/cfitsio/install-sh create mode 100644 vendor/cfitsio/iraffits.c create mode 100644 vendor/cfitsio/longnam.h create mode 100644 vendor/cfitsio/modkey.c create mode 100644 vendor/cfitsio/pliocomp.c create mode 100644 vendor/cfitsio/putcol.c create mode 100644 vendor/cfitsio/putcolb.c create mode 100644 vendor/cfitsio/putcold.c create mode 100644 vendor/cfitsio/putcole.c create mode 100644 vendor/cfitsio/putcoli.c create mode 100644 vendor/cfitsio/putcolj.c create mode 100644 vendor/cfitsio/putcolk.c create mode 100644 vendor/cfitsio/putcoll.c create mode 100644 vendor/cfitsio/putcols.c create mode 100644 vendor/cfitsio/putcolsb.c create mode 100644 vendor/cfitsio/putcolu.c create mode 100644 vendor/cfitsio/putcolui.c create mode 100644 vendor/cfitsio/putcoluj.c create mode 100644 vendor/cfitsio/putcoluk.c create mode 100644 vendor/cfitsio/putkey.c create mode 100644 vendor/cfitsio/quantize.c create mode 100644 vendor/cfitsio/region.c create mode 100644 vendor/cfitsio/region.h create mode 100644 vendor/cfitsio/ricecomp.c create mode 100644 vendor/cfitsio/scalnull.c create mode 100644 vendor/cfitsio/simplerng.c create mode 100644 vendor/cfitsio/simplerng.h create mode 100644 vendor/cfitsio/swapproc.c create mode 100644 vendor/cfitsio/wcssub.c create mode 100644 vendor/cfitsio/wcsutil.c create mode 100644 vendor/cfitsio/zcompress.c create mode 100644 vendor/cfitsio/zuncompress.c create mode 100755 vendor/trim_cfitsio.sh diff --git a/Makefile b/Makefile index c76c07b84..154830090 100644 --- a/Makefile +++ b/Makefile @@ -41,7 +41,7 @@ export CFLAGS ?= -g -O2 export XC_CFLAGS = $(CPPFLAGS) $(CFLAGS) export XC_LFLAGS = $(LDFLAGS) -.PHONY: all sysgen clean test arch noao host novos core bindirs bin_links config inplace starttime +.PHONY: all sysgen clean test arch noao host novos core vendor bindirs bin_links config inplace starttime all:: sysgen @@ -73,8 +73,14 @@ host: novos $(MAKE) -C $(host) bindir=$(hbin) boot/install $(MAKE) -C $(host) clean +# Build vendor libs (libvotable) +vendor: host + $(MAKE) -C $(iraf)vendor \ + includedir=$(iraf)include/ bindir=$(bin) install + $(MAKE) -C $(iraf)vendor clean + # Build the core system. -core: host +core: host vendor $(MKPKG) # Build the NOAO package. @@ -90,6 +96,7 @@ test: # by generic, xyacc and similar. clean: $(MAKE) -C unix clean + $(MAKE) -C vendor clean find ./local ./math ./pkg ./sys ./noao/[adfimnorst]* \ -type f -name \*.\[aeo\] -exec rm -f {} \; rm -f $(bin)/* noao/bin$(arch)/* $(hbin)* .build_started \ diff --git a/test/files.md b/test/files.md index d5c2a4992..06ee2ce3f 100644 --- a/test/files.md +++ b/test/files.md @@ -60,6 +60,7 @@ host$bin/xyacc.e cl> dir bin$*.a ncol=1 bin$libbev.a bin$libc.a +bin$libcfitsio.a bin$libcur.a bin$libcurfit.a bin$libdeboor.a diff --git a/vendor/Makefile b/vendor/Makefile new file mode 100644 index 000000000..1b021a61f --- /dev/null +++ b/vendor/Makefile @@ -0,0 +1,23 @@ +export bindir ?= $(bin) +export includedir ?= $(iraf)include/ + +all: cfitsio + +install: all + mkdir -p $(includedir) $(bindir) + $(MAKE) -C cfitsio install + rm -rf $(bindir)pkgconfig/ + rmdir $(bindir)pkgconfig || true + +clean: + $(MAKE) -C cfitsio distclean || true + +cfitsio: + cd cfitsio && \ + ./configure --includedir=$(includedir) \ + --bindir=$(bindir) --libdir=$(bindir) \ + --disable-curl \ + FC=none + $(MAKE) -C cfitsio libcfitsio.a + +.PHONY: cfitsio clean all install diff --git a/vendor/README b/vendor/README new file mode 100644 index 000000000..8b1378917 --- /dev/null +++ b/vendor/README @@ -0,0 +1 @@ + diff --git a/vendor/cfitsio/License.txt b/vendor/cfitsio/License.txt new file mode 100644 index 000000000..2f5f48d3d --- /dev/null +++ b/vendor/cfitsio/License.txt @@ -0,0 +1,25 @@ +Copyright (Unpublished--all rights reserved under the copyright laws of +the United States), U.S. Government as represented by the Administrator +of the National Aeronautics and Space Administration. No copyright is +claimed in the United States under Title 17, U.S. Code. + +Permission to freely use, copy, modify, and distribute this software +and its documentation without fee is hereby granted, provided that this +copyright notice and disclaimer of warranty appears in all copies. + +DISCLAIMER: + +THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND, +EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO, +ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY +IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE +DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE +SOFTWARE WILL BE ERROR FREE. IN NO EVENT SHALL NASA BE LIABLE FOR ANY +DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR +CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY +CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY, +CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY +PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED +FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR +SERVICES PROVIDED HEREUNDER. diff --git a/vendor/cfitsio/Makefile.in b/vendor/cfitsio/Makefile.in new file mode 100644 index 000000000..2e2d2506a --- /dev/null +++ b/vendor/cfitsio/Makefile.in @@ -0,0 +1,198 @@ +# +# Makefile for cfitsio library: +# +# Oct-96 : original version by +# +# JDD/WDP +# NASA GSFC +# Oct 1996 +# +# 25-Jan-01 : removed conditional drvrsmem.c compilation because this +# is now handled within the source file itself. +# 09-Mar-98 : modified to conditionally compile drvrsmem.c. Also +# changes to target all (deleted clean), added DEFS, LIBS, added +# DEFS to .c.o, added SOURCES_SHMEM and MY_SHMEM, expanded getcol* +# and putcol* in SOURCES, modified OBJECTS, mv changed to /bin/mv +# (to bypass aliasing), cp changed to /bin/cp, add smem and +# testprog targets. See also changes and comments in configure.in + + +# Default library name: +PACKAGE = cfitsio + +# CFITSIO version numbers: +CFITSIO_MAJOR = @CFITSIO_MAJOR@ +CFITSIO_MINOR = @CFITSIO_MINOR@ +CFITSIO_MICRO = @CFITSIO_MICRO@ +CFITSIO_SONAME = @CFITSIO_SONAME@ + +prefix = @prefix@ +exec_prefix = @exec_prefix@ +CFITSIO_BIN = ${DESTDIR}@bindir@ +CFITSIO_LIB = ${DESTDIR}@libdir@ +CFITSIO_INCLUDE = ${DESTDIR}@includedir@ +INSTALL_DIRS = ${DESTDIR}@INSTALL_ROOT@ ${CFITSIO_INCLUDE} ${CFITSIO_LIB} ${CFITSIO_LIB}/pkgconfig + + +SHELL = /bin/sh +ARCHIVE = @ARCHIVE@ +RANLIB = @RANLIB@ +CC = @CC@ +CFLAGS = @CFLAGS@ +CPPFLAGS = @CPPFLAGS@ +SSE_FLAGS = @SSE_FLAGS@ +FC = @FC@ +LDFLAGS = @LDFLAGS@ +LDFLAGS_BIN = @LDFLAGS_BIN@ +DEFS = @DEFS@ +LIBS = @LIBS@ +LIBS_CURL = @LIBS_CURL@ +FLEX = flex +BISON = bison + +SHLIB_LD = @SHLIB_LD@ +SHLIB_SUFFIX = @SHLIB_SUFFIX@ +CFITSIO_SHLIB = @CFITSIO_SHLIB@ +CFITSIO_SHLIB_SONAME = @CFITSIO_SHLIB_SONAME@ + + +CORE_SOURCES = buffers.c cfileio.c checksum.c drvrfile.c drvrmem.c \ + drvrnet.c drvrsmem.c editcol.c edithdu.c eval_l.c \ + eval_y.c eval_f.c fitscore.c getcol.c getcolb.c getcold.c getcole.c \ + getcoli.c getcolj.c getcolk.c getcoll.c getcols.c getcolsb.c \ + getcoluk.c getcolui.c getcoluj.c getkey.c group.c grparser.c \ + histo.c iraffits.c \ + modkey.c putcol.c putcolb.c putcold.c putcole.c putcoli.c \ + putcolj.c putcolk.c putcoluk.c putcoll.c putcols.c putcolsb.c \ + putcolu.c putcolui.c putcoluj.c putkey.c region.c scalnull.c \ + swapproc.c wcssub.c wcsutil.c imcompress.c quantize.c ricecomp.c \ + pliocomp.c fits_hcompress.c fits_hdecompress.c \ + simplerng.c @GSIFTP_SRC@ + +ZLIB_SOURCES = zcompress.c zuncompress.c + +SOURCES = ${CORE_SOURCES} ${ZLIB_SOURCES} @F77_WRAPPERS@ + +OBJECTS = ${SOURCES:.c=.o} + +CORE_OBJECTS = ${CORE_SOURCES:.c=.o} ${ZLIB_SOURCES:.c=.o} + + +FITSIO_SRC = f77_wrap1.c f77_wrap2.c f77_wrap3.c f77_wrap4.c + +# ============ description of all targets ============= +# - <<-- ignore error code + +all: + @if [ "x${FC}" = x ]; then \ + ${MAKE} all-nofitsio; \ + else \ + ${MAKE} stand_alone; \ + fi + +all-nofitsio: + ${MAKE} stand_alone "FITSIO_SRC=" + +stand_alone: lib${PACKAGE}.a shared + +lib${PACKAGE}.a: ${OBJECTS} + ${ARCHIVE} $@ ${OBJECTS}; \ + ${RANLIB} $@; + +shared: lib${PACKAGE}${SHLIB_SUFFIX} + +lib${PACKAGE}${SHLIB_SUFFIX}: ${OBJECTS} + ${SHLIB_LD} ${LDFLAGS} -o ${CFITSIO_SHLIB} ${OBJECTS} -lm ${LIBS_CURL} ${LIBS} + @if [ "x${CFITSIO_SHLIB_SONAME}" != x ]; then \ + ln -sf ${CFITSIO_SHLIB} ${CFITSIO_SHLIB_SONAME}; \ + ln -sf ${CFITSIO_SHLIB_SONAME} $@; \ + fi + +install: lib${PACKAGE}.a ${INSTALL_DIRS} + @for lib in lib${PACKAGE}.a lib${PACKAGE}${SHLIB_SUFFIX} \ + ${CFITSIO_SHLIB} ${CFITSIO_SHLIB_SONAME}; do \ + if [ -f $$lib ]; then \ + echo "/bin/rm -f ${CFITSIO_LIB}/$$lib"; \ + /bin/rm -f ${CFITSIO_LIB}/$$lib; \ + echo "/bin/cp -a $$lib ${CFITSIO_LIB}"; \ + /bin/cp -a $$lib ${CFITSIO_LIB}; \ + fi; \ + done + /bin/cp fitsio.h fitsio2.h longnam.h drvrsmem.h ${CFITSIO_INCLUDE} + /bin/cp cfitsio.pc ${CFITSIO_LIB}/pkgconfig + @for task in ${FPACK_UTILS} ${UTILS}; do \ + if [ -f $$task ]; then \ + if [ ! -d ${CFITSIO_BIN} ]; then mkdir -p ${CFITSIO_BIN}; fi; \ + echo "/bin/cp $$task ${CFITSIO_BIN}"; \ + /bin/cp $$task ${CFITSIO_BIN}; \ + fi; \ + done + +.c.o: + ${CC} -c -o ${ ./configure [--prefix=/target/installation/path] + > make (or 'make shared') + > make install (this step is optional) + +at the operating system prompt. The configure command customizes the +Makefile for the particular system, then the `make' command compiles the +source files and builds the library. Type `./configure' and not simply +`configure' to ensure that the configure script in the current directory +is run and not some other system-wide configure script. The optional +'prefix' argument to configure gives the path to the directory where +the CFITSIO library and include files should be installed via the later +'make install' command. For example, + + > ./configure --prefix=/usr1/local + +will cause the 'make install' command to copy the CFITSIO libcfitsio file +to /usr1/local/lib and the necessary include files to /usr1/local/include +(assuming of course that the process has permission to write to these +directories). + +All the available configure options can be seen by entering the command + + > ./configure --help + +On VAX/VMS and ALPHA/VMS systems the make.com command file may be used +to build the cfitsio.olb object library using the default G-floating +point option for double variables. The make\_dfloat.com and make\_ieee.com +files may be used instead to build the library with the other floating +point options. + +A precompiled DLL version of CFITSIO is available for IBM-PC users of +the Borland or Microsoft Visual C++ compilers in the files +cfitsiodll_xxxx_borland.zip and cfitsiodll_xxxx_vcc.zip, where 'xxxx' +represents the current release number. These zip archives also +contains other files and instructions on how to use the CFITSIO DLL +library. The CFITSIO library may also be built from the source code +using the makefile.bc or makefile.vcc files. Finally, the makepc.bat +file gives an example of building CFITSIO with the Borland C++ v4.5 +compiler using simpler DOS commands. + +Instructions for building CFITSIO on Mac OS can be found in +the README.MacOS file. + +TESTING CFITSIO +--------------- + +The CFITSIO library should be tested by building and running +the testprog.c program that is included with the release. +On Unix systems, type: +- + % make testprog + % testprog > testprog.lis + % diff testprog.lis testprog.out + % cmp testprog.fit testprog.std +- + On VMS systems, +(assuming cc is the name of the C compiler command), type: +- + $ cc testprog.c + $ link testprog, cfitsio/lib + $ run testprog +- +The testprog program should produce a FITS file called `testprog.fit' +that is identical to the testprog.std FITS file included in this +release. The diagnostic messages (which were piped to the file +testprog.lis in the Unix example) should be identical to the listing +contained in the file testprog.out. The 'diff' and 'cmp' commands +shown above should not report any differences in the files. + +USING CFITSIO +------------- + +The CFITSIO User's Guide, contained in the files cfitsio.doc (plain +text file) and cfitsio.ps (postscript file), provides detailed +documentation about how to build and use the CFITSIO library. +It contains a description of every user-callable routine in the +CFITSIO interface. + +The cookbook.c file provides some sample routines for performing common +operations on various types of FITS files. Programmers are urged to +examine these routines for recommended programming practices when using +CFITSIO. Users are free to copy or modify these routines for their own +purposes. + +Any problem reports or suggestions for +improvements are welcome and should be sent to the HEASARC +help desk. + +------------------------------------------------------------------------- +William D. Pence +HEASARC, NASA/GSFC diff --git a/vendor/cfitsio/README.IRAF b/vendor/cfitsio/README.IRAF new file mode 100644 index 000000000..55a0f76e5 --- /dev/null +++ b/vendor/cfitsio/README.IRAF @@ -0,0 +1,3 @@ +Note: IRAF only requires the CFITSIO library, and hence in this bundled version, +we removed all other files except the required license (License.txt) and changelog +(docs/changes.txt, which has the version number). diff --git a/vendor/cfitsio/buffers.c b/vendor/cfitsio/buffers.c new file mode 100644 index 000000000..d3795e3f2 --- /dev/null +++ b/vendor/cfitsio/buffers.c @@ -0,0 +1,1377 @@ +/* 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 +#include +#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); + + if (nbytes > LONG_MAX) { + ffpmsg("Number of bytes to write is greater than LONG_MAX (ffpbyt)."); + *status = WRITE_ERROR; + return(*status); + } + + ntodo = (long) nbytes; + cptr = (char *)buffer; + + 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[FLEN_ERRMSG]; + + 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) + { + snprintf(message, FLEN_ERRMSG, + "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/vendor/cfitsio/cfileio.c b/vendor/cfitsio/cfileio.c new file mode 100644 index 000000000..d36b4f523 --- /dev/null +++ b/vendor/cfitsio/cfileio.c @@ -0,0 +1,8057 @@ +/* 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 +#include +#include +#include +#include +#include /* apparently needed to define size_t */ +#include "fitsio2.h" +#include "group.h" +#ifdef CFITSIO_HAVE_CURL + #include +#endif + +#define MAX_PREFIX_LEN 20 /* max length of file type prefix (e.g. 'http://') */ +#define MAX_DRIVERS 31 /* 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); +static int find_quote(char **string); +static int find_doublequote(char **string); +static int find_paren(char **string); +static int find_bracket(char **string); +static int find_curlybracket(char **string); +static int standardize_path(char *fullpath, int *status); +int comma2semicolon(char *string); + +#ifdef _REENTRANT + +pthread_mutex_t Fitsio_InitLock = PTHREAD_MUTEX_INITIALIZER; + +#endif + +/*--------------------------------------------------------------------------*/ +int fitsio_init_lock(void) +{ + int status = 0; + +#ifdef _REENTRANT + + static int need_to_init = 1; + + 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 */ + + status = pthread_mutexattr_init(&mutex_init); + if (status) { + ffpmsg("pthread_mutexattr_init failed (fitsio_init_lock)"); + return(status); + } + +#ifdef __GLIBC__ + status = pthread_mutexattr_settype(&mutex_init, + PTHREAD_MUTEX_RECURSIVE_NP); +#else + status = pthread_mutexattr_settype(&mutex_init, + PTHREAD_MUTEX_RECURSIVE); +#endif + if (status) { + ffpmsg("pthread_mutexattr_settype failed (fitsio_init_lock)"); + return(status); + } + + status = pthread_mutex_init(&Fitsio_Lock,&mutex_init); + if (status) { + ffpmsg("pthread_mutex_init failed (fitsio_init_lock)"); + return(status); + } + + need_to_init = 0; + } + + FFUNLOCK1(Fitsio_InitLock); + +#endif + + return(status); +} +/*--------------------------------------------------------------------------*/ +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 */ + ((*fptr)->Fptr)->noextsyntax = 0; /* extended syntax can be used in filename */ + + 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) + { + snprintf(errmsg, FLEN_ERRMSG, + " extension number %d doesn't exist or couldn't be opened.",extnum); + ffpmsg(errmsg); + } + else + { + snprintf(errmsg, FLEN_ERRMSG, + " extension with EXTNAME = %s,", extname); + ffpmsg(errmsg); + + if (extvers) + { + snprintf(errmsg, FLEN_ERRMSG, + " and with EXTVERS = %d,", extvers); + ffpmsg(errmsg); + } + + if (movetotype != ANY_HDU) + { + snprintf(errmsg, FLEN_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 ffeopn(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 */ + char *extlist, /* I - list of 'good' extensions to move to */ + int *hdutype, /* O - type of extension that is moved to */ + int *status) /* IO - error status */ +/* + Open an existing FITS file with either readonly or read/write access. and + if the primary array contains a null image (i.e., NAXIS = 0) then attempt to + move to the first extension named in the extlist of extension names. If + none are found, then simply move to the 2nd extension. +*/ +{ + int hdunum, naxis = 0, thdutype, gotext=0; + char *ext, *textlist; + char *saveptr; + + if (*status > 0) + return(*status); + + if (ffopen(fptr, name, mode, status) > 0) + return(*status); + + fits_get_hdu_num(*fptr, &hdunum); + fits_get_hdu_type(*fptr, &thdutype, status); + if (hdunum == 1 && thdutype == IMAGE_HDU) { + fits_get_img_dim(*fptr, &naxis, status); + } + + /* We are in the "default" primary extension */ + /* look through the extension list */ + if( (hdunum == 1) && (naxis == 0) ){ + if( extlist ){ + gotext = 0; + textlist = malloc(strlen(extlist) + 1); + if (!textlist) { + *status = MEMORY_ALLOCATION; + return(*status); + } + + strcpy(textlist, extlist); + for(ext=(char *)ffstrtok(textlist, " ",&saveptr); ext != NULL; + ext=(char *)ffstrtok(NULL," ",&saveptr)){ + fits_movnam_hdu(*fptr, ANY_HDU, ext, 0, status); + if( *status == 0 ){ + gotext = 1; + break; + } else { + *status = 0; + } + } + free(textlist); + } + if( !gotext ){ + /* if all else fails, move to extension #2 and hope for the best */ + fits_movabs_hdu(*fptr, 2, &thdutype, status); + } + } + if (hdutype) { + fits_get_hdu_type(*fptr, hdutype, 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(int soname, /* I - CFITSIO shared library version */ + /* 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 SONAME of fitsio.h used to build the CFITSIO library + is the same as was used in compiling the application program that + links to the library. +*/ +{ + if (soname != CFITSIO_SONAME) + { + printf("\nERROR: Mismatch in the CFITSIO_SONAME value in the fitsio.h include file\n"); + printf("that was used to build the CFITSIO library, and the value in the include file\n"); + printf("that was used when compiling the application program:\n"); + printf(" Version used to build the CFITSIO library = %d\n",CFITSIO_SONAME); + printf(" Version included by the application program = %d\n",soname); + printf("\nFix this by recompiling and then relinking this application program \n"); + printf("with the CFITSIO library.\n"); + + *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], compspec[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'; + compspec[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. */ + + /* call the newer version of this parsing routine that supports 'compspec' */ + ffifile2(url, urltype, infile, outfile, extspec, + rowfilter, binspec, colspec, pixfilter, compspec, 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, open_disk_file, &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 */ + ((*fptr)->Fptr)->noextsyntax = open_disk_file; /* true if extended syntax is disabled */ + + 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) + { + snprintf(errmsg, FLEN_ERRMSG, + " extension number %d doesn't exist or couldn't be opened.",extnum); + ffpmsg(errmsg); + } + else + { + snprintf(errmsg, FLEN_ERRMSG, + " extension with EXTNAME = %s,", extname); + ffpmsg(errmsg); + + if (extvers) + { + snprintf(errmsg, FLEN_ERRMSG, + " and with EXTVERS = %d,", extvers); + ffpmsg(errmsg); + } + + if (movetotype != ANY_HDU) + { + snprintf(errmsg, FLEN_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")) && + fits_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 satisfying 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 */ + + + /* leave it up to calling routine to write any HISTORY keywords */ + } + + /* --------------------------------------------------------------------- */ + /* 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) + { + char **exprs = 0; + 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 */ + ffbinse(binspec, &imagetype, &haxis, colname, + minin, maxin, binsizein, + minname, maxname, binname, + &weight, wtcol, &recip, &(exprs), 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. */ + ffhist2e(fptr, outfile, imagetype, haxis, + colname, exprs, minin, maxin, binsizein, + minname, maxname, binname, + weight, wtcol, (exprs?exprs[4]:0), + recip, rowselect, status); + + if (exprs) free(exprs); + + 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); + } + 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); + } + } + + /* parse and save image compression specification, if given */ + if (*compspec) { + ffparsecompspec(*fptr, compspec, 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 noextsyn, /* I - 0 = ext syntax may be used; 1 = ext syntax disabled */ + 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, iMatch=-1; + 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); + + strcpy(tmpinfile, infile); + if(fits_strcasecmp(urltype,"FILE://") == 0) + { + if (standardize_path(tmpinfile, status)) + return(*status); + } + + for (ii = 0; ii < NMAXFILES; ii++) /* check every buffer */ + { + if (FptrTable[ii] != 0) + { + oldFptr = FptrTable[ii]; + + if (oldFptr->noextsyntax) + { + /* old urltype must be "file://" */ + if (fits_strcasecmp(urltype,"FILE://") == 0) + { + /* compare tmpinfile to adjusted oldFptr->filename */ + + /* This shouldn't be possible, but check anyway */ + if (strlen(oldFptr->filename) > FLEN_FILENAME-1) + { + ffpmsg("Name of old file is too long. (fits_already_open)"); + return (*status = FILE_NOT_OPENED); + } + strcpy(oldinfile, oldFptr->filename); + if (standardize_path(oldinfile, status)) + return(*status); + + if (!strcmp(tmpinfile, oldinfile)) + { + /* if infile is not noextsyn, must check that it is not + using filters of any kind */ + if (noextsyn || (!rowfilter[0] && !binspec[0] && !colspec[0])) + { + 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); + } + iMatch = ii; + } + } + } + } /* end if old file has disabled extended syntax */ + else + { + 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(fits_strcasecmp(oldurltype,"FILE://") == 0) + { + if (standardize_path(oldinfile, status)) + return(*status); + } + + 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); + } + iMatch = ii; + + } + } + } /* end if old file recognizes extended syntax */ + } /* end if old fptr exists */ + } /* end loop over NMAXFILES */ + if (iMatch >= 0) + { + oldFptr = FptrTable[iMatch]; + *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 standardize_path(char *fullpath, int* status) +{ + /* Utility function for common operation in fits_already_open + fullpath: I/O string to be standardized. Assume len = FLEN_FILENAME */ + + char tmpPath[FLEN_FILENAME]; + char cwd [FLEN_FILENAME]; + + if (fits_path2url(fullpath, FLEN_FILENAME, tmpPath, status)) + return(*status); + + if (tmpPath[0] != '/') + { + fits_get_cwd(cwd,status); + if (strlen(cwd) + strlen(tmpPath) + 1 > FLEN_FILENAME-1) { + ffpmsg("Tile name is too long. (standardize_path)"); + return(*status = FILE_NOT_OPENED); + } + strcat(cwd,"/"); + strcat(cwd,tmpPath); + fits_clean_url(cwd,tmpPath,status); + } + + strcpy(fullpath, tmpPath); + + 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); +} +/*--------------------------------------------------------------------------*/ +static int find_quote(char **string) + +/* + look for the closing single quote character in the input string +*/ +{ + char *tstr; + + tstr = *string; + + while (*tstr) { + if (*tstr == '\'') { /* found the closing quote */ + *string = tstr + 1; /* set pointer to next char */ + return(0); + } else { /* skip over any other character */ + tstr++; + } + } + return(1); /* opps, didn't find the closing character */ +} + +/*--------------------------------------------------------------------------*/ +char *fits_find_match_delim(char *string, char delim) +/* + Find matching delimiter, respecting quoting and (potentially nested) parentheses + + char *string - null-terminated string to be searched for delimiter + char delim - single delimiter to search for (one of '")]} ) + + returns: pointer to character after delimiter, or 0 if not found +*/ +{ + char *tstr = string; + int retval = 0; + + if (!string) return 0; + switch (delim) { + case '\'': retval = find_quote(&tstr); break; + case '"': retval = find_doublequote(&tstr); break; + case '}': retval = find_curlybracket(&tstr); break; + case ']': retval = find_bracket(&tstr); break; + case ')': retval = find_paren(&tstr); break; + default: return 0; /* Invalid delimeter, return failure */ + } + + /* Delimeter not found, return failure */ + if (retval) return 0; + + /* Delimeter was found, return next position */ + return (tstr); +} + +/*--------------------------------------------------------------------------*/ +static int find_doublequote(char **string) + +/* + look for the closing double quote character in the input string +*/ +{ + char *tstr; + + tstr = *string; + + while (*tstr) { + if (*tstr == '"') { /* found the closing quote */ + *string = tstr + 1; /* set pointer to next char */ + return(0); + } else { /* skip over any other character */ + tstr++; + } + } + return(1); /* opps, didn't find the closing character */ +} + +/*--------------------------------------------------------------------------*/ +static int find_paren(char **string) + +/* + look for the closing parenthesis character in the input string +*/ +{ + char *tstr; + + tstr = *string; + + while (*tstr) { + + if (*tstr == ')') { /* found the closing parens */ + *string = tstr + 1; /* set pointer to next char */ + return(0); + } else if (*tstr == '(') { /* found another level of parens */ + tstr++; + if (find_paren(&tstr)) return(1); + } else if (*tstr == '[') { + tstr++; + if (find_bracket(&tstr)) return(1); + } else if (*tstr == '{') { + tstr++; + if (find_curlybracket(&tstr)) return(1); + } else if (*tstr == '"') { + tstr++; + if (find_doublequote(&tstr)) return(1); + } else if (*tstr == '\'') { + tstr++; + if (find_quote(&tstr)) return(1); + } else { + tstr++; + } + } + return(1); /* opps, didn't find the closing character */ +} +/*--------------------------------------------------------------------------*/ +static int find_bracket(char **string) + +/* + look for the closing bracket character in the input string +*/ +{ + char *tstr; + + tstr = *string; + + while (*tstr) { + if (*tstr == ']') { /* found the closing bracket */ + *string = tstr + 1; /* set pointer to next char */ + return(0); + } else if (*tstr == '(') { /* found another level of parens */ + tstr++; + if (find_paren(&tstr)) return(1); + } else if (*tstr == '[') { + tstr++; + if (find_bracket(&tstr)) return(1); + } else if (*tstr == '{') { + tstr++; + if (find_curlybracket(&tstr)) return(1); + } else if (*tstr == '"') { + tstr++; + if (find_doublequote(&tstr)) return(1); + } else if (*tstr == '\'') { + tstr++; + if (find_quote(&tstr)) return(1); + } else { + tstr++; + } + } + return(1); /* opps, didn't find the closing character */ +} +/*--------------------------------------------------------------------------*/ +static int find_curlybracket(char **string) + +/* + look for the closing curly bracket character in the input string +*/ +{ + char *tstr; + + tstr = *string; + + while (*tstr) { + if (*tstr == '}') { /* found the closing curly bracket */ + *string = tstr + 1; /* set pointer to next char */ + return(0); + } else if (*tstr == '(') { /* found another level of parens */ + tstr++; + if (find_paren(&tstr)) return(1); + } else if (*tstr == '[') { + tstr++; + if (find_bracket(&tstr)) return(1); + } else if (*tstr == '{') { + tstr++; + if (find_curlybracket(&tstr)) return(1); + } else if (*tstr == '"') { + tstr++; + if (find_doublequote(&tstr)) return(1); + } else if (*tstr == '\'') { + tstr++; + if (find_quote(&tstr)) return(1); + } else { + tstr++; + } + } + return(1); /* opps, didn't find the closing character */ +} +/*--------------------------------------------------------------------------*/ +int comma2semicolon(char *string) + +/* + replace commas with semicolons, unless the comma is within a quoted or bracketed expression +*/ +{ + char *tstr; + + tstr = string; + + while (*tstr) { + + if (*tstr == ',') { /* found a comma */ + *tstr = ';'; + tstr++; + } else if (*tstr == '(') { /* found another level of parens */ + tstr++; + if (find_paren(&tstr)) return(1); + } else if (*tstr == '[') { + tstr++; + if (find_bracket(&tstr)) return(1); + } else if (*tstr == '{') { + tstr++; + if (find_curlybracket(&tstr)) return(1); + } else if (*tstr == '"') { + tstr++; + if (find_doublequote(&tstr)) return(1); + } else if (*tstr == '\'') { + tstr++; + if (find_quote(&tstr)) return(1); + } else { + tstr++; + } + } + return(0); /* reached end of string */ +} +/*--------------------------------------------------------------------------*/ +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 *tstbuff=0, *cptr, *cptr2, *cptr3, *clause = NULL, 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 */ + + /* as of July 2012, the CFITSIO column filter syntax was modified */ + /* so that commas may be used to separate clauses, as well as semi-colons. */ + /* This was done because users cannot enter the semi-colon in the HEASARC's */ + /* Hera on-line data processing system for computer security reasons. */ + /* Therefore, we must convert those commas back to semi-colons here, but we */ + /* must not convert any columns that occur within parenthesies. */ + + if (comma2semicolon(cptr)) { + ffpmsg("parsing error in column filter expression"); + ffpmsg(cptr); + if( file_expr ) free( file_expr ); + *status = PARSE_SYNTAX_ERR; + return(*status); + } + + /* parse expression and get first clause, if more than 1 */ + while ((slen = fits_get_token2(&cptr, ";", &clause, NULL, status)) > 0 ) + { + if( *cptr==';' ) cptr++; + clause[slen] = '\0'; + + if (clause[0] == '!' || clause[0] == '-') + { + char *clause1 = clause+1; + int clen = clause1[0] ? strlen(clause1) : 0; + /* ===================================== */ + /* Case I. delete this column or keyword */ + /* ===================================== */ + + /* Case Ia. delete column names with 0-or-more wildcard + -COLNAME+ - delete repeated columns with exact name + -COLNAM*+ - delete columns matching patterns + */ + if (*status == 0 && + clen > 1 && clause1[0] != '#' && + clause1[clen-1] == '+') { + + clause1[clen-1] = 0; clen--; + + /* Note that this is a delete 0 or more specification, + which means that no matching columns is not an error. */ + do { + int status_del = 0; + + /* Have to set status=0 so we can reset the search at + start column. Because we are deleting columns on + the fly here, we have to reset the search every + time. The only penalty here is execution time + because leaving *status == COL_NOT_UNIQUE is merely + an optimization for tables assuming the tables do + not change from one call to the next. (an + assumption broken in this loop) */ + *status = 0; + ffgcno(*fptr, CASEINSEN, clause1, &colnum, status); + /* ffgcno returns COL_NOT_UNIQUE if there are multiple columns, + and COL_NOT_FOUND after the last column is found, and + COL_NOT_FOUND if no matches were found */ + if (*status != 0 && *status != COL_NOT_UNIQUE) break; + + if (ffdcol(*fptr, colnum, &status_del) > 0) { + ffpmsg("failed to delete column in input file:"); + ffpmsg(clause); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + if( clause ) free(clause); + return (*status = status_del); + } + deletecol = 1; /* set flag that at least one col was deleted */ + numcols--; + } while (*status == COL_NOT_UNIQUE); + + *status = 0; /* No matches are still successful */ + colnum = -1; /* Ignore the column we found */ + + /* Case Ib. delete column names with wildcard or not + -COLNAME - deleted exact column + -COLNAM* - delete first column that matches pattern + Note no leading '#' + */ + } else if (clause1[0] && clause1[0] != '#' && + ((ffgcno(*fptr, CASEINSEN, clause1, &colnum, status) <= 0) || + *status == COL_NOT_UNIQUE)) + { + /* a column with this name exists, so try to delete it */ + *status = 0; /* Clear potential status=COL_NOT_UNIQUE */ + 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 ); + if( clause ) free(clause); + return(*status); + } + deletecol = 1; /* set flag that at least one col was deleted */ + numcols--; + colnum = -1; + } + /* Case Ic. delete keyword(s) + -KEYNAME,#KEYNAME - delete exact keyword (first match) + -KEYNAM*,#KEYNAM* - delete first matching keyword + -KEYNAME+,-#KEYNAME+ - delete 0-or-more exact matches of exact keyword + -KEYNAM*+,-#KEYNAM*+ - delete 0-or-more wildcard matches + Note the preceding # is optional if no conflicting column name exists + and that wildcard patterns are described in "colfilter" section of + documentation. + */ + else + { + int delall = 0; + int haswild = 0; + ffcmsg(); /* clear previous error message from ffgcno */ + /* try deleting a keyword with this name */ + *status = 0; + /* skip past leading '#' if any */ + if (clause1[0] == '#') clause1++; + clen = strlen(clause1); + + /* Repeat deletion of keyword if requested with trailing '+' */ + if (clen > 1 && clause1[clen-1] == '+') { + delall = 1; + clause1[clen-1] = 0; + } + /* Determine if this pattern has wildcards */ + if (strchr(clause1,'?') || strchr(clause1,'*') || strchr(clause1,'#')) { + haswild = 1; + } + + if (haswild) { + /* ffdkey() behaves differently if the pattern has a wildcard: + it only checks from the "current" header position to the end, and doesn't + check before the "current" header position. Therefore, for the + case of wildcards we will have to reset to the beginning. */ + ffmaky(*fptr, 1, status); /* reset pointer to beginning of header */ + } + + /* Single or repeated deletions until done */ + do { + if (ffdkey(*fptr, clause1, status) > 0) + { + if (delall && *status == KEY_NO_EXIST) { + /* Found last wildcard item. Stop deleting */ + ffcmsg(); + *status = 0; + delall = 0; /* Force end of this loop */ + } else { + /* This was not a wildcard deletion, or it resulted in + another kind of error */ + ffpmsg("column or keyword to be deleted does not exist:"); + ffpmsg(clause1); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + if( clause ) free(clause); + return(*status); + } + } + } while(delall); /* end do{} */ + } + } + 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_token2(&cptr2, "( =", &tstbuff, NULL, status); + + if (slen == 0 || *status) + { + ffpmsg("error: column or keyword name is blank (ffedit_columns):"); + ffpmsg(clause); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + if (clause) free(clause); + if (*status==0) + *status=URL_PARSE_ERROR; + return(*status); + } + if (strlen(tstbuff) > FLEN_VALUE-1) + { + ffpmsg("error: column or keyword name is too long (ffedit_columns):"); + ffpmsg(clause); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + if (clause) free(clause); + free(tstbuff); + return(*status= URL_PARSE_ERROR); + } + strcpy(colname, tstbuff); + free(tstbuff); + tstbuff=0; + + /* 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"); + if( file_expr ) free( file_expr ); + if (clause) free(clause); + 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) { + if( file_expr ) free( file_expr ); + if (clause) free(clause); + 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 == '(') + { + if (fits_get_token2(&cptr2, ")", &tstbuff, NULL, status)==0) + { + strcat(colname,")"); + } + else + { + if ((strlen(tstbuff) + strlen(colname) + 1) > + FLEN_VALUE-1) + { + ffpmsg("error: column name is too long (ffedit_columns):"); + if( file_expr ) free( file_expr ); + if (clause) free(clause); + free(tstbuff); + *status=URL_PARSE_ERROR; + return (*status); + } + strcat(colname, tstbuff); + strcat(colname, ")"); + free(tstbuff); + tstbuff=0; + } + 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 ); + if (clause) free(clause); + 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 */ + + if (fits_get_token2(&cptr2, " ", &tstbuff, NULL, status)==0) + { + oldname[0]=0; + } + else + { + if (strlen(tstbuff) > FLEN_VALUE-1) + { + ffpmsg("error: column name syntax is too long (ffedit_columns):"); + if( file_expr ) free( file_expr ); + if (clause) free(clause); + free(tstbuff); + *status=URL_PARSE_ERROR; + return (*status); + } + strcpy(oldname, tstbuff); + free(tstbuff); + tstbuff=0; + } + /* 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 ); + if (clause) free(clause); + 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 ); + if (clause) free(clause); + 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; + + if (fits_get_token2(&cptr3, "(", &tstbuff, NULL, status)==0) + { + oldname[0]=0; + } + else + { + if (strlen(tstbuff) > FLEN_VALUE-1) + { + ffpmsg("column expression is too long (ffedit_columns)"); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + if (clause) free(clause); + free(tstbuff); + *status=URL_PARSE_ERROR; + return(*status); + } + strcpy(oldname, tstbuff); + free(tstbuff); + tstbuff=0; + } + if (cptr3[0] == '(' ) + { + cptr3++; /* skip the '(' */ + if (fits_get_token2(&cptr3, ")", &tstbuff, NULL, status)==0) + { + colformat[0]=0; + } + else + { + if (strlen(tstbuff) > FLEN_VALUE-1) + { + ffpmsg("column expression is too long (ffedit_columns)"); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + if (clause) free(clause); + free(tstbuff); + *status=URL_PARSE_ERROR; + return(*status); + } + strcpy(colformat, tstbuff); + free(tstbuff); + tstbuff=0; + } + } + + /* 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"); + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + if (clause) free(clause); + 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 (clause) free(clause); /* free old clause before getting new one */ + clause = NULL; + } + + 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 ); + if (clause) free(clause); + return(*status); + } + } + } + } + + if( colindex ) free( colindex ); + if( file_expr ) free( file_expr ); + if (clause) free(clause); + + 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 */ + snprintf(card,FLEN_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; + snprintf(tform, 20, "%.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 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; + + snprintf(card, FLEN_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); + snprintf(filename+strlen(filename),FLEN_FILENAME+20-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], *tstbuff=0; + + if (*status > 0) + return(*status); + + slen = fits_get_token2(ptr, " ,:", &tstbuff, &isanumber, status); /* get 1st token */ + if (slen==0) + { + /* support [:2,:2] type syntax, where the leading * is implied */ + strcpy(token,"*"); + } + else + { + if (strlen(tstbuff) > FLEN_VALUE-1) + { + ffpmsg("Error: image section string too long (fits_get_section_range)"); + free(tstbuff); + *status = URL_PARSE_ERROR; + return(*status); + } + strcpy(token, tstbuff); + free(tstbuff); + tstbuff=0; + } + + 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_token2(ptr, " ,:", &tstbuff, &isanumber, status); /* get token */ + if (slen == 0 || !isanumber) + { + if (tstbuff) + free(tstbuff); + return(*status = URL_PARSE_ERROR); + } + if (strlen(tstbuff) > FLEN_VALUE-1) + { + ffpmsg("Error: image section string too long (fits_get_section_range)"); + free(tstbuff); + *status = URL_PARSE_ERROR; + return(*status); + } + strcpy(token, tstbuff); + free(tstbuff); + tstbuff=0; + + /* the token contains the max value */ + *secmax = atol(token); + } + + if (**ptr == ':') + { + (*ptr)++; /* skip the colon between the max and incre values */ + slen = fits_get_token2(ptr, " ,", &tstbuff, &isanumber, status); /* get token */ + if (slen == 0 || !isanumber) + { + if (tstbuff) + free(tstbuff); + return(*status = URL_PARSE_ERROR); + } + if (strlen(tstbuff) > FLEN_VALUE-1) + { + ffpmsg("Error: image section string too long (fits_get_section_range)"); + free(tstbuff); + *status = URL_PARSE_ERROR; + return(*status); + } + strcpy(token, tstbuff); + free(tstbuff); + tstbuff=0; + + + *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; + int quantize_method = SUBTRACTIVE_DITHER_1; + long tilesize[MAX_COMPRESS_DIM] = {0,0,0,0,0,0}; + float qlevel = -99., 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++; + if (*ptr1 == 'z' || *ptr1 == 'Z') { + /* use the subtractive_dither_2 option */ + quantize_method = SUBTRACTIVE_DITHER_2; + ptr1++; + } else if (*ptr1 == '0') { + /* do not dither */ + quantize_method = NO_DITHER; + 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 != -99.) { + fits_set_quantize_level(fptr, qlevel, status); + fits_set_quantize_method(fptr, quantize_method, 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. +*/ +{ + *fptr = 0; /* initialize null file pointer, */ + /* regardless of the value of *status */ + 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; + + *fptr = 0; /* initialize null file pointer, */ + /* regardless of the value of *status */ + if (*status > 0) + return(*status); + + if (*status == CREATE_DISK_FILE) + { + create_disk_file = 1; + *status = 0; + } + + 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 */ + ((*fptr)->Fptr)->noextsyntax = create_disk_file; /* true if extended syntax is disabled */ + + 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 */ + ((*fptr)->Fptr)->noextsyntax = 0; /* extended syntax can be used in filename */ + + 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); + } + +#ifdef HAVE_NET_SERVICES + + /* 25--------------------https driver-----------------------*/ + status = fits_register_driver("https://", + NULL, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + https_checkfile, + https_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 https:// driver (init_cfitsio)"); + FFUNLOCK; + return(status); + } + + /* 26--------------------https file driver-----------------------*/ + + status = fits_register_driver("httpsfile://", + NULL, + file_shutdown, + file_setoptions, + file_getoptions, + file_getversion, + NULL, /* checkfile not needed */ + https_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 httpsfile:// driver (init_cfitsio)"); + FFUNLOCK; + return(status); + } + + /* 27--------------------https memory driver-----------------------*/ + /* same as https:// driver, except memory file can be opened READWRITE */ + status = fits_register_driver("httpsmem://", + NULL, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + https_checkfile, + https_file_open, /* this will simply call https_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 httpsmem:// driver (init_cfitsio)"); + FFUNLOCK; + return(status); + } + /* === End of https net drivers section === */ + + /* 28--------------------ftps driver-----------------------*/ + status = fits_register_driver("ftps://", + NULL, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + ftps_checkfile, + ftps_open, + NULL, + mem_truncate, + mem_close_free, + NULL, + mem_size, + NULL, + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the ftps:// driver (init_cfitsio)"); + FFUNLOCK; + return(status); + } + + /* 29--------------------ftps file driver-----------------------*/ + + status = fits_register_driver("ftpsfile://", + NULL, + file_shutdown, + file_setoptions, + file_getoptions, + file_getversion, + NULL, + ftps_file_open, + file_create, +#ifdef HAVE_FTRUNCATE + file_truncate, +#else + NULL, +#endif + file_close, + file_remove, + file_size, + file_flush, + file_seek, + file_read, + file_write); + + if (status) + { + ffpmsg("failed to register the ftpsfile:// driver (init_cfitsio)"); + FFUNLOCK; + return(status); + } + + /* 30--------------------ftps memory driver-----------------------*/ + /* same as ftps:// driver, except memory file can be opened READWRITE */ + status = fits_register_driver("ftpsmem://", + NULL, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + ftps_checkfile, + ftps_file_open, + NULL, + mem_truncate, + mem_close_free, + NULL, + mem_size, + NULL, + mem_seek, + mem_read, + mem_write); + + if (status) + { + ffpmsg("failed to register the ftpsmem:// driver (init_cfitsio)"); + FFUNLOCK; + return(status); + } + + /* 31--------------------ftps compressed file driver------------------*/ + status = fits_register_driver("ftpscompress://", + NULL, + mem_shutdown, + mem_setoptions, + mem_getoptions, + mem_getversion, + NULL, /* checkfile not needed */ + ftps_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 ftpscompress:// driver (init_cfitsio)"); + FFUNLOCK; + return(status); + } +#endif + + + /* 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 *sizex), + 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 does not support the pixfilter or compspec components. +*/ +{ + return ffifile2(url, urltype, infilex, outfile, + extspec, rowfilterx, binspec, colspec, 0, 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 does not support the compspec component. +*/ +{ + return ffifile2(url, urltype, infilex, outfile, + extspec, rowfilterx, binspec, colspec, pixfilter, 0, status); + +} +/*--------------------------------------------------------------------------*/ +int ffifile2(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 */ + char *compspec, /* image compression specification */ + 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, compStart; + + /* 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'; + if (compspec) *compspec = '\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 (!fits_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 (ptr2-ptr1+3 >= MAX_PREFIX_LEN) + { + ffpmsg("Name of urltype is too long."); + return(*status = URL_PARSE_ERROR); + } + 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) + { + ptr4 = strchr(ptr2, ')'); /* search for closing parenthesis ) */ + while (ptr4 && ptr2) + { + do { + ++ptr4; + } while (*ptr4 == ' '); /* find next non-blank char after ')' */ + if (*ptr4 == 0 || *ptr4 == '[') + break; + ptr2 = strchr(ptr2+1, '('); + ptr4 = strchr(ptr4, ')'); + } + } + + 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 a image compression 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")] + + [compress Rice] + + 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; + compStart = 0; + + if (*tmptr == '@') /* test for leading @ symbol */ + hasAt = 1; + + if ( !fits_strncasecmp(tmptr, "col ", 4) ) + colStart = 1; + + if ( !fits_strncasecmp(tmptr, "bin", 3) ) + binStart = 1; + + if ( !fits_strncasecmp(tmptr, "pix", 3) ) + pixStart = 1; + + if ( !fits_strncasecmp(tmptr, "compress ", 9) || + !fits_strncasecmp(tmptr, "compress]", 9) ) + compStart = 1; + + if ( !fits_strncasecmp(tmptr, "gtifilter(", 10) || + !fits_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 || + compStart || + (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 = fits_find_match_delim(binspec, ']'); + + if (ptr2) /* terminate the binning filter */ + { + --ptr2; /* points beyond delimeter, so rewind by 1 */ + *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 = fits_find_match_delim(ptr1+1, ']'); + if (ptr2) { + strcpy(tmpstr, ptr2); /* copy any chars after the binspec */ + strcpy(ptr1, tmpstr); /* overwrite binspec */ + } else { + ffpmsg("input file URL is missing closing bracket ']'"); + ffpmsg(rowfilter); + free(infile); + return(*status = URL_PARSE_ERROR); /* error, no closing ] */ + } + } + + /* --------------------------------------------------------- */ + /* does the filter contain a column selection specification? */ + /* --------------------------------------------------------- */ + + ptr1 = strstr(rowfilter, "[col "); + if (!ptr1) + { + ptr1 = strstr(rowfilter, "[COL "); + + if (!ptr1) + ptr1 = strstr(rowfilter, "[Col "); + } + + hasAt = 0; + while (ptr1) { + + /* find the end of the column specifier */ + ptr2 = ptr1 + 5; + /* Scan past any whitespace and check for @filename */ + while (*ptr2 == ' ') ptr2++; + if (*ptr2 == '@') hasAt = 1; + + 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 + strlen(colspec) > FLEN_FILENAME - 1) { + free(infile); + return(*status = URL_PARSE_ERROR); + } + + if (*colspec == 0) { + strncpy(colspec, ptr1 + 1, collen); + colspec[collen] = '\0'; + } else { /* Pre-existing colspec, append with ";" */ + strcat(colspec, ";"); + strncat(colspec, ptr1 + 5, collen-4); + /* Note that strncat always null-terminates the destination string */ + + /* Special error checking here. We can't allow there to be a + col @filename.txt includes if there are multiple col expressions */ + if (hasAt) { + ffpmsg("input URL multiple column filter cannot use @filename.txt"); + free(infile); + return(*status = URL_PARSE_ERROR); + } + + } + + collen = strlen(colspec); + 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 */ + + /* Check for additional column specifiers */ + ptr1 = strstr(rowfilter, "[col "); + if (!ptr1) ptr1 = strstr(rowfilter, "[COL "); + if (!ptr1) ptr1 = strstr(rowfilter, "[Col "); + } + + /* --------------------------------------------------------- */ + /* 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 */ + } + + /* ------------------------------------------------------------ */ + /* does the filter contain an image compression specification? */ + /* ------------------------------------------------------------ */ + + ptr1 = strstr(rowfilter, "[compress"); + + if (ptr1) + { + ptr2 = ptr1 + 9; /* end of the '[compress' string */ + + if ( *ptr2 != ' ' && *ptr2 != ']') + ptr1 = NULL; /* compress string must be followed by space or ] */ + } + + if (ptr1) + { + /* found the compress string */ + if (compspec) + { + if (strlen(ptr1 +1) > FLEN_FILENAME - 1) + { + free(infile); + return(*status = URL_PARSE_ERROR); + } + + strcpy(compspec, ptr1 + 1); + ptr2 = strchr(compspec, ']'); + + 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 compression spec from the row filter string */ + ptr2 = strchr(ptr1, ']'); + strcpy(tmpstr, ptr2+1); /* copy any chars after the binspec */ + 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]) { + hasAt = 0; + + /* Check for multiple expressions, which would appear as "[expr][expr]..." */ + ptr1 = rowfilter; + while((*ptr1 == '[') && (ptr2 = strstr(rowfilter,"]["))-ptr1 > 2) { + /* Advance past any white space */ + ptr3 = ptr1+1; + while (*ptr3 == ' ') ptr3++; + /* Check for @filename.txt */ + if (*ptr3 == '@') hasAt = 1; + + /* Add expression of the form "((expr))&&", note the addition of 6 characters */ + if ((strlen(rowfilterx) + (ptr2-ptr1) + 6) > FLEN_FILENAME - 1) { + free(infile); + return (*status = URL_PARSE_ERROR); + } + + /* Special error checking here. We can't allow there to be a + @filename.txt includes if there are multiple row expressions */ + if (*rowfilterx && hasAt) { + ffpmsg("input URL multiple row filter cannot use @filename.txt"); + free(infile); + return(*status = URL_PARSE_ERROR); + } + + /* Append the expression */ + strcat(rowfilterx, "(("); + strncat(rowfilterx, ptr1+1, (ptr2-ptr1-1)); + /* Note that strncat always null-terminates the destination string */ + strcat(rowfilterx, "))&&"); + + /* Advance to next expression */ + ptr1 = ptr2 + 1; + } + + /* At final iteration, ptr1 points to beginning [ and ptr2 to ending ] */ + ptr2 = rowfilter + strlen(rowfilter) - 1; + if( *ptr1=='[' && *ptr2==']' ) { + /* Check for @include in final position */ + ptr3 = ptr1 + 1; + while (*ptr3 == ' ') ptr3++; + if (*ptr3 == '@') hasAt = 1; + + /* Check for overflow; add extra 4 characters if we have pre-existing expression */ + if (strlen(rowfilterx) + (ptr2-ptr1 + (*rowfilterx)?4:0) > FLEN_FILENAME - 1) { + free(infile); + return(*status = URL_PARSE_ERROR); + } + + /* Special error checking here. We can't allow there to be a + @filename.txt includes if there are multiple row expressions */ + if (*rowfilterx && hasAt) { + ffpmsg("input URL multiple row filter cannot use @filename.txt"); + free(infile); + return(*status = URL_PARSE_ERROR); + } + + if (*rowfilterx) { + /* A pre-existing row filter: we bracket by ((expr)) to be sure */ + strcat(rowfilterx, "(("); + strncat(rowfilterx, ptr1+1, (ptr2-ptr1-1)); + strcat(rowfilterx, "))"); + + } else { + /* We have only one filter, so just copy the expression alone. + This will be the most typical case */ + strncat(rowfilterx, ptr1+1, (ptr2-ptr1-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, *ptr4; + 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) + { + ptr4 = strchr(ptr2, ')'); + while (ptr4 && ptr2) + { + do { + ++ptr4; + } while (*ptr4 == ' '); + if (*ptr4 == 0 || *ptr4 == '[') + break; + ptr2 = strchr(ptr2+1, '('); + ptr4 = strchr(ptr4, ')'); + } + } + + 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 (!ptr1) + { + 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 = 1; + 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 ) { + snprintf(line,256,"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 ( eoline && (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')) { + strncpy(tval, token, 72); + tval[72] = '\0'; + + /* 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); +} +/*--------------------------------------------------------------------------*/ +int fits_get_token2(char **ptr, + char *delimiter, + char **token, + int *isanumber, /* O - is this token a number? */ + int *status) + +/* + 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; + + This routine allocates the *token string; the calling routine must free it +*/ +{ + char *loc, tval[73]; + int slen; + double dval; + + if (*status) + return(0); + + while (**ptr == ' ') /* skip over leading blanks */ + (*ptr)++; + + slen = strcspn(*ptr, delimiter); /* length of next token */ + if (slen) + { + *token = (char *) calloc(slen + 1, 1); + if (!(*token)) { + ffpmsg("Couldn't allocate memory to hold token string (fits_get_token2)."); + *status = MEMORY_ALLOCATION ; + return(0); + } + + 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')) { + strncpy(tval, *token, 72); + tval[72] = '\0'; + + /* 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 = 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); + + if (*status > 0) + ffchdu(fptr, &tstatus); /* turn off the error message from ffchdu */ + else + ffchdu(fptr, status); + + 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, &zerostatus); + + 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. +*/ +{ + *fptr = 0; /* initialize null file pointer, */ + /* regardless of the value of *status */ + 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); +} + +/*-------------------------------------------------------------------*/ +int ffihtps(void) +{ + /* Wrapper function for global initialization of curl library. + This is NOT THREAD-SAFE */ + int status=0; +#ifdef CFITSIO_HAVE_CURL + if (curl_global_init(CURL_GLOBAL_ALL)) + /* Do we want to define a new CFITSIO error code for this? */ + status = -1; +#endif + return status; +} + +/*-------------------------------------------------------------------*/ +int ffchtps(void) +{ + /* Wrapper function for global cleanup of curl library. + This is NOT THREAD-SAFE */ +#ifdef CFITSIO_HAVE_CURL + curl_global_cleanup(); +#endif + return 0; +} + +/*-------------------------------------------------------------------*/ +void ffvhtps(int flag) +{ + /* Turn libcurl's verbose output on (1) or off (0). + This is NOT THREAD-SAFE */ +#ifdef HAVE_NET_SERVICES + + https_set_verbose(flag); +#endif +} + +/*-------------------------------------------------------------------*/ +void ffshdwn(int flag) +{ + /* Display download status bar (to stderr), where applicable. + This is NOT THREAD-SAFE */ +#ifdef HAVE_NET_SERVICES + fits_dwnld_prog_bar(flag); +#endif +} + +/*-------------------------------------------------------------------*/ +int ffgtmo(void) +{ + int timeout=0; +#ifdef HAVE_NET_SERVICES + timeout = fits_net_timeout(-1); +#endif + return timeout; +} + +/*-------------------------------------------------------------------*/ +int ffstmo(int sec, int *status) +{ + if (*status > 0) + return (*status); + +#ifdef HAVE_NET_SERVICES + if (sec <= 0) + { + *status = BAD_NETTIMEOUT; + ffpmsg("Bad value for net timeout setting (fits_set_timeout)."); + return(*status); + } + fits_net_timeout(sec); +#endif + return(*status); +} diff --git a/vendor/cfitsio/cfitsio.pc.in b/vendor/cfitsio/cfitsio.pc.in new file mode 100644 index 000000000..b5daf5f8c --- /dev/null +++ b/vendor/cfitsio/cfitsio.pc.in @@ -0,0 +1,12 @@ +prefix=@prefix@ +exec_prefix=@exec_prefix@ +libdir=@libdir@ +includedir=@includedir@ + +Name: cfitsio +Description: FITS File Subroutine Library +URL: https://heasarc.gsfc.nasa.gov/fitsio/ +Version: @CFITSIO_MAJOR@.@CFITSIO_MINOR@.@CFITSIO_MICRO@ +Libs: -L${libdir} -lcfitsio +Libs.private: @LIBS_CURL@ @LIBS@ -lm +Cflags: -I${includedir} diff --git a/vendor/cfitsio/checksum.c b/vendor/cfitsio/checksum.c new file mode 100644 index 000000000..4bc467f4b --- /dev/null +++ b/vendor/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 +#include +#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 */ + snprintf(datasum, FLEN_VALUE, "%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/vendor/cfitsio/config.guess b/vendor/cfitsio/config.guess new file mode 100755 index 000000000..1972fda8e --- /dev/null +++ b/vendor/cfitsio/config.guess @@ -0,0 +1,1700 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright 1992-2021 Free Software Foundation, Inc. + +timestamp='2021-01-25' + +# This file 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 3 of the License, 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, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. +# +# You can get the latest version of this script from: +# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess +# +# Please send patches to . + + +me=$(echo "$0" | sed -e 's,.*/,,') + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Options: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright 1992-2021 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +tmp= +# shellcheck disable=SC2172 +trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 + +set_cc_for_build() { + # prevent multiple calls if $tmp is already set + test "$tmp" && return 0 + : "${TMPDIR=/tmp}" + # shellcheck disable=SC2039 + { tmp=$( (umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null) && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } + dummy=$tmp/dummy + case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in + ,,) echo "int x;" > "$dummy.c" + for driver in cc gcc c89 c99 ; do + if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then + CC_FOR_BUILD="$driver" + break + fi + done + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; + esac +} + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if test -f /.attbin/uname ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=$( (uname -m) 2>/dev/null) || UNAME_MACHINE=unknown +UNAME_RELEASE=$( (uname -r) 2>/dev/null) || UNAME_RELEASE=unknown +UNAME_SYSTEM=$( (uname -s) 2>/dev/null) || UNAME_SYSTEM=unknown +UNAME_VERSION=$( (uname -v) 2>/dev/null) || UNAME_VERSION=unknown + +case "$UNAME_SYSTEM" in +Linux|GNU|GNU/*) + LIBC=unknown + + set_cc_for_build + cat <<-EOF > "$dummy.c" + #include + #if defined(__UCLIBC__) + LIBC=uclibc + #elif defined(__dietlibc__) + LIBC=dietlibc + #elif defined(__GLIBC__) + LIBC=gnu + #else + #include + /* First heuristic to detect musl libc. */ + #ifdef __DEFINED_va_list + LIBC=musl + #endif + #endif + EOF + eval "$($CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g')" + + # Second heuristic to detect musl libc. + if [ "$LIBC" = unknown ] && + command -v ldd >/dev/null && + ldd --version 2>&1 | grep -q ^musl; then + LIBC=musl + fi + + # If the system lacks a compiler, then just pick glibc. + # We could probably try harder. + if [ "$LIBC" = unknown ]; then + LIBC=gnu + fi + ;; +esac + +# Note: order is significant - the case branches are not exclusive. + +case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + UNAME_MACHINE_ARCH=$( (uname -p 2>/dev/null || \ + /sbin/sysctl -n hw.machine_arch 2>/dev/null || \ + /usr/sbin/sysctl -n hw.machine_arch 2>/dev/null || \ + echo unknown)) + case "$UNAME_MACHINE_ARCH" in + aarch64eb) machine=aarch64_be-unknown ;; + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; + earmv*) + arch=$(echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,') + endian=$(echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p') + machine="${arch}${endian}"-unknown + ;; + *) machine="$UNAME_MACHINE_ARCH"-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently (or will in the future) and ABI. + case "$UNAME_MACHINE_ARCH" in + earm*) + os=netbsdelf + ;; + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ELF__ + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # Determine ABI tags. + case "$UNAME_MACHINE_ARCH" in + earm*) + expr='s/^earmv[0-9]/-eabi/;s/eb$//' + abi=$(echo "$UNAME_MACHINE_ARCH" | sed -e "$expr") + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case "$UNAME_VERSION" in + Debian*) + release='-gnu' + ;; + *) + release=$(echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2) + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "$machine-${os}${release}${abi-}" + exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=$(arch | sed 's/Bitrig.//') + echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE" + exit ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=$(arch | sed 's/OpenBSD.//') + echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE" + exit ;; + *:LibertyBSD:*:*) + UNAME_MACHINE_ARCH=$(arch | sed 's/^.*BSD\.//') + echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE" + exit ;; + *:MidnightBSD:*:*) + echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE" + exit ;; + *:ekkoBSD:*:*) + echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE" + exit ;; + *:SolidBSD:*:*) + echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE" + exit ;; + *:OS108:*:*) + echo "$UNAME_MACHINE"-unknown-os108_"$UNAME_RELEASE" + exit ;; + macppc:MirBSD:*:*) + echo powerpc-unknown-mirbsd"$UNAME_RELEASE" + exit ;; + *:MirBSD:*:*) + echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE" + exit ;; + *:Sortix:*:*) + echo "$UNAME_MACHINE"-unknown-sortix + exit ;; + *:Twizzler:*:*) + echo "$UNAME_MACHINE"-unknown-twizzler + exit ;; + *:Redox:*:*) + echo "$UNAME_MACHINE"-unknown-redox + exit ;; + mips:OSF1:*.*) + echo mips-dec-osf1 + exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) + UNAME_RELEASE=$(/usr/sbin/sizer -v | awk '{print $3}') + ;; + *5.*) + UNAME_RELEASE=$(/usr/sbin/sizer -v | awk '{print $4}') + ;; + esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=$(/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1) + case "$ALPHA_CPU_TYPE" in + "EV4 (21064)") + UNAME_MACHINE=alpha ;; + "EV4.5 (21064)") + UNAME_MACHINE=alpha ;; + "LCA4 (21066/21068)") + UNAME_MACHINE=alpha ;; + "EV5 (21164)") + UNAME_MACHINE=alphaev5 ;; + "EV5.6 (21164A)") + UNAME_MACHINE=alphaev56 ;; + "EV5.6 (21164PC)") + UNAME_MACHINE=alphapca56 ;; + "EV5.7 (21164PC)") + UNAME_MACHINE=alphapca57 ;; + "EV6 (21264)") + UNAME_MACHINE=alphaev6 ;; + "EV6.7 (21264A)") + UNAME_MACHINE=alphaev67 ;; + "EV6.8CB (21264C)") + UNAME_MACHINE=alphaev68 ;; + "EV6.8AL (21264B)") + UNAME_MACHINE=alphaev68 ;; + "EV6.8CX (21264D)") + UNAME_MACHINE=alphaev68 ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE=alphaev69 ;; + "EV7 (21364)") + UNAME_MACHINE=alphaev7 ;; + "EV7.9 (21364A)") + UNAME_MACHINE=alphaev79 ;; + esac + # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo "$UNAME_MACHINE"-dec-osf"$(echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz)" + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 + exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo "$UNAME_MACHINE"-unknown-amigaos + exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo "$UNAME_MACHINE"-unknown-morphos + exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe + exit ;; + *:OS400:*:*) + echo powerpc-ibm-os400 + exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix"$UNAME_RELEASE" + exit ;; + arm*:riscos:*:*|arm*:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp + exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "$( (/bin/universe) 2>/dev/null)" = att ; then + echo pyramid-pyramid-sysv3 + else + echo pyramid-pyramid-bsd + fi + exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 + exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 + exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case $(/usr/bin/uname -p) in + sparc) echo sparc-icl-nx7; exit ;; + esac ;; + s390x:SunOS:*:*) + echo "$UNAME_MACHINE"-ibm-solaris2"$(echo "$UNAME_RELEASE" | sed -e 's/[^.]*//')" + exit ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')" + exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2"$(echo "$UNAME_RELEASE" | sed -e 's/[^.]*//')" + exit ;; + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux"$UNAME_RELEASE" + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + set_cc_for_build + SUN_ARCH=i386 + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH=x86_64 + fi + fi + echo "$SUN_ARCH"-pc-solaris2"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')" + exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')" + exit ;; + sun4*:SunOS:*:*) + case "$(/usr/bin/arch -k)" in + Series*|S4*) + UNAME_RELEASE=$(uname -v) + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos"$(echo "$UNAME_RELEASE"|sed -e 's/-/_/')" + exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos"$UNAME_RELEASE" + exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=$( (sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null) + test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 + case "$(/bin/arch)" in + sun3) + echo m68k-sun-sunos"$UNAME_RELEASE" + ;; + sun4) + echo sparc-sun-sunos"$UNAME_RELEASE" + ;; + esac + exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos"$UNAME_RELEASE" + exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint"$UNAME_RELEASE" + exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint"$UNAME_RELEASE" + exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint"$UNAME_RELEASE" + exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint"$UNAME_RELEASE" + exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint"$UNAME_RELEASE" + exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint"$UNAME_RELEASE" + exit ;; + m68k:machten:*:*) + echo m68k-apple-machten"$UNAME_RELEASE" + exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten"$UNAME_RELEASE" + exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 + exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix"$UNAME_RELEASE" + exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix"$UNAME_RELEASE" + exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix"$UNAME_RELEASE" + exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" +#ifdef __cplusplus +#include /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o "$dummy" "$dummy.c" && + dummyarg=$(echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p') && + SYSTEM_NAME=$("$dummy" "$dummyarg") && + { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos"$UNAME_RELEASE" + exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax + exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix + exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 + exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 + exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 + exit ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=$(/usr/bin/uname -p) + if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110 + then + if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \ + test "$TARGET_BINARY_INTERFACE"x = x + then + echo m88k-dg-dgux"$UNAME_RELEASE" + else + echo m88k-dg-dguxbcs"$UNAME_RELEASE" + fi + else + echo i586-dg-dgux"$UNAME_RELEASE" + fi + exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 + exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 + exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 + exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd + exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix"$(echo "$UNAME_RELEASE"|sed -e 's/-/_/g')" + exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit ;; # Note that: echo "'$(uname -s)'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix + exit ;; + ia64:AIX:*:*) + if test -x /usr/bin/oslevel ; then + IBM_REV=$(/usr/bin/oslevel) + else + IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + fi + echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV" + exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + #include + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=$("$dummy") + then + echo "$SYSTEM_NAME" + else + echo rs6000-ibm-aix3.2.5 + fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi + exit ;; + *:AIX:*:[4567]) + IBM_CPU_ID=$(/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }') + if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if test -x /usr/bin/lslpp ; then + IBM_REV=$(/usr/bin/lslpp -Lqc bos.rte.libc | + awk -F: '{ print $3 }' | sed s/[0-9]*$/0/) + else + IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + fi + echo "$IBM_ARCH"-ibm-aix"$IBM_REV" + exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix + exit ;; + ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) + echo romp-ibm-bsd4.4 + exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd"$UNAME_RELEASE" # 4.3 with uname added to + exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx + exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd + exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 + exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//') + case "$UNAME_MACHINE" in + 9000/31?) HP_ARCH=m68000 ;; + 9000/[34]??) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if test -x /usr/bin/getconf; then + sc_cpu_version=$(/usr/bin/getconf SC_CPU_VERSION 2>/dev/null) + sc_kernel_bits=$(/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null) + case "$sc_cpu_version" in + 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0 + 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "$sc_kernel_bits" in + 32) HP_ARCH=hppa2.0n ;; + 64) HP_ARCH=hppa2.0w ;; + '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20 + esac ;; + esac + fi + if test "$HP_ARCH" = ""; then + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + + #define _HPUX_SOURCE + #include + #include + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=$("$dummy") + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if test "$HP_ARCH" = hppa2.0w + then + set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | + grep -q __LP64__ + then + HP_ARCH=hppa2.0w + else + HP_ARCH=hppa64 + fi + fi + echo "$HP_ARCH"-hp-hpux"$HPUX_REV" + exit ;; + ia64:HP-UX:*:*) + HPUX_REV=$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//') + echo ia64-hp-hpux"$HPUX_REV" + exit ;; + 3050*:HI-UX:*:*) + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + #include + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=$("$dummy") && + { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 + exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) + echo hppa1.1-hp-bsd + exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) + echo hppa1.1-hp-osf + exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf + exit ;; + i*86:OSF1:*:*) + if test -x /usr/sbin/sysversion ; then + echo "$UNAME_MACHINE"-unknown-osf1mk + else + echo "$UNAME_MACHINE"-unknown-osf1 + fi + exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites + exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd + exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd + exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd + exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd + exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*[A-Z]90:*:*:*) + echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + *:UNICOS/mp:*:*) + echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=$(uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz) + FUJITSU_SYS=$(uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///') + FUJITSU_REL=$(echo "$UNAME_RELEASE" | sed -e 's/ /_/') + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=$(uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///') + FUJITSU_REL=$(echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/') + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE" + exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi"$UNAME_RELEASE" + exit ;; + *:BSD/OS:*:*) + echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" + exit ;; + arm:FreeBSD:*:*) + UNAME_PROCESSOR=$(uname -p) + set_cc_for_build + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo "${UNAME_PROCESSOR}"-unknown-freebsd"$(echo ${UNAME_RELEASE}|sed -e 's/[-(].*//')"-gnueabi + else + echo "${UNAME_PROCESSOR}"-unknown-freebsd"$(echo ${UNAME_RELEASE}|sed -e 's/[-(].*//')"-gnueabihf + fi + exit ;; + *:FreeBSD:*:*) + UNAME_PROCESSOR=$(/usr/bin/uname -p) + case "$UNAME_PROCESSOR" in + amd64) + UNAME_PROCESSOR=x86_64 ;; + i386) + UNAME_PROCESSOR=i586 ;; + esac + echo "$UNAME_PROCESSOR"-unknown-freebsd"$(echo "$UNAME_RELEASE"|sed -e 's/[-(].*//')" + exit ;; + i*:CYGWIN*:*) + echo "$UNAME_MACHINE"-pc-cygwin + exit ;; + *:MINGW64*:*) + echo "$UNAME_MACHINE"-pc-mingw64 + exit ;; + *:MINGW*:*) + echo "$UNAME_MACHINE"-pc-mingw32 + exit ;; + *:MSYS*:*) + echo "$UNAME_MACHINE"-pc-msys + exit ;; + i*:PW*:*) + echo "$UNAME_MACHINE"-pc-pw32 + exit ;; + *:Interix*:*) + case "$UNAME_MACHINE" in + x86) + echo i586-pc-interix"$UNAME_RELEASE" + exit ;; + authenticamd | genuineintel | EM64T) + echo x86_64-unknown-interix"$UNAME_RELEASE" + exit ;; + IA64) + echo ia64-unknown-interix"$UNAME_RELEASE" + exit ;; + esac ;; + i*:UWIN*:*) + echo "$UNAME_MACHINE"-pc-uwin + exit ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-pc-cygwin + exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')" + exit ;; + *:GNU:*:*) + # the GNU system + echo "$(echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,')-unknown-$LIBC$(echo "$UNAME_RELEASE"|sed -e 's,/.*$,,')" + exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo "$UNAME_MACHINE-unknown-$(echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]")$(echo "$UNAME_RELEASE"|sed -e 's/[-(].*//')-$LIBC" + exit ;; + *:Minix:*:*) + echo "$UNAME_MACHINE"-unknown-minix + exit ;; + aarch64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + alpha:Linux:*:*) + case $(sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null) in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC=gnulibc1 ; fi + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + arc:Linux:*:* | arceb:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + arm*:Linux:*:*) + set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi + else + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf + fi + fi + exit ;; + avr32*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + cris:Linux:*:*) + echo "$UNAME_MACHINE"-axis-linux-"$LIBC" + exit ;; + crisv32:Linux:*:*) + echo "$UNAME_MACHINE"-axis-linux-"$LIBC" + exit ;; + e2k:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + frv:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + hexagon:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + i*86:Linux:*:*) + echo "$UNAME_MACHINE"-pc-linux-"$LIBC" + exit ;; + ia64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + k1om:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + m32r*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + m68*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + mips:Linux:*:* | mips64:Linux:*:*) + set_cc_for_build + IS_GLIBC=0 + test x"${LIBC}" = xgnu && IS_GLIBC=1 + sed 's/^ //' << EOF > "$dummy.c" + #undef CPU + #undef mips + #undef mipsel + #undef mips64 + #undef mips64el + #if ${IS_GLIBC} && defined(_ABI64) + LIBCABI=gnuabi64 + #else + #if ${IS_GLIBC} && defined(_ABIN32) + LIBCABI=gnuabin32 + #else + LIBCABI=${LIBC} + #endif + #endif + + #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa64r6 + #else + #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa32r6 + #else + #if defined(__mips64) + CPU=mips64 + #else + CPU=mips + #endif + #endif + #endif + + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + MIPS_ENDIAN=el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + MIPS_ENDIAN= + #else + MIPS_ENDIAN= + #endif + #endif +EOF + eval "$($CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI')" + test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; } + ;; + mips64el:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + openrisc*:Linux:*:*) + echo or1k-unknown-linux-"$LIBC" + exit ;; + or32:Linux:*:* | or1k*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + padre:Linux:*:*) + echo sparc-unknown-linux-"$LIBC" + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-"$LIBC" + exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case $(grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2) in + PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;; + PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;; + *) echo hppa-unknown-linux-"$LIBC" ;; + esac + exit ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-"$LIBC" + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-"$LIBC" + exit ;; + ppc64le:Linux:*:*) + echo powerpc64le-unknown-linux-"$LIBC" + exit ;; + ppcle:Linux:*:*) + echo powerpcle-unknown-linux-"$LIBC" + exit ;; + riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo "$UNAME_MACHINE"-ibm-linux-"$LIBC" + exit ;; + sh64*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + sh*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + tile*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + vax:Linux:*:*) + echo "$UNAME_MACHINE"-dec-linux-"$LIBC" + exit ;; + x86_64:Linux:*:*) + set_cc_for_build + LIBCABI=$LIBC + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __ILP32__'; echo IS_X32; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_X32 >/dev/null + then + LIBCABI="$LIBC"x32 + fi + fi + echo "$UNAME_MACHINE"-pc-linux-"$LIBCABI" + exit ;; + xtensa*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 + exit ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION" + exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo "$UNAME_MACHINE"-pc-os2-emx + exit ;; + i*86:XTS-300:*:STOP) + echo "$UNAME_MACHINE"-unknown-stop + exit ;; + i*86:atheos:*:*) + echo "$UNAME_MACHINE"-unknown-atheos + exit ;; + i*86:syllable:*:*) + echo "$UNAME_MACHINE"-pc-syllable + exit ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) + echo i386-unknown-lynxos"$UNAME_RELEASE" + exit ;; + i*86:*DOS:*:*) + echo "$UNAME_MACHINE"-pc-msdosdjgpp + exit ;; + i*86:*:4.*:*) + UNAME_REL=$(echo "$UNAME_RELEASE" | sed 's/\/MP$//') + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL" + else + echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL" + fi + exit ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. + case $(/bin/uname -X | grep "^Machine") in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}" + exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=$(sed -n 's/.*Version //p' /dev/null >/dev/null ; then + UNAME_REL=$( (/bin/uname -X|grep Release|sed -e 's/.*= //')) + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL" + else + echo "$UNAME_MACHINE"-pc-sysv32 + fi + exit ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configure will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; + Intel:Mach:3*:*) + echo i386-pc-mach3 + exit ;; + paragon:*:*:*) + echo i860-intel-osf1 + exit ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv"$UNAME_RELEASE" # Unknown i860-SVR4 + fi + exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv + exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv + exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix + exit ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.$(sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.$(sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos"$UNAME_RELEASE" + exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 + exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos"$UNAME_RELEASE" + exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos"$UNAME_RELEASE" + exit ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) + echo powerpc-unknown-lynxos"$UNAME_RELEASE" + exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv"$UNAME_RELEASE" + exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=$( (uname -p) 2>/dev/null) + echo "$UNAME_MACHINE"-sni-sysv4 + else + echo ns32k-sni-sysv + fi + exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 + exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo "$UNAME_MACHINE"-stratus-vos + exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos + exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux"$UNAME_RELEASE" + exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 + exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if test -d /usr/nec; then + echo mips-nec-sysv"$UNAME_RELEASE" + else + echo mips-unknown-sysv"$UNAME_RELEASE" + fi + exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos + exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos + exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos + exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux"$UNAME_RELEASE" + exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux"$UNAME_RELEASE" + exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux"$UNAME_RELEASE" + exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux"$UNAME_RELEASE" + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux"$UNAME_RELEASE" + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux"$UNAME_RELEASE" + exit ;; + SX-ACE:SUPER-UX:*:*) + echo sxace-nec-superux"$UNAME_RELEASE" + exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody"$UNAME_RELEASE" + exit ;; + *:Rhapsody:*:*) + echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE" + exit ;; + arm64:Darwin:*:*) + echo aarch64-apple-darwin"$UNAME_RELEASE" + exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=$(uname -p) + case $UNAME_PROCESSOR in + unknown) UNAME_PROCESSOR=powerpc ;; + esac + if command -v xcode-select > /dev/null 2> /dev/null && \ + ! xcode-select --print-path > /dev/null 2> /dev/null ; then + # Avoid executing cc if there is no toolchain installed as + # cc will be a stub that puts up a graphical alert + # prompting the user to install developer tools. + CC_FOR_BUILD=no_compiler_found + else + set_cc_for_build + fi + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + case $UNAME_PROCESSOR in + i386) UNAME_PROCESSOR=x86_64 ;; + powerpc) UNAME_PROCESSOR=powerpc64 ;; + esac + fi + # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc + if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_PPC >/dev/null + then + UNAME_PROCESSOR=powerpc + fi + elif test "$UNAME_PROCESSOR" = i386 ; then + # uname -m returns i386 or x86_64 + UNAME_PROCESSOR=$UNAME_MACHINE + fi + echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE" + exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=$(uname -p) + if test "$UNAME_PROCESSOR" = x86; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE" + exit ;; + *:QNX:*:4*) + echo i386-pc-qnx + exit ;; + NEO-*:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSR-*:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSV-*:NONSTOP_KERNEL:*:*) + echo nsv-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSX-*:NONSTOP_KERNEL:*:*) + echo nsx-tandem-nsk"$UNAME_RELEASE" + exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux + exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv + exit ;; + DS/*:UNIX_System_V:*:*) + echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE" + exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + # shellcheck disable=SC2154 + if test "$cputype" = 386; then + UNAME_MACHINE=i386 + else + UNAME_MACHINE="$cputype" + fi + echo "$UNAME_MACHINE"-unknown-plan9 + exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 + exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex + exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 + exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 + exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 + exit ;; + *:ITS:*:*) + echo pdp10-unknown-its + exit ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux"$UNAME_RELEASE" + exit ;; + *:DragonFly:*:*) + echo "$UNAME_MACHINE"-unknown-dragonfly"$(echo "$UNAME_RELEASE"|sed -e 's/[-(].*//')" + exit ;; + *:*VMS:*:*) + UNAME_MACHINE=$( (uname -p) 2>/dev/null) + case "$UNAME_MACHINE" in + A*) echo alpha-dec-vms ; exit ;; + I*) echo ia64-dec-vms ; exit ;; + V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix + exit ;; + i*86:skyos:*:*) + echo "$UNAME_MACHINE"-pc-skyos"$(echo "$UNAME_RELEASE" | sed -e 's/ .*$//')" + exit ;; + i*86:rdos:*:*) + echo "$UNAME_MACHINE"-pc-rdos + exit ;; + *:AROS:*:*) + echo "$UNAME_MACHINE"-unknown-aros + exit ;; + x86_64:VMkernel:*:*) + echo "$UNAME_MACHINE"-unknown-esx + exit ;; + amd64:Isilon\ OneFS:*:*) + echo x86_64-unknown-onefs + exit ;; + *:Unleashed:*:*) + echo "$UNAME_MACHINE"-unknown-unleashed"$UNAME_RELEASE" + exit ;; +esac + +# No uname command or uname output not recognized. +set_cc_for_build +cat > "$dummy.c" < +#include +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#include +#if defined(_SIZE_T_) || defined(SIGLOST) +#include +#endif +#endif +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=$( (hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null); + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); +#endif + +#if defined (vax) +#if !defined (ultrix) +#include +#if defined (BSD) +#if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +#else +#if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#endif +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#else +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname un; + uname (&un); + printf ("vax-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("vax-dec-ultrix\n"); exit (0); +#endif +#endif +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname *un; + uname (&un); + printf ("mips-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("mips-dec-ultrix\n"); exit (0); +#endif +#endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=$($dummy) && + { echo "$SYSTEM_NAME"; exit; } + +# Apollos put the system type in the environment. +test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; } + +echo "$0: unable to guess system type" >&2 + +case "$UNAME_MACHINE:$UNAME_SYSTEM" in + mips:Linux | mips64:Linux) + # If we got here on MIPS GNU/Linux, output extra information. + cat >&2 <&2 <&2 </dev/null || echo unknown) +uname -r = $( (uname -r) 2>/dev/null || echo unknown) +uname -s = $( (uname -s) 2>/dev/null || echo unknown) +uname -v = $( (uname -v) 2>/dev/null || echo unknown) + +/usr/bin/uname -p = $( (/usr/bin/uname -p) 2>/dev/null) +/bin/uname -X = $( (/bin/uname -X) 2>/dev/null) + +hostinfo = $( (hostinfo) 2>/dev/null) +/bin/universe = $( (/bin/universe) 2>/dev/null) +/usr/bin/arch -k = $( (/usr/bin/arch -k) 2>/dev/null) +/bin/arch = $( (/bin/arch) 2>/dev/null) +/usr/bin/oslevel = $( (/usr/bin/oslevel) 2>/dev/null) +/usr/convex/getsysinfo = $( (/usr/convex/getsysinfo) 2>/dev/null) + +UNAME_MACHINE = "$UNAME_MACHINE" +UNAME_RELEASE = "$UNAME_RELEASE" +UNAME_SYSTEM = "$UNAME_SYSTEM" +UNAME_VERSION = "$UNAME_VERSION" +EOF +fi + +exit 1 + +# Local variables: +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/vendor/cfitsio/config.sub b/vendor/cfitsio/config.sub new file mode 100755 index 000000000..63c1f1c8b --- /dev/null +++ b/vendor/cfitsio/config.sub @@ -0,0 +1,1860 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright 1992-2021 Free Software Foundation, Inc. + +timestamp='2021-01-08' + +# This file 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 3 of the License, 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, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). + + +# Please send patches to . +# +# Configuration subroutine to validate and canonicalize a configuration type. +# Supply the specified configuration type as an argument. +# If it is invalid, we print an error message on stderr and exit with code 1. +# Otherwise, we print the canonical config type on stdout and succeed. + +# You can get the latest version of this script from: +# https://git.savannah.gnu.org/cgit/config.git/plain/config.sub + +# This file is supposed to be the same for all GNU packages +# and recognize all the CPU types, system types and aliases +# that are meaningful with *any* GNU software. +# Each package is responsible for reporting which valid configurations +# it does not support. The user should be able to distinguish +# a failure to support a valid configuration from a meaningless +# configuration. + +# The goal of this file is to map all the various variations of a given +# machine specification into a single specification in the form: +# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM +# or in some cases, the newer four-part form: +# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM +# It is wrong to echo any other type of specification. + +me=$(echo "$0" | sed -e 's,.*/,,') + +usage="\ +Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS + +Canonicalize a configuration name. + +Options: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.sub ($timestamp) + +Copyright 1992-2021 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo "$1" + exit ;; + + * ) + break ;; + esac +done + +case $# in + 0) echo "$me: missing argument$help" >&2 + exit 1;; + 1) ;; + *) echo "$me: too many arguments$help" >&2 + exit 1;; +esac + +# Split fields of configuration type +# shellcheck disable=SC2162 +IFS="-" read field1 field2 field3 field4 <&2 + exit 1 + ;; + *-*-*-*) + basic_machine=$field1-$field2 + basic_os=$field3-$field4 + ;; + *-*-*) + # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two + # parts + maybe_os=$field2-$field3 + case $maybe_os in + nto-qnx* | linux-* | uclinux-uclibc* \ + | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \ + | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \ + | storm-chaos* | os2-emx* | rtmk-nova*) + basic_machine=$field1 + basic_os=$maybe_os + ;; + android-linux) + basic_machine=$field1-unknown + basic_os=linux-android + ;; + *) + basic_machine=$field1-$field2 + basic_os=$field3 + ;; + esac + ;; + *-*) + # A lone config we happen to match not fitting any pattern + case $field1-$field2 in + decstation-3100) + basic_machine=mips-dec + basic_os= + ;; + *-*) + # Second component is usually, but not always the OS + case $field2 in + # Prevent following clause from handling this valid os + sun*os*) + basic_machine=$field1 + basic_os=$field2 + ;; + # Manufacturers + dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \ + | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ + | unicom* | ibm* | next | hp | isi* | apollo | altos* \ + | convergent* | ncr* | news | 32* | 3600* | 3100* \ + | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \ + | ultra | tti* | harris | dolphin | highlevel | gould \ + | cbm | ns | masscomp | apple | axis | knuth | cray \ + | microblaze* | sim | cisco \ + | oki | wec | wrs | winbond) + basic_machine=$field1-$field2 + basic_os= + ;; + *) + basic_machine=$field1 + basic_os=$field2 + ;; + esac + ;; + esac + ;; + *) + # Convert single-component short-hands not valid as part of + # multi-component configurations. + case $field1 in + 386bsd) + basic_machine=i386-pc + basic_os=bsd + ;; + a29khif) + basic_machine=a29k-amd + basic_os=udi + ;; + adobe68k) + basic_machine=m68010-adobe + basic_os=scout + ;; + alliant) + basic_machine=fx80-alliant + basic_os= + ;; + altos | altos3068) + basic_machine=m68k-altos + basic_os= + ;; + am29k) + basic_machine=a29k-none + basic_os=bsd + ;; + amdahl) + basic_machine=580-amdahl + basic_os=sysv + ;; + amiga) + basic_machine=m68k-unknown + basic_os= + ;; + amigaos | amigados) + basic_machine=m68k-unknown + basic_os=amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + basic_os=sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + basic_os=sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + basic_os=bsd + ;; + aros) + basic_machine=i386-pc + basic_os=aros + ;; + aux) + basic_machine=m68k-apple + basic_os=aux + ;; + balance) + basic_machine=ns32k-sequent + basic_os=dynix + ;; + blackfin) + basic_machine=bfin-unknown + basic_os=linux + ;; + cegcc) + basic_machine=arm-unknown + basic_os=cegcc + ;; + convex-c1) + basic_machine=c1-convex + basic_os=bsd + ;; + convex-c2) + basic_machine=c2-convex + basic_os=bsd + ;; + convex-c32) + basic_machine=c32-convex + basic_os=bsd + ;; + convex-c34) + basic_machine=c34-convex + basic_os=bsd + ;; + convex-c38) + basic_machine=c38-convex + basic_os=bsd + ;; + cray) + basic_machine=j90-cray + basic_os=unicos + ;; + crds | unos) + basic_machine=m68k-crds + basic_os= + ;; + da30) + basic_machine=m68k-da30 + basic_os= + ;; + decstation | pmax | pmin | dec3100 | decstatn) + basic_machine=mips-dec + basic_os= + ;; + delta88) + basic_machine=m88k-motorola + basic_os=sysv3 + ;; + dicos) + basic_machine=i686-pc + basic_os=dicos + ;; + djgpp) + basic_machine=i586-pc + basic_os=msdosdjgpp + ;; + ebmon29k) + basic_machine=a29k-amd + basic_os=ebmon + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + basic_os=ose + ;; + gmicro) + basic_machine=tron-gmicro + basic_os=sysv + ;; + go32) + basic_machine=i386-pc + basic_os=go32 + ;; + h8300hms) + basic_machine=h8300-hitachi + basic_os=hms + ;; + h8300xray) + basic_machine=h8300-hitachi + basic_os=xray + ;; + h8500hms) + basic_machine=h8500-hitachi + basic_os=hms + ;; + harris) + basic_machine=m88k-harris + basic_os=sysv3 + ;; + hp300 | hp300hpux) + basic_machine=m68k-hp + basic_os=hpux + ;; + hp300bsd) + basic_machine=m68k-hp + basic_os=bsd + ;; + hppaosf) + basic_machine=hppa1.1-hp + basic_os=osf + ;; + hppro) + basic_machine=hppa1.1-hp + basic_os=proelf + ;; + i386mach) + basic_machine=i386-mach + basic_os=mach + ;; + isi68 | isi) + basic_machine=m68k-isi + basic_os=sysv + ;; + m68knommu) + basic_machine=m68k-unknown + basic_os=linux + ;; + magnum | m3230) + basic_machine=mips-mips + basic_os=sysv + ;; + merlin) + basic_machine=ns32k-utek + basic_os=sysv + ;; + mingw64) + basic_machine=x86_64-pc + basic_os=mingw64 + ;; + mingw32) + basic_machine=i686-pc + basic_os=mingw32 + ;; + mingw32ce) + basic_machine=arm-unknown + basic_os=mingw32ce + ;; + monitor) + basic_machine=m68k-rom68k + basic_os=coff + ;; + morphos) + basic_machine=powerpc-unknown + basic_os=morphos + ;; + moxiebox) + basic_machine=moxie-unknown + basic_os=moxiebox + ;; + msdos) + basic_machine=i386-pc + basic_os=msdos + ;; + msys) + basic_machine=i686-pc + basic_os=msys + ;; + mvs) + basic_machine=i370-ibm + basic_os=mvs + ;; + nacl) + basic_machine=le32-unknown + basic_os=nacl + ;; + ncr3000) + basic_machine=i486-ncr + basic_os=sysv4 + ;; + netbsd386) + basic_machine=i386-pc + basic_os=netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + basic_os=linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + basic_os=newsos + ;; + news1000) + basic_machine=m68030-sony + basic_os=newsos + ;; + necv70) + basic_machine=v70-nec + basic_os=sysv + ;; + nh3000) + basic_machine=m68k-harris + basic_os=cxux + ;; + nh[45]000) + basic_machine=m88k-harris + basic_os=cxux + ;; + nindy960) + basic_machine=i960-intel + basic_os=nindy + ;; + mon960) + basic_machine=i960-intel + basic_os=mon960 + ;; + nonstopux) + basic_machine=mips-compaq + basic_os=nonstopux + ;; + os400) + basic_machine=powerpc-ibm + basic_os=os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + basic_os=ose + ;; + os68k) + basic_machine=m68k-none + basic_os=os68k + ;; + paragon) + basic_machine=i860-intel + basic_os=osf + ;; + parisc) + basic_machine=hppa-unknown + basic_os=linux + ;; + psp) + basic_machine=mipsallegrexel-sony + basic_os=psp + ;; + pw32) + basic_machine=i586-unknown + basic_os=pw32 + ;; + rdos | rdos64) + basic_machine=x86_64-pc + basic_os=rdos + ;; + rdos32) + basic_machine=i386-pc + basic_os=rdos + ;; + rom68k) + basic_machine=m68k-rom68k + basic_os=coff + ;; + sa29200) + basic_machine=a29k-amd + basic_os=udi + ;; + sei) + basic_machine=mips-sei + basic_os=seiux + ;; + sequent) + basic_machine=i386-sequent + basic_os= + ;; + sps7) + basic_machine=m68k-bull + basic_os=sysv2 + ;; + st2000) + basic_machine=m68k-tandem + basic_os= + ;; + stratus) + basic_machine=i860-stratus + basic_os=sysv4 + ;; + sun2) + basic_machine=m68000-sun + basic_os= + ;; + sun2os3) + basic_machine=m68000-sun + basic_os=sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + basic_os=sunos4 + ;; + sun3) + basic_machine=m68k-sun + basic_os= + ;; + sun3os3) + basic_machine=m68k-sun + basic_os=sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + basic_os=sunos4 + ;; + sun4) + basic_machine=sparc-sun + basic_os= + ;; + sun4os3) + basic_machine=sparc-sun + basic_os=sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + basic_os=sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + basic_os=solaris2 + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + basic_os= + ;; + sv1) + basic_machine=sv1-cray + basic_os=unicos + ;; + symmetry) + basic_machine=i386-sequent + basic_os=dynix + ;; + t3e) + basic_machine=alphaev5-cray + basic_os=unicos + ;; + t90) + basic_machine=t90-cray + basic_os=unicos + ;; + toad1) + basic_machine=pdp10-xkl + basic_os=tops20 + ;; + tpf) + basic_machine=s390x-ibm + basic_os=tpf + ;; + udi29k) + basic_machine=a29k-amd + basic_os=udi + ;; + ultra3) + basic_machine=a29k-nyu + basic_os=sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + basic_os=none + ;; + vaxv) + basic_machine=vax-dec + basic_os=sysv + ;; + vms) + basic_machine=vax-dec + basic_os=vms + ;; + vsta) + basic_machine=i386-pc + basic_os=vsta + ;; + vxworks960) + basic_machine=i960-wrs + basic_os=vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + basic_os=vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + basic_os=vxworks + ;; + xbox) + basic_machine=i686-pc + basic_os=mingw32 + ;; + ymp) + basic_machine=ymp-cray + basic_os=unicos + ;; + *) + basic_machine=$1 + basic_os= + ;; + esac + ;; +esac + +# Decode 1-component or ad-hoc basic machines +case $basic_machine in + # Here we handle the default manufacturer of certain CPU types. It is in + # some cases the only manufacturer, in others, it is the most popular. + w89k) + cpu=hppa1.1 + vendor=winbond + ;; + op50n) + cpu=hppa1.1 + vendor=oki + ;; + op60c) + cpu=hppa1.1 + vendor=oki + ;; + ibm*) + cpu=i370 + vendor=ibm + ;; + orion105) + cpu=clipper + vendor=highlevel + ;; + mac | mpw | mac-mpw) + cpu=m68k + vendor=apple + ;; + pmac | pmac-mpw) + cpu=powerpc + vendor=apple + ;; + + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. + 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) + cpu=m68000 + vendor=att + ;; + 3b*) + cpu=we32k + vendor=att + ;; + bluegene*) + cpu=powerpc + vendor=ibm + basic_os=cnk + ;; + decsystem10* | dec10*) + cpu=pdp10 + vendor=dec + basic_os=tops10 + ;; + decsystem20* | dec20*) + cpu=pdp10 + vendor=dec + basic_os=tops20 + ;; + delta | 3300 | motorola-3300 | motorola-delta \ + | 3300-motorola | delta-motorola) + cpu=m68k + vendor=motorola + ;; + dpx2*) + cpu=m68k + vendor=bull + basic_os=sysv3 + ;; + encore | umax | mmax) + cpu=ns32k + vendor=encore + ;; + elxsi) + cpu=elxsi + vendor=elxsi + basic_os=${basic_os:-bsd} + ;; + fx2800) + cpu=i860 + vendor=alliant + ;; + genix) + cpu=ns32k + vendor=ns + ;; + h3050r* | hiux*) + cpu=hppa1.1 + vendor=hitachi + basic_os=hiuxwe2 + ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + hp9k2[0-9][0-9] | hp9k31[0-9]) + cpu=m68000 + vendor=hp + ;; + hp9k3[2-9][0-9]) + cpu=m68k + vendor=hp + ;; + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + cpu=hppa1.1 + vendor=hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[0-9][0-9] | hp8[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + i*86v32) + cpu=$(echo "$1" | sed -e 's/86.*/86/') + vendor=pc + basic_os=sysv32 + ;; + i*86v4*) + cpu=$(echo "$1" | sed -e 's/86.*/86/') + vendor=pc + basic_os=sysv4 + ;; + i*86v) + cpu=$(echo "$1" | sed -e 's/86.*/86/') + vendor=pc + basic_os=sysv + ;; + i*86sol2) + cpu=$(echo "$1" | sed -e 's/86.*/86/') + vendor=pc + basic_os=solaris2 + ;; + j90 | j90-cray) + cpu=j90 + vendor=cray + basic_os=${basic_os:-unicos} + ;; + iris | iris4d) + cpu=mips + vendor=sgi + case $basic_os in + irix*) + ;; + *) + basic_os=irix4 + ;; + esac + ;; + miniframe) + cpu=m68000 + vendor=convergent + ;; + *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*) + cpu=m68k + vendor=atari + basic_os=mint + ;; + news-3600 | risc-news) + cpu=mips + vendor=sony + basic_os=newsos + ;; + next | m*-next) + cpu=m68k + vendor=next + case $basic_os in + openstep*) + ;; + nextstep*) + ;; + ns2*) + basic_os=nextstep2 + ;; + *) + basic_os=nextstep3 + ;; + esac + ;; + np1) + cpu=np1 + vendor=gould + ;; + op50n-* | op60c-*) + cpu=hppa1.1 + vendor=oki + basic_os=proelf + ;; + pa-hitachi) + cpu=hppa1.1 + vendor=hitachi + basic_os=hiuxwe2 + ;; + pbd) + cpu=sparc + vendor=tti + ;; + pbb) + cpu=m68k + vendor=tti + ;; + pc532) + cpu=ns32k + vendor=pc532 + ;; + pn) + cpu=pn + vendor=gould + ;; + power) + cpu=power + vendor=ibm + ;; + ps2) + cpu=i386 + vendor=ibm + ;; + rm[46]00) + cpu=mips + vendor=siemens + ;; + rtpc | rtpc-*) + cpu=romp + vendor=ibm + ;; + sde) + cpu=mipsisa32 + vendor=sde + basic_os=${basic_os:-elf} + ;; + simso-wrs) + cpu=sparclite + vendor=wrs + basic_os=vxworks + ;; + tower | tower-32) + cpu=m68k + vendor=ncr + ;; + vpp*|vx|vx-*) + cpu=f301 + vendor=fujitsu + ;; + w65) + cpu=w65 + vendor=wdc + ;; + w89k-*) + cpu=hppa1.1 + vendor=winbond + basic_os=proelf + ;; + none) + cpu=none + vendor=none + ;; + leon|leon[3-9]) + cpu=sparc + vendor=$basic_machine + ;; + leon-*|leon[3-9]-*) + cpu=sparc + vendor=$(echo "$basic_machine" | sed 's/-.*//') + ;; + + *-*) + # shellcheck disable=SC2162 + IFS="-" read cpu vendor <&2 + exit 1 + ;; + esac + ;; +esac + +# Here we canonicalize certain aliases for manufacturers. +case $vendor in + digital*) + vendor=dec + ;; + commodore*) + vendor=cbm + ;; + *) + ;; +esac + +# Decode manufacturer-specific aliases for certain operating systems. + +if test x$basic_os != x +then + +# First recognize some ad-hoc caes, or perhaps split kernel-os, or else just +# set os. +case $basic_os in + gnu/linux*) + kernel=linux + os=$(echo $basic_os | sed -e 's|gnu/linux|gnu|') + ;; + os2-emx) + kernel=os2 + os=$(echo $basic_os | sed -e 's|os2-emx|emx|') + ;; + nto-qnx*) + kernel=nto + os=$(echo $basic_os | sed -e 's|nto-qnx|qnx|') + ;; + *-*) + # shellcheck disable=SC2162 + IFS="-" read kernel os <&2 + exit 1 + ;; +esac + +# As a final step for OS-related things, validate the OS-kernel combination +# (given a valid OS), if there is a kernel. +case $kernel-$os in + linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* | linux-musl* | linux-uclibc* ) + ;; + uclinux-uclibc* ) + ;; + -dietlibc* | -newlib* | -musl* | -uclibc* ) + # These are just libc implementations, not actual OSes, and thus + # require a kernel. + echo "Invalid configuration \`$1': libc \`$os' needs explicit kernel." 1>&2 + exit 1 + ;; + kfreebsd*-gnu* | kopensolaris*-gnu*) + ;; + vxworks-simlinux | vxworks-simwindows | vxworks-spe) + ;; + nto-qnx*) + ;; + os2-emx) + ;; + *-eabi* | *-gnueabi*) + ;; + -*) + # Blank kernel with real OS is always fine. + ;; + *-*) + echo "Invalid configuration \`$1': Kernel \`$kernel' not known to work with OS \`$os'." 1>&2 + exit 1 + ;; +esac + +# Here we handle the case where we know the os, and the CPU type, but not the +# manufacturer. We pick the logical manufacturer. +case $vendor in + unknown) + case $cpu-$os in + *-riscix*) + vendor=acorn + ;; + *-sunos*) + vendor=sun + ;; + *-cnk* | *-aix*) + vendor=ibm + ;; + *-beos*) + vendor=be + ;; + *-hpux*) + vendor=hp + ;; + *-mpeix*) + vendor=hp + ;; + *-hiux*) + vendor=hitachi + ;; + *-unos*) + vendor=crds + ;; + *-dgux*) + vendor=dg + ;; + *-luna*) + vendor=omron + ;; + *-genix*) + vendor=ns + ;; + *-clix*) + vendor=intergraph + ;; + *-mvs* | *-opened*) + vendor=ibm + ;; + *-os400*) + vendor=ibm + ;; + s390-* | s390x-*) + vendor=ibm + ;; + *-ptx*) + vendor=sequent + ;; + *-tpf*) + vendor=ibm + ;; + *-vxsim* | *-vxworks* | *-windiss*) + vendor=wrs + ;; + *-aux*) + vendor=apple + ;; + *-hms*) + vendor=hitachi + ;; + *-mpw* | *-macos*) + vendor=apple + ;; + *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*) + vendor=atari + ;; + *-vos*) + vendor=stratus + ;; + esac + ;; +esac + +echo "$cpu-$vendor-${kernel:+$kernel-}$os" +exit + +# Local variables: +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/vendor/cfitsio/configure b/vendor/cfitsio/configure new file mode 100755 index 000000000..35e8f795b --- /dev/null +++ b/vendor/cfitsio/configure @@ -0,0 +1,8162 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.71. +# +# +# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, +# Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +as_nop=: +if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else $as_nop + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + + +# Reset variables that may have inherited troublesome values from +# the environment. + +# IFS needs to be set, to space, tab, and newline, in precisely that order. +# (If _AS_PATH_WALK were called with IFS unset, it would have the +# side effect of setting IFS to empty, thus disabling word splitting.) +# Quoting is to prevent editors from complaining about space-tab. +as_nl=' +' +export as_nl +IFS=" "" $as_nl" + +PS1='$ ' +PS2='> ' +PS4='+ ' + +# Ensure predictable behavior from utilities with locale-dependent output. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# We cannot yet rely on "unset" to work, but we need these variables +# to be unset--not just set to an empty or harmless value--now, to +# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct +# also avoids known problems related to "unset" and subshell syntax +# in other old shells (e.g. bash 2.01 and pdksh 5.2.14). +for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH +do eval test \${$as_var+y} \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done + +# Ensure that fds 0, 1, and 2 are open. +if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi +if (exec 3>&2) ; then :; else exec 2>/dev/null; fi + +# The user is always right. +if ${PATH_SEPARATOR+false} :; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + test -r "$as_dir$0" && as_myself=$as_dir$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="as_nop=: +if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else \$as_nop + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ) +then : + +else \$as_nop + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +blah=\$(echo \$(echo blah)) +test x\"\$blah\" = xblah || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" + if (eval "$as_required") 2>/dev/null +then : + as_have_required=yes +else $as_nop + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null +then : + +else $as_nop + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null +then : + CONFIG_SHELL=$as_shell as_have_required=yes + if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null +then : + break 2 +fi +fi + done;; + esac + as_found=false +done +IFS=$as_save_IFS +if $as_found +then : + +else $as_nop + if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null +then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi +fi + + + if test "x$CONFIG_SHELL" != x +then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno +then : + printf "%s\n" "$0: This script requires a shell more modern than all" + printf "%s\n" "$0: the shells that I found on your system." + if test ${ZSH_VERSION+y} ; then + printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should" + printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later." + else + printf "%s\n" "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit +# as_fn_nop +# --------- +# Do nothing but, unlike ":", preserve the value of $?. +as_fn_nop () +{ + return $? +} +as_nop=as_fn_nop + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null +then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else $as_nop + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null +then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else $as_nop + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + +# as_fn_nop +# --------- +# Do nothing but, unlike ":", preserve the value of $?. +as_fn_nop () +{ + return $? +} +as_nop=as_fn_nop +# as_fn_nop +# --------- +# Do nothing but, unlike ":", preserve the value of $?. +as_fn_nop () +{ + return $? +} +as_nop=as_fn_nop + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + printf "%s\n" "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +# Determine whether it's possible to make 'echo' print without a newline. +# These variables are no longer used directly by Autoconf, but are AC_SUBSTed +# for compatibility with existing Makefiles. +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +# For backward compatibility with old third-party macros, we provide +# the shell variables $as_echo and $as_echo_n. New code should use +# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. +as_echo='printf %s\n' +as_echo_n='printf %s' + + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='' +PACKAGE_TARNAME='' +PACKAGE_VERSION='' +PACKAGE_STRING='' +PACKAGE_BUGREPORT='' +PACKAGE_URL='' + +ac_unique_file="fitscore.c" +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_STDIO_H +# include +#endif +#ifdef HAVE_STDLIB_H +# include +#endif +#ifdef HAVE_STRING_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_header_c_list= +ac_default_prefix=`pwd` +ac_subst_vars='LTLIBOBJS +LIBOBJS +my_shmem +LDFLAGS_BIN +F77_WRAPPERS +CFITSIO_SHLIB_SONAME +CFITSIO_SHLIB +SHLIB_SUFFIX +SHLIB_LD +LIBPRE +ARCH +LIBS_CURL +CURLCONFIG +GCCVERSION +SSE_FLAGS +RANLIB +ARCHIVE +AR +FC +INSTALL_ROOT +GSIFTP_SRC +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +CFITSIO_SONAME +CFITSIO_MICRO +CFITSIO_MINOR +CFITSIO_MAJOR +target_os +target_vendor +target_cpu +target +host_os +host_vendor +host_cpu +host +build_os +build_vendor +build_cpu +build +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +runstatedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +enable_curl +enable_reentrant +enable_sse2 +enable_ssse3 +enable_symbols +enable_hera +with_bzip2 +with_gsiftp +with_gsiftp_flavour +with_zlib_check +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir runstatedir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures this package to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF + +System types: + --build=BUILD configure for building on BUILD [guessed] + --host=HOST cross-compile to build programs to run on HOST [BUILD] + --target=TARGET configure for building compilers for TARGET [HOST] +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --disable-curl Disable linking with the curl library. Disables + remote file i/o support + --enable-reentrant Enable reentrant multithreading + --enable-sse2 Enable use of instructions in the SSE2 extended + instruction set + --enable-ssse3 Enable use of instructions in the SSSE3 extended + instruction set + --enable-symbols Enable debugging symbols by turning optimization off + --enable-hera Build for HERA (ASD use only) + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-bzip2[=PATH] Enable bzip2 support. Optional path to the location + of include/bzlib.h and lib/libbz2 + --with-gsiftp[=PATH] Enable Globus Toolkit gsiftp protocol support + --with-gsiftp-flavour[=PATH] + Define Globus Toolkit gsiftp protocol flavour + --without-zlib-check Disable check for zlib compression library e.g. for + cross-compilers + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to the package provider. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for configure.gnu first; this name is used for a wrapper for + # Metaconfig's "Configure" on case-insensitive file systems. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +configure +generated by GNU Autoconf 2.71 + +Copyright (C) 2021 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest.beam + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext +then : + ac_retval=0 +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + } +then : + ac_retval=0 +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +printf %s "checking for $2... " >&6; } +if eval test \${$3+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + eval "$3=yes" +else $as_nop + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +eval ac_res=\$$3 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +printf "%s\n" "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +printf %s "checking for $2... " >&6; } +if eval test \${$3+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. */ + +#include +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main (void) +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + eval "$3=yes" +else $as_nop + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +printf "%s\n" "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func +ac_configure_args_raw= +for ac_arg +do + case $ac_arg in + *\'*) + ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append ac_configure_args_raw " '$ac_arg'" +done + +case $ac_configure_args_raw in + *$as_nl*) + ac_safe_unquote= ;; + *) + ac_unsafe_z='|&;<>()$`\\"*?[ '' ' # This string ends in space, tab. + ac_unsafe_a="$ac_unsafe_z#~" + ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g" + ac_configure_args_raw=` printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;; +esac + +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by $as_me, which was +generated by GNU Autoconf 2.71. Invocation command line was + + $ $0$ac_configure_args_raw + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + printf "%s\n" "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Sanitize IFS. + IFS=" "" $as_nl" + # Save into config.log some information that might help in debugging. + { + echo + + printf "%s\n" "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + printf "%s\n" "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + printf "%s\n" "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + printf "%s\n" "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + printf "%s\n" "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + printf "%s\n" "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + printf "%s\n" "$as_me: caught signal $ac_signal" + printf "%s\n" "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +printf "%s\n" "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +if test -n "$CONFIG_SITE"; then + ac_site_files="$CONFIG_SITE" +elif test "x$prefix" != xNONE; then + ac_site_files="$prefix/share/config.site $prefix/etc/config.site" +else + ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" +fi + +for ac_site_file in $ac_site_files +do + case $ac_site_file in #( + */*) : + ;; #( + *) : + ac_site_file=./$ac_site_file ;; +esac + if test -f "$ac_site_file" && test -r "$ac_site_file"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +printf "%s\n" "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +printf "%s\n" "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Test code for whether the C compiler supports C89 (global declarations) +ac_c_conftest_c89_globals=' +/* Does the compiler advertise C89 conformance? + Do not test the value of __STDC__, because some compilers set it to 0 + while being otherwise adequately conformant. */ +#if !defined __STDC__ +# error "Compiler does not advertise C89 conformance" +#endif + +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ +struct buf { int x; }; +struct buf * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not \xHH hex character constants. + These do not provoke an error unfortunately, instead are silently treated + as an "x". The following induces an error, until -std is added to get + proper ANSI mode. Curiously \x00 != x always comes out true, for an + array size at least. It is necessary to write \x00 == 0 to get something + that is true only with -std. */ +int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) '\''x'\'' +int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int), + int, int);' + +# Test code for whether the C compiler supports C89 (body of main). +ac_c_conftest_c89_main=' +ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); +' + +# Test code for whether the C compiler supports C99 (global declarations) +ac_c_conftest_c99_globals=' +// Does the compiler advertise C99 conformance? +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L +# error "Compiler does not advertise C99 conformance" +#endif + +#include +extern int puts (const char *); +extern int printf (const char *, ...); +extern int dprintf (int, const char *, ...); +extern void *malloc (size_t); + +// Check varargs macros. These examples are taken from C99 6.10.3.5. +// dprintf is used instead of fprintf to avoid needing to declare +// FILE and stderr. +#define debug(...) dprintf (2, __VA_ARGS__) +#define showlist(...) puts (#__VA_ARGS__) +#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) +static void +test_varargs_macros (void) +{ + int x = 1234; + int y = 5678; + debug ("Flag"); + debug ("X = %d\n", x); + showlist (The first, second, and third items.); + report (x>y, "x is %d but y is %d", x, y); +} + +// Check long long types. +#define BIG64 18446744073709551615ull +#define BIG32 4294967295ul +#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) +#if !BIG_OK + #error "your preprocessor is broken" +#endif +#if BIG_OK +#else + #error "your preprocessor is broken" +#endif +static long long int bignum = -9223372036854775807LL; +static unsigned long long int ubignum = BIG64; + +struct incomplete_array +{ + int datasize; + double data[]; +}; + +struct named_init { + int number; + const wchar_t *name; + double average; +}; + +typedef const char *ccp; + +static inline int +test_restrict (ccp restrict text) +{ + // See if C++-style comments work. + // Iterate through items via the restricted pointer. + // Also check for declarations in for loops. + for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) + continue; + return 0; +} + +// Check varargs and va_copy. +static bool +test_varargs (const char *format, ...) +{ + va_list args; + va_start (args, format); + va_list args_copy; + va_copy (args_copy, args); + + const char *str = ""; + int number = 0; + float fnumber = 0; + + while (*format) + { + switch (*format++) + { + case '\''s'\'': // string + str = va_arg (args_copy, const char *); + break; + case '\''d'\'': // int + number = va_arg (args_copy, int); + break; + case '\''f'\'': // float + fnumber = va_arg (args_copy, double); + break; + default: + break; + } + } + va_end (args_copy); + va_end (args); + + return *str && number && fnumber; +} +' + +# Test code for whether the C compiler supports C99 (body of main). +ac_c_conftest_c99_main=' + // Check bool. + _Bool success = false; + success |= (argc != 0); + + // Check restrict. + if (test_restrict ("String literal") == 0) + success = true; + char *restrict newvar = "Another string"; + + // Check varargs. + success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234); + test_varargs_macros (); + + // Check flexible array members. + struct incomplete_array *ia = + malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); + ia->datasize = 10; + for (int i = 0; i < ia->datasize; ++i) + ia->data[i] = i * 1.234; + + // Check named initializers. + struct named_init ni = { + .number = 34, + .name = L"Test wide string", + .average = 543.34343, + }; + + ni.number = 58; + + int dynamic_array[ni.number]; + dynamic_array[0] = argv[0][0]; + dynamic_array[ni.number - 1] = 543; + + // work around unused variable warnings + ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\'' + || dynamic_array[ni.number - 1] != 543); +' + +# Test code for whether the C compiler supports C11 (global declarations) +ac_c_conftest_c11_globals=' +// Does the compiler advertise C11 conformance? +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L +# error "Compiler does not advertise C11 conformance" +#endif + +// Check _Alignas. +char _Alignas (double) aligned_as_double; +char _Alignas (0) no_special_alignment; +extern char aligned_as_int; +char _Alignas (0) _Alignas (int) aligned_as_int; + +// Check _Alignof. +enum +{ + int_alignment = _Alignof (int), + int_array_alignment = _Alignof (int[100]), + char_alignment = _Alignof (char) +}; +_Static_assert (0 < -_Alignof (int), "_Alignof is signed"); + +// Check _Noreturn. +int _Noreturn does_not_return (void) { for (;;) continue; } + +// Check _Static_assert. +struct test_static_assert +{ + int x; + _Static_assert (sizeof (int) <= sizeof (long int), + "_Static_assert does not work in struct"); + long int y; +}; + +// Check UTF-8 literals. +#define u8 syntax error! +char const utf8_literal[] = u8"happens to be ASCII" "another string"; + +// Check duplicate typedefs. +typedef long *long_ptr; +typedef long int *long_ptr; +typedef long_ptr long_ptr; + +// Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1. +struct anonymous +{ + union { + struct { int i; int j; }; + struct { int k; long int l; } w; + }; + int m; +} v1; +' + +# Test code for whether the C compiler supports C11 (body of main). +ac_c_conftest_c11_main=' + _Static_assert ((offsetof (struct anonymous, i) + == offsetof (struct anonymous, w.k)), + "Anonymous union alignment botch"); + v1.i = 2; + v1.w.k = 5; + ok |= v1.i != 5; +' + +# Test code for whether the C compiler supports C11 (complete). +ac_c_conftest_c11_program="${ac_c_conftest_c89_globals} +${ac_c_conftest_c99_globals} +${ac_c_conftest_c11_globals} + +int +main (int argc, char **argv) +{ + int ok = 0; + ${ac_c_conftest_c89_main} + ${ac_c_conftest_c99_main} + ${ac_c_conftest_c11_main} + return ok; +} +" + +# Test code for whether the C compiler supports C99 (complete). +ac_c_conftest_c99_program="${ac_c_conftest_c89_globals} +${ac_c_conftest_c99_globals} + +int +main (int argc, char **argv) +{ + int ok = 0; + ${ac_c_conftest_c89_main} + ${ac_c_conftest_c99_main} + return ok; +} +" + +# Test code for whether the C compiler supports C89 (complete). +ac_c_conftest_c89_program="${ac_c_conftest_c89_globals} + +int +main (int argc, char **argv) +{ + int ok = 0; + ${ac_c_conftest_c89_main} + return ok; +} +" + +as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H" +as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H" +as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H" +as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H" +as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H" +as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H" +as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H" +as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H" +as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H" + +# Auxiliary files required by this configure script. +ac_aux_files="config.guess config.sub" + +# Locations in which to look for auxiliary files. +ac_aux_dir_candidates="${srcdir}${PATH_SEPARATOR}${srcdir}/..${PATH_SEPARATOR}${srcdir}/../.." + +# Search for a directory containing all of the required auxiliary files, +# $ac_aux_files, from the $PATH-style list $ac_aux_dir_candidates. +# If we don't find one directory that contains all the files we need, +# we report the set of missing files from the *first* directory in +# $ac_aux_dir_candidates and give up. +ac_missing_aux_files="" +ac_first_candidate=: +printf "%s\n" "$as_me:${as_lineno-$LINENO}: looking for aux files: $ac_aux_files" >&5 +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in $ac_aux_dir_candidates +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + as_found=: + + printf "%s\n" "$as_me:${as_lineno-$LINENO}: trying $as_dir" >&5 + ac_aux_dir_found=yes + ac_install_sh= + for ac_aux in $ac_aux_files + do + # As a special case, if "install-sh" is required, that requirement + # can be satisfied by any of "install-sh", "install.sh", or "shtool", + # and $ac_install_sh is set appropriately for whichever one is found. + if test x"$ac_aux" = x"install-sh" + then + if test -f "${as_dir}install-sh"; then + printf "%s\n" "$as_me:${as_lineno-$LINENO}: ${as_dir}install-sh found" >&5 + ac_install_sh="${as_dir}install-sh -c" + elif test -f "${as_dir}install.sh"; then + printf "%s\n" "$as_me:${as_lineno-$LINENO}: ${as_dir}install.sh found" >&5 + ac_install_sh="${as_dir}install.sh -c" + elif test -f "${as_dir}shtool"; then + printf "%s\n" "$as_me:${as_lineno-$LINENO}: ${as_dir}shtool found" >&5 + ac_install_sh="${as_dir}shtool install -c" + else + ac_aux_dir_found=no + if $ac_first_candidate; then + ac_missing_aux_files="${ac_missing_aux_files} install-sh" + else + break + fi + fi + else + if test -f "${as_dir}${ac_aux}"; then + printf "%s\n" "$as_me:${as_lineno-$LINENO}: ${as_dir}${ac_aux} found" >&5 + else + ac_aux_dir_found=no + if $ac_first_candidate; then + ac_missing_aux_files="${ac_missing_aux_files} ${ac_aux}" + else + break + fi + fi + fi + done + if test "$ac_aux_dir_found" = yes; then + ac_aux_dir="$as_dir" + break + fi + ac_first_candidate=false + + as_found=false +done +IFS=$as_save_IFS +if $as_found +then : + +else $as_nop + as_fn_error $? "cannot find required auxiliary files:$ac_missing_aux_files" "$LINENO" 5 +fi + + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +if test -f "${ac_aux_dir}config.guess"; then + ac_config_guess="$SHELL ${ac_aux_dir}config.guess" +fi +if test -f "${ac_aux_dir}config.sub"; then + ac_config_sub="$SHELL ${ac_aux_dir}config.sub" +fi +if test -f "$ac_aux_dir/configure"; then + ac_configure="$SHELL ${ac_aux_dir}configure" +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +printf "%s\n" "$as_me: former value: \`$ac_old_val'" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file' + and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + + # Make sure we can run config.sub. +$SHELL "${ac_aux_dir}config.sub" sun4 >/dev/null 2>&1 || + as_fn_error $? "cannot run $SHELL ${ac_aux_dir}config.sub" "$LINENO" 5 + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 +printf %s "checking build system type... " >&6; } +if test ${ac_cv_build+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "${ac_aux_dir}config.guess"` +test "x$ac_build_alias" = x && + as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 +ac_cv_build=`$SHELL "${ac_aux_dir}config.sub" $ac_build_alias` || + as_fn_error $? "$SHELL ${ac_aux_dir}config.sub $ac_build_alias failed" "$LINENO" 5 + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 +printf "%s\n" "$ac_cv_build" >&6; } +case $ac_cv_build in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 +printf %s "checking host system type... " >&6; } +if test ${ac_cv_host+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "${ac_aux_dir}config.sub" $host_alias` || + as_fn_error $? "$SHELL ${ac_aux_dir}config.sub $host_alias failed" "$LINENO" 5 +fi + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 +printf "%s\n" "$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking target system type" >&5 +printf %s "checking target system type... " >&6; } +if test ${ac_cv_target+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test "x$target_alias" = x; then + ac_cv_target=$ac_cv_host +else + ac_cv_target=`$SHELL "${ac_aux_dir}config.sub" $target_alias` || + as_fn_error $? "$SHELL ${ac_aux_dir}config.sub $target_alias failed" "$LINENO" 5 +fi + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_target" >&5 +printf "%s\n" "$ac_cv_target" >&6; } +case $ac_cv_target in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical target" "$LINENO" 5;; +esac +target=$ac_cv_target +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_target +shift +target_cpu=$1 +target_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +target_os=$* +IFS=$ac_save_IFS +case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac + + +# The aliases save the names the user supplied, while $host etc. +# will get canonicalized. +test -n "$target_alias" && + test "$program_prefix$program_suffix$program_transform_name" = \ + NONENONEs,x,x, && + program_prefix=${target_alias}- + +#-------------------------------------------------------------------- +# CFITSIO Version Numbers: +#-------------------------------------------------------------------- +CFITSIO_MAJOR=4 + +CFITSIO_MINOR=2 + +CFITSIO_MICRO=0 + +# Increment soname each time the interface changes: +CFITSIO_SONAME=10 + + +#-------------------------------------------------------------------- +# Command options +#-------------------------------------------------------------------- + +ADD_CURL=yes +# Check whether --enable-curl was given. +if test ${enable_curl+y} +then : + enableval=$enable_curl; if test $enableval = no; then ADD_CURL=no; fi + +fi + +if test "x$ADD_CURL" = xno; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Not linking with curl for remote file i/o support" >&5 +printf "%s\n" "$as_me: WARNING: Not linking with curl for remote file i/o support" >&2;} +fi + +# Check whether --enable-reentrant was given. +if test ${enable_reentrant+y} +then : + enableval=$enable_reentrant; if test $enableval = yes; then BUILD_REENTRANT=yes; fi + +fi + + +SSE_FLAGS="" +# Check whether --enable-sse2 was given. +if test ${enable_sse2+y} +then : + enableval=$enable_sse2; if test $enableval = yes; then SSE_FLAGS="-msse2"; fi + +fi + + +# Check whether --enable-ssse3 was given. +if test ${enable_ssse3+y} +then : + enableval=$enable_ssse3; if test $enableval = yes; then SSE_FLAGS="$SSE_FLAGS -mssse3"; fi + +fi + + +SYMBOLS="" +# Check whether --enable-symbols was given. +if test ${enable_symbols+y} +then : + enableval=$enable_symbols; if test $enableval = yes; then SYMBOLS=yes; fi + +fi + + +# Define BUILD_HERA when building for HERA project to activate code in +# drvrfile.c (by way of fitsio2.h): +# Check whether --enable-hera was given. +if test ${enable_hera+y} +then : + enableval=$enable_hera; if test $enableval = yes; then BUILD_HERA=yes; fi + +fi + +if test "x$BUILD_HERA" = xyes; then + printf "%s\n" "#define BUILD_HERA 1" >>confdefs.h + +fi + +# Optional support for bzip2 compression: + + + + + + + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. +set dummy ${ac_tool_prefix}clang; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}clang" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "clang", so it can be a program name with args. +set dummy clang; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="clang" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +fi + + +test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion -version; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +printf %s "checking whether the C compiler works... " >&6; } +ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else $as_nop + ac_file='' +fi +if test -z "$ac_file" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +printf %s "checking for C compiler default output file name... " >&6; } +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +printf "%s\n" "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +printf %s "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else $as_nop + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +printf "%s\n" "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main (void) +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +printf %s "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +printf "%s\n" "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +printf %s "checking for suffix of object files... " >&6; } +if test ${ac_cv_objext+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +printf "%s\n" "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 +printf %s "checking whether the compiler supports GNU C... " >&6; } +if test ${ac_cv_c_compiler_gnu+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_compiler_gnu=yes +else $as_nop + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+y} +ac_save_CFLAGS=$CFLAGS +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +printf %s "checking whether $CC accepts -g... " >&6; } +if test ${ac_cv_prog_cc_g+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_g=yes +else $as_nop + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +else $as_nop + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +printf "%s\n" "$ac_cv_prog_cc_g" >&6; } +if test $ac_test_CFLAGS; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +ac_prog_cc_stdc=no +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 +printf %s "checking for $CC option to enable C11 features... " >&6; } +if test ${ac_cv_prog_cc_c11+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c11=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c11_program +_ACEOF +for ac_arg in '' -std=gnu11 +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c11=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c11" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c11" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c11" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } + CC="$CC $ac_cv_prog_cc_c11" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + ac_prog_cc_stdc=c11 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 +printf %s "checking for $CC option to enable C99 features... " >&6; } +if test ${ac_cv_prog_cc_c99+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c99=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c99_program +_ACEOF +for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c99=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c99" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c99" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c99" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } + CC="$CC $ac_cv_prog_cc_c99" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + ac_prog_cc_stdc=c99 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 +printf %s "checking for $CC option to enable C89 features... " >&6; } +if test ${ac_cv_prog_cc_c89+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c89_program +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c89" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c89" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } + CC="$CC $ac_cv_prog_cc_c89" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + ac_prog_cc_stdc=c89 +fi +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +ac_header= ac_cache= +for ac_item in $ac_header_c_list +do + if test $ac_cache; then + ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default" + if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then + printf "%s\n" "#define $ac_item 1" >> confdefs.h + fi + ac_header= ac_cache= + elif test $ac_header; then + ac_cache=$ac_item + else + ac_header=$ac_item + fi +done + + + + + + + + +if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes +then : + +printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# Check whether --with-bzip2 was given. +if test ${with_bzip2+y} +then : + withval=$with_bzip2; if test "x$withval" != "xno"; then + if test "x$withval" = "xyes" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for main in -lbz2" >&5 +printf %s "checking for main in -lbz2... " >&6; } +if test ${ac_cv_lib_bz2_main+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lbz2 $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main (void) +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_bz2_main=yes +else $as_nop + ac_cv_lib_bz2_main=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bz2_main" >&5 +printf "%s\n" "$ac_cv_lib_bz2_main" >&6; } +if test "x$ac_cv_lib_bz2_main" = xyes +then : + printf "%s\n" "#define HAVE_LIBBZ2 1" >>confdefs.h + + LIBS="-lbz2 $LIBS" + +else $as_nop + as_fn_error $? "Unable to locate bz2 library needed when enabling bzip2 support; try specifying the path" "$LINENO" 5 +fi + + else + BZIP2_PATH="${withval}" + fi + for ac_header in bzlib.h +do : + ac_fn_c_check_header_compile "$LINENO" "bzlib.h" "ac_cv_header_bzlib_h" "$ac_includes_default" +if test "x$ac_cv_header_bzlib_h" = xyes +then : + printf "%s\n" "#define HAVE_BZLIB_H 1" >>confdefs.h + +printf "%s\n" "#define HAVE_BZIP2 1" >>confdefs.h + +fi + +done + fi + + +fi + + +# Optional Globus Toolkit support: + +# Check whether --with-gsiftp was given. +if test ${with_gsiftp+y} +then : + withval=$with_gsiftp; if test "x$withval" != "xno"; then + if test "x$withval" != "xyes" ; then + GSIFTP_PATH="${withval}" + fi + +printf "%s\n" "#define HAVE_GSIFTP 1" >>confdefs.h + + USE_GSIFTP=yes + fi + + +fi + +# GSIFTP source code (optional): +if test "x$USE_GSIFTP" = xyes; then + GSIFTP_SRC="drvrgsiftp.c" +else + GSIFTP_SRC="" +fi + + + +# Check whether --with-gsiftp-flavour was given. +if test ${with_gsiftp_flavour+y} +then : + withval=$with_gsiftp_flavour; if test "x$withval" != "xno"; then + if test "x$withval" != "xyes" ; then + GSIFTP_FLAVOUR="${withval}" + fi + +printf "%s\n" "#define GSIFTP_FLAVOUR 1" >>confdefs.h + + fi + + +fi + + +# Optionally disable check for zlib: +ZLIB_CHECK=yes + +# Check whether --with-zlib-check was given. +if test ${with_zlib_check+y} +then : + withval=$with_zlib_check; if test "x$withval" = "xno"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cfitsio: ZLIB is required!" >&5 +printf "%s\n" "$as_me: WARNING: cfitsio: ZLIB is required!" >&2;} + ZLIB_CHECK=no + fi + + +fi + + +#-------------------------------------------------------------------- +# Check for install location prefix +#-------------------------------------------------------------------- + + + +# make will complain about duplicate targets for the install directories +# if prefix == exec_prefix +INSTALL_ROOT='${prefix}' + +test "$exec_prefix" != NONE -a "$prefix" != "$exec_prefix" \ + && INSTALL_ROOT="$INSTALL_ROOT "'${exec_prefix}' + + +#-------------------------------------------------------------------- +# System type +#-------------------------------------------------------------------- + +case $host in + *cygwin*) + ARCH="cygwin" + EXT="cygwin" + ;; + *apple-darwin*) + # Darwin can be powerpc, i386, or x86_64 + ARCH=`uname -p` + EXT="darwin" + ;; + *freebsd*) + ARCH="linux" + EXT="lnx" + ;; + *haiku*) + # Haiku can be arm, i386, or x86_64 + ARCH=`uname -p` + EXT="haiku" + ;; + *hpux*) + ARCH="hp" + EXT="hpu" + ;; + *irix*) + ARCH="sgi" + EXT="sgi" + ;; + *linux*) + ARCH="linux" + EXT="lnx" + ;; + *mingw32*) + #ARCH="" + EXT="mingw32" + ;; + *osf1*) + ARCH="alpha" + EXT="osf" + ;; + *solaris*) + ARCH="solaris" + EXT="sol" + ;; + *ultrix*) + ARCH="dec" + EXT="dec" + ;; + *) + echo "cfitsio: == Don't know what do do with $host" + ;; +esac + + + +# Try first to find a proprietary C compiler, then gcc +if test "x$EXT" != xcygwin && test "x$EXT" != xdarwin && test "x$EXT" != xlnx && test "x$EXT" != xmingw32; then + if test "x$CC" = x; then + for ac_prog in cc +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$CC" && break +done + + fi +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. +set dummy ${ac_tool_prefix}clang; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}clang" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "clang", so it can be a program name with args. +set dummy clang; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="clang" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +fi + + +test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion -version; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 +printf %s "checking whether the compiler supports GNU C... " >&6; } +if test ${ac_cv_c_compiler_gnu+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_compiler_gnu=yes +else $as_nop + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+y} +ac_save_CFLAGS=$CFLAGS +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +printf %s "checking whether $CC accepts -g... " >&6; } +if test ${ac_cv_prog_cc_g+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_g=yes +else $as_nop + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +else $as_nop + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +printf "%s\n" "$ac_cv_prog_cc_g" >&6; } +if test $ac_test_CFLAGS; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +ac_prog_cc_stdc=no +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 +printf %s "checking for $CC option to enable C11 features... " >&6; } +if test ${ac_cv_prog_cc_c11+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c11=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c11_program +_ACEOF +for ac_arg in '' -std=gnu11 +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c11=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c11" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c11" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c11" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } + CC="$CC $ac_cv_prog_cc_c11" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + ac_prog_cc_stdc=c11 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 +printf %s "checking for $CC option to enable C99 features... " >&6; } +if test ${ac_cv_prog_cc_c99+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c99=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c99_program +_ACEOF +for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c99=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c99" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c99" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c99" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } + CC="$CC $ac_cv_prog_cc_c99" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + ac_prog_cc_stdc=c99 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 +printf %s "checking for $CC option to enable C89 features... " >&6; } +if test ${ac_cv_prog_cc_c89+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c89_program +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c89" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c89" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } + CC="$CC $ac_cv_prog_cc_c89" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + ac_prog_cc_stdc=c89 +fi +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +#------------------------------------------------------------------------------- +# Handle --enable-symbols=yes +#------------------------------------------------------------------------------- + +# Remove existing/default optimization: +if test "x$SYMBOLS" = "xyes"; then + + COPT_DEFAULT=`echo $CFLAGS | tr " " "\012" | grep "^\-O[0-9]"` + + CFLAGS=`echo $CFLAGS | sed "s:$COPT_DEFAULT::g"` +fi + +#------------------------------------------------------------------------------- + +LDFLAGS="$CFLAGS" +LDFLAGS_BIN="$LDFLAGS" + +if test "x$FC" = "xnone" ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: cfitsio: == Fortran compiler search has been overridden" >&5 +printf "%s\n" "$as_me: cfitsio: == Fortran compiler search has been overridden" >&6;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: cfitsio: == Cfitsio will be built without Fortran wrapper support" >&5 +printf "%s\n" "$as_me: cfitsio: == Cfitsio will be built without Fortran wrapper support" >&6;} + FC= + F77_WRAPPERS= +else + for ac_prog in gfortran g95 g77 f77 ifort f95 f90 xlf cf77 gf77 af77 ncf f2c +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_FC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$FC"; then + ac_cv_prog_FC="$FC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_FC="$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +FC=$ac_cv_prog_FC +if test -n "$FC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $FC" >&5 +printf "%s\n" "$FC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$FC" && break +done +test -n "$FC" || FC="notfound" + + if test $FC = 'notfound' ; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cfitsio: == No acceptable Fortran compiler found in \$PATH" >&5 +printf "%s\n" "$as_me: WARNING: cfitsio: == No acceptable Fortran compiler found in \$PATH" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: cfitsio: == Adding wrapper support for GNU Fortran by default" >&5 +printf "%s\n" "$as_me: cfitsio: == Adding wrapper support for GNU Fortran by default" >&6;} + CFORTRANFLAGS="-Dg77Fortran" + F77_WRAPPERS="\${FITSIO_SRC}" + else + CFORTRANFLAGS= + F77_WRAPPERS="\${FITSIO_SRC}" + echo $ac_n "checking whether we are using GNU Fortran""... $ac_c" 1>&6 + if test `$FC --version -c < /dev/null 2> /dev/null | grep -c GNU` -gt 0 -o \ + `$FC --version -c < /dev/null 2> /dev/null | grep -ic egcs` -gt 0 + then + echo "$ac_t""yes" 1>&6 + echo $ac_n "cfitsio: == Adding wrapper support for GNU Fortran""... $ac_c" 1>&6 + CFORTRANFLAGS="-Dg77Fortran" + echo "$ac_t"" done" 1>&6 + else + echo "$ac_t""no" 1>&6 + if test $FC = 'f2c' ; then + echo $ac_n "cfitsio: == Adding wrapper support for f2c""... $ac_c" 1>&6 + CFORTRANFLAGS="-Df2cFortran" + echo "$ac_t"" done" 1>&6 + fi + fi + fi +fi + +# ar & ranlib required +#--------------------- +# Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_AR+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="ar" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_AR" && ac_cv_prog_AR="noar" +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +printf "%s\n" "$AR" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +if test $AR = noar; then + as_fn_error $? "ar not found in your \$PATH. See your sysdamin." "$LINENO" 5 +fi +ARCHIVE="$AR rv" + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_RANLIB+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +printf "%s\n" "$RANLIB" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_RANLIB+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +printf "%s\n" "$ac_ct_RANLIB" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + + + for ac_header in stdlib.h string.h math.h limits.h +do : + as_ac_Header=`printf "%s\n" "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes" +then : + cat >>confdefs.h <<_ACEOF +#define `printf "%s\n" "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + ANSI_HEADER=yes +else $as_nop + ANSI_HEADER=no +fi + +done +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ +void d( int , double) + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + PROTO=yes +else $as_nop + PROTO=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +if test $ANSI_HEADER = no -o $PROTO = no; then + echo " *********** WARNING: CFITSIO CONFIGURE FAILURE ************ " + echo "cfitsio: ANSI C environment NOT found. Aborting cfitsio configure." + if test $ANSI_HEADER = no; then + echo "cfitsio: You're missing a needed ANSI header file." + fi + if test $PROTO = no; then + echo "cfitsio: Your compiler can't do ANSI function prototypes." + fi + echo "cfitsio: You need an ANSI C compiler and all ANSI trappings" + echo "cfitsio: to build cfitsio. " + echo " ******************************************************* " + exit 0; +fi + +if test "x$SSE_FLAGS" != x; then + SAVE_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS $SSE_FLAGS" + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts $SSE_FLAGS" >&5 +printf %s "checking whether $CC accepts $SSE_FLAGS... " >&6; } + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + c_has_option=yes +else $as_nop + c_has_option=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $c_has_option" >&5 +printf "%s\n" "$c_has_option" >&6; } + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + if test "$c_has_option" = no; then SSE_FLAGS=""; fi + CFLAGS="$SAVE_CFLAGS" +fi + + +CFLAGS="$CFLAGS" +LIBPRE="" + +case $host in + *cygwin*) + CFLAGS="$CFLAGS -DHAVE_POSIX_SIGNALS" + # LDFLAGS used by utilities: + LDFLAGS_BIN="$LDFLAGS_BIN -Wl,-rpath,\${CFITSIO_LIB}" + ;; + *apple-darwin*) + + case $host in + *darwin[56789]*) + ;; + *) + +# # Build for i386 & x86_64 architectures on Darwin 10.x or newer: +# echo "int main(){return(0);}" > /tmp/$$.c +# $CC -v -o /tmp/$$.out /tmp/$$.c 2> /tmp/$$.log +# if test `cat /tmp/$$.log | grep -ci 'LLVM'` -ne 0; then APPLEXCODE="yes"; fi +# if test "x$APPLEXCODE" = xyes; then +# # Flags for building Universal binaries: +# C_UNIV_SWITCH="-arch i386 -arch x86_64" +# CFLAGS="$CFLAGS $C_UNIV_SWITCH" +# fi + # LDFLAGS used by utilities: + LDFLAGS_BIN="$LDFLAGS_BIN -Wl,-rpath,\${CFITSIO_LIB}" + ;; + esac + # For large file support (but may break Absoft compilers): + printf "%s\n" "#define _LARGEFILE_SOURCE 1" >>confdefs.h + + printf "%s\n" "#define _FILE_OFFSET_BITS 64" >>confdefs.h + + ;; + *haiku*) + # For large file support: + printf "%s\n" "#define _LARGEFILE_SOURCE 1" >>confdefs.h + + printf "%s\n" "#define _FILE_OFFSET_BITS 64" >>confdefs.h + + ;; + *hpux*) + if test "x$CFORTRANFLAGS" = x ; then + CFORTRANFLAGS="-Dappendus" + fi + CFLAGS="$CFLAGS -DPG_PPU" + LIBPRE="-Wl," + ;; + *irix*) + CFLAGS="$CFLAGS -DHAVE_POSIX_SIGNALS" + RANLIB="touch" + ;; + *linux*) + # For large file support: + printf "%s\n" "#define _LARGEFILE_SOURCE 1" >>confdefs.h + + printf "%s\n" "#define _FILE_OFFSET_BITS 64" >>confdefs.h + + # LDFLAGS used by utilities: + LDFLAGS_BIN="$LDFLAGS_BIN -Wl,-rpath,\${CFITSIO_LIB}" + ;; + *mingw32*) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for large file support" >&5 +printf %s "checking for large file support... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main (void) +{ +_FILE_OFFSET_BITS_SET_FSEEKO + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + + printf "%s\n" "#define _LARGEFILE_SOURCE 1" >>confdefs.h + + printf "%s\n" "#define _FILE_OFFSET_BITS 64" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + ;; + *solaris*) + if test "x$CFORTRANFLAGS" = x ; then + CFORTRANFLAGS="-Dsolaris" + fi + # We need libm on Solaris: + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for frexp in -lm" >&5 +printf %s "checking for frexp in -lm... " >&6; } +if test ${ac_cv_lib_m_frexp+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char frexp (); +int +main (void) +{ +return frexp (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_m_frexp=yes +else $as_nop + ac_cv_lib_m_frexp=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_frexp" >&5 +printf "%s\n" "$ac_cv_lib_m_frexp" >&6; } +if test "x$ac_cv_lib_m_frexp" = xyes +then : + printf "%s\n" "#define HAVE_LIBM 1" >>confdefs.h + + LIBS="-lm $LIBS" + +fi + + # For large file support: + printf "%s\n" "#define _LARGEFILE_SOURCE 1" >>confdefs.h + + printf "%s\n" "#define _FILE_OFFSET_BITS 64" >>confdefs.h + + ;; + *) + echo "cfitsio: == Don't know what do do with $host" + ;; +esac + +CFLAGS="$CFLAGS $CFORTRANFLAGS" + +case $GCC in + yes) + GCCVERSION="`$CC -dumpversion 2>&1`" + echo "cfitsio: == Using gcc version $GCCVERSION" + + + gcc_test=`echo $GCCVERSION | grep -c '2\.[45678]'` + + if test $gcc_test -gt 0 + then + + CFLAGS=`echo $CFLAGS | sed 's:-O[^ ]* *::'` + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: This gcc is pretty old. Disabling optimization to be safe." >&5 +printf "%s\n" "$as_me: WARNING: This gcc is pretty old. Disabling optimization to be safe." >&2;} + fi + ;; + no) + echo "cfitsio: Old CFLAGS is $CFLAGS" + CFLAGS=`echo $CFLAGS | sed -e "s/-g/-O/"` + case $host in + *solaris*) + + if test `echo $CFLAGS | grep -c fast` -gt 0 + then + echo "cfitsio: Replacing -fast with -O3" + CFLAGS=`echo $CFLAGS | sed 's:-fast:-O3:'` + fi + + CFLAGS="$CFLAGS -DHAVE_ALLOCA_H -DHAVE_POSIX_SIGNALS" + ;; + *) + echo "== No special changes for $host" + ;; + esac + echo "New CFLAGS is $CFLAGS" + ;; + *) + # Don't do anything now + ;; +esac + +# Shared library section +#------------------------------------------------------------------------------- +SHLIB_LD=: +SHLIB_SUFFIX=".so" +CFITSIO_SHLIB="" +CFITSIO_SHLIB_SONAME="" +lhea_shlib_cflags= +case $EXT in + cygwin|mingw32) + SHLIB_LD="$CC -shared" + SHLIB_SUFFIX=".dll" + ;; + darwin) + + SHLIB_SUFFIX=".dylib" + CFITSIO_SHLIB="lib\${PACKAGE}.\${CFITSIO_SONAME}.\${CFITSIO_MAJOR}.\${CFITSIO_MINOR}.\${CFITSIO_MICRO}\${SHLIB_SUFFIX}" + CFITSIO_SHLIB_SONAME="lib\${PACKAGE}.\${CFITSIO_SONAME}\${SHLIB_SUFFIX}" + case $host in + *darwin[56789]*) + SHLIB_LD="$CC -dynamiclib -install_name lib\${PACKAGE}.\${CFITSIO_SONAME}\${SHLIB_SUFFIX} -compatibility_version \${CFITSIO_SONAME} -current_version \${CFITSIO_SONAME}.\${CFITSIO_MAJOR}.\${CFITSIO_MINOR}.\${CFITSIO_MICRO}" + ;; + *) + # Build 'Universal' binaries (i386 & x86_64 architectures) and + # use rpath token on Darwin 10.x or newer: + SHLIB_LD="$CC -dynamiclib $C_UNIV_SWITCH -headerpad_max_install_names -install_name @rpath/lib\${PACKAGE}.\${CFITSIO_SONAME}\${SHLIB_SUFFIX} -compatibility_version \${CFITSIO_SONAME} -current_version \${CFITSIO_SONAME}.\${CFITSIO_MAJOR}.\${CFITSIO_MINOR}.\${CFITSIO_MICRO}" + ;; + esac + + lhea_shlib_cflags="-fPIC -fno-common" + ;; + haiku) + SHLIB_LD=":" + CFITSIO_SHLIB="lib\${PACKAGE}\${SHLIB_SUFFIX}.\${CFITSIO_SONAME}.\${CFITSIO_MAJOR}.\${CFITSIO_MINOR}.\${CFITSIO_MICRO}" + CFITSIO_SHLIB_SONAME="lib\${PACKAGE}\${SHLIB_SUFFIX}.\${CFITSIO_SONAME}" + ;; + hpu) + SHLIB_LD="ld -b" + SHLIB_SUFFIX=".sl" + ;; + lnx) + SHLIB_LD=":" + CFITSIO_SHLIB="lib\${PACKAGE}\${SHLIB_SUFFIX}.\${CFITSIO_SONAME}.\${CFITSIO_MAJOR}.\${CFITSIO_MINOR}.\${CFITSIO_MICRO}" + CFITSIO_SHLIB_SONAME="lib\${PACKAGE}\${SHLIB_SUFFIX}.\${CFITSIO_SONAME}" + ;; + osf) + SHLIB_LD="ld -shared -expect_unresolved '*'" + LD_FLAGS="-taso" + ;; + sol) + SHLIB_LD="/usr/ccs/bin/ld -G" + lhea_shlib_cflags="-KPIC" + ;; + sgi) + SHLIB_LD="ld -shared -rdata_shared" + ;; + *) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Unable to determine how to make a shared library" >&5 +printf "%s\n" "$as_me: WARNING: Unable to determine how to make a shared library" >&2;} + ;; +esac +# Darwin uses gcc (=cc), but needs different flags (see above) +if test "x$EXT" != xdarwin && test "x$EXT" != xcygwin && test "x$EXT" != xmingw32; then + if test "x$GCC" = xyes; then + SHLIB_LD="$CC -shared -Wl,-soname,lib\${PACKAGE}\${SHLIB_SUFFIX}.\${CFITSIO_SONAME}" + lhea_shlib_cflags='-fPIC' + fi +fi +if test "x$lhea_shlib_cflags" != x; then + CFLAGS="$CFLAGS $lhea_shlib_cflags" +fi +# Set shared library name for cases in which we aren't setting a 'soname': +if test "x$CFITSIO_SHLIB" = x; then CFITSIO_SHLIB="lib\${PACKAGE}\${SHLIB_SUFFIX}"; fi + +# Curl library (will be pulled in to the shared CFITSIO library): +# --------------------------------------------------------------- +CURL_INC="" +CURL_LIB="" +CURL_LIB_PATH="" +if test "x$ADD_CURL" = xyes; then + # Use curl-config to get compiler & linker flags, if available. + # Extract the first word of "curl-config", so it can be a program name with args. +set dummy curl-config; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CURLCONFIG+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CURLCONFIG"; then + ac_cv_prog_CURLCONFIG="$CURLCONFIG" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CURLCONFIG="curl-config" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CURLCONFIG=$ac_cv_prog_CURLCONFIG +if test -n "$CURLCONFIG"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CURLCONFIG" >&5 +printf "%s\n" "$CURLCONFIG" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + if test "x$CURLCONFIG" != x; then + CURL_LIB=`$CURLCONFIG --libs` + CURL_INC=`$CURLCONFIG --cflags` + if test "x$CURL_LIB" != x; then + LIBS_CURL="$CURL_LIB" + # Mac OS: For third-party curl-config, acquire an rpath: + if test `echo $host | grep -c apple-darwin` -ne 0 -a `echo $CURL_LIB | grep -c "^\-L"` -gt 0; then + CURL_LIB_PATH=`echo ${CURL_LIB} | tr " " "\012" | grep "^\-L" | tr "\012" " " | sed 's:-L::' | sed 's: $::'` + if test "x$CURL_LIB_PATH" != x; then + LIBS_CURL="-Wl,-rpath,$CURL_LIB_PATH $CURL_LIB" + fi + fi + if test `echo $host | grep -c cygwin` -ne 0 -o `echo $host | grep -c mingw32` -ne 0; then + LIBS="$CURL_LIB $LIBS" + fi + printf "%s\n" "#define CFITSIO_HAVE_CURL 1" >>confdefs.h + + fi + if test "x$CURL_INC" != x; then + CFLAGS="$CURL_INC $CFLAGS" + fi + # No curl-config: + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: curl-config not found. Disabling curl support." >&5 +printf "%s\n" "$as_me: WARNING: curl-config not found. Disabling curl support." >&2;} + # Incomplete stubs for possible future use: + # AC_CHECK_LIB([curl],[main],[], + # [AC_MSG_WARN(Not building curl support for CFITSIO)]) + # AC_CHECK_HEADER(curl.h,[]) + fi +fi + + +# ZLIB (required): +if test "x$ZLIB_CHECK" = xyes; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for inflateEnd in -lz" >&5 +printf %s "checking for inflateEnd in -lz... " >&6; } +if test ${ac_cv_lib_z_inflateEnd+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lz $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char inflateEnd (); +int +main (void) +{ +return inflateEnd (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_z_inflateEnd=yes +else $as_nop + ac_cv_lib_z_inflateEnd=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_z_inflateEnd" >&5 +printf "%s\n" "$ac_cv_lib_z_inflateEnd" >&6; } +if test "x$ac_cv_lib_z_inflateEnd" = xyes +then : + printf "%s\n" "#define HAVE_LIBZ 1" >>confdefs.h + + LIBS="-lz $LIBS" + +else $as_nop + as_fn_error $? "Unable to locate zlib compression library" "$LINENO" 5 +fi + +fi + +# GSIFTP flags: +if test "x$GSIFTP_PATH" != x -a "x$GSIFTP_FLAVOUR" != x; then + CFLAGS="$CFLAGS -I${GSIFTP_PATH}/include/${GSIFTP_FLAVOUR}" + LIBS="$LIBS -L${GSIFTP_PATH}/lib -lglobus_ftp_client_${GSIFTP_FLAVOUR}" +fi + +# BZIP2 flags: +if test "x$BZIP2_PATH" != x; then + CFLAGS="$CFLAGS -I${BZIP2_PATH}/include" + LIBS="$LIBS -L${BZIP2_PATH}/lib -lbz2" +fi + + + + +# ================= test for the unix ftruncate function ================ + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether ftruncate works" >&5 +printf %s "checking whether ftruncate works... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main (void) +{ + +ftruncate(0, 0); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + +printf "%s\n" "#define HAVE_FTRUNCATE 1" >>confdefs.h + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext + +# --------------------------------------------------------- +# some systems define long long for 64-bit ints +# --------------------------------------------------------- + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether long long is defined" >&5 +printf %s "checking whether long long is defined... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main (void) +{ + +long long filler; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define HAVE_LONGLONG 1" >>confdefs.h + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + +# ==================== SHARED MEMORY DRIVER SECTION ======================= +# +# 09-Mar-98 : modified by JB/ISDC +# 3 checks added to support autoconfiguration of shared memory +# driver. First generic check is made whether shared memory is supported +# at all, then 2 more specific checks are made (architecture dependent). +# Currently tested on : sparc-solaris, intel-linux, sgi-irix, dec-alpha-osf + +# ------------------------------------------------------------------------- +# check is System V IPC is supported on this machine +# ------------------------------------------------------------------------- + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether system V style IPC services are supported" >&5 +printf %s "checking whether system V style IPC services are supported... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include + +int +main (void) +{ + +shmat(0, 0, 0); +shmdt(0); +shmget(0, 0, 0); +semget(0, 0, 0); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + +printf "%s\n" "#define HAVE_SHMEM_SERVICES 1" >>confdefs.h + +my_shmem=\${SOURCES_SHMEM} +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext + + + +# ------------------------------------------------------------------------- +# some systems define flock_t, for others we have to define it ourselves +# ------------------------------------------------------------------------- + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether flock_t is defined in sys/fcntl.h" >&5 +printf %s "checking whether flock_t is defined in sys/fcntl.h... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main (void) +{ + +flock_t filler; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define HAVE_FLOCK_T 1" >>confdefs.h + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + +if test "$HAVE_FLOCK_T" != 1; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether flock_t is defined in sys/flock.h" >&5 +printf %s "checking whether flock_t is defined in sys/flock.h... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main (void) +{ + + flock_t filler; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + + printf "%s\n" "#define HAVE_FLOCK_T 1" >>confdefs.h + + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +# ------------------------------------------------------------------------------ +# Define _REENTRANT & add -lpthread to LIBS if reentrant multithreading enabled: +# ------------------------------------------------------------------------------ +if test "x$BUILD_REENTRANT" = xyes; then + printf "%s\n" "#define _REENTRANT 1" >>confdefs.h + + printf "%s\n" "#define _XOPEN_SOURCE 700" >>confdefs.h + + # Additional definition needed to get 'union semun' when using + # _XOPEN_SOURCE on a Mac: + if test "x$EXT" = xdarwin; then + printf "%s\n" "#define _DARWIN_C_SOURCE 1" >>confdefs.h + + fi + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for main in -lpthread" >&5 +printf %s "checking for main in -lpthread... " >&6; } +if test ${ac_cv_lib_pthread_main+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main (void) +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO" +then : + ac_cv_lib_pthread_main=yes +else $as_nop + ac_cv_lib_pthread_main=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_main" >&5 +printf "%s\n" "$ac_cv_lib_pthread_main" >&6; } +if test "x$ac_cv_lib_pthread_main" = xyes +then : + printf "%s\n" "#define HAVE_LIBPTHREAD 1" >>confdefs.h + + LIBS="-lpthread $LIBS" + +else $as_nop + as_fn_error $? "Unable to locate pthread library needed when enabling reentrant multithreading" "$LINENO" 5 +fi + +fi + +# ------------------------------------------------------------------------- +# there are some idiosyncrasies with semun defs (used in semxxx). Solaris +# does not define it at all +# ------------------------------------------------------------------------- + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether union semun is defined" >&5 +printf %s "checking whether union semun is defined... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include + +int +main (void) +{ + +union semun filler; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +printf "%s\n" "#define HAVE_UNION_SEMUN 1" >>confdefs.h + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + +# ------------------------------------------------------------------------- +# fmemopen is not available on e.g. older Macs: +# ------------------------------------------------------------------------- + +ac_fn_c_check_func "$LINENO" "fmemopen" "ac_cv_func_fmemopen" +if test "x$ac_cv_func_fmemopen" = xyes +then : + printf "%s\n" "#define HAVE_FMEMOPEN 1" >>confdefs.h + +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Disabling support for compressed files via FTPS" >&5 +printf "%s\n" "$as_me: WARNING: Disabling support for compressed files via FTPS" >&2;} +fi + + +# ==================== END OF SHARED MEMORY DRIVER SECTION ================ +# ================= test for the unix networking functions ================ + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing gethostbyname" >&5 +printf %s "checking for library containing gethostbyname... " >&6; } +if test ${ac_cv_search_gethostbyname+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char gethostbyname (); +int +main (void) +{ +return gethostbyname (); + ; + return 0; +} +_ACEOF +for ac_lib in '' nsl network +do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO" +then : + ac_cv_search_gethostbyname=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext + if test ${ac_cv_search_gethostbyname+y} +then : + break +fi +done +if test ${ac_cv_search_gethostbyname+y} +then : + +else $as_nop + ac_cv_search_gethostbyname=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_gethostbyname" >&5 +printf "%s\n" "$ac_cv_search_gethostbyname" >&6; } +ac_res=$ac_cv_search_gethostbyname +if test "$ac_res" != no +then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + cfitsio_have_nsl=1 +else $as_nop + cfitsio_have_nsl=0 +fi + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing connect" >&5 +printf %s "checking for library containing connect... " >&6; } +if test ${ac_cv_search_connect+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +char connect (); +int +main (void) +{ +return connect (); + ; + return 0; +} +_ACEOF +for ac_lib in '' socket network +do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib -lnsl $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO" +then : + ac_cv_search_connect=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext + if test ${ac_cv_search_connect+y} +then : + break +fi +done +if test ${ac_cv_search_connect+y} +then : + +else $as_nop + ac_cv_search_connect=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_connect" >&5 +printf "%s\n" "$ac_cv_search_connect" >&6; } +ac_res=$ac_cv_search_connect +if test "$ac_res" != no +then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + cfitsio_have_socket=1 +else $as_nop + cfitsio_have_socket=0 +fi + + +if test "$cfitsio_have_nsl" = 1 -a "$cfitsio_have_socket" = 1; then + printf "%s\n" "#define HAVE_NET_SERVICES 1" >>confdefs.h + +fi + +# ==================== END OF unix networking SECTION ================ + +ac_config_files="$ac_config_files Makefile" + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +printf "%s\n" "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` + + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +as_nop=: +if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else $as_nop + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + + +# Reset variables that may have inherited troublesome values from +# the environment. + +# IFS needs to be set, to space, tab, and newline, in precisely that order. +# (If _AS_PATH_WALK were called with IFS unset, it would have the +# side effect of setting IFS to empty, thus disabling word splitting.) +# Quoting is to prevent editors from complaining about space-tab. +as_nl=' +' +export as_nl +IFS=" "" $as_nl" + +PS1='$ ' +PS2='> ' +PS4='+ ' + +# Ensure predictable behavior from utilities with locale-dependent output. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# We cannot yet rely on "unset" to work, but we need these variables +# to be unset--not just set to an empty or harmless value--now, to +# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct +# also avoids known problems related to "unset" and subshell syntax +# in other old shells (e.g. bash 2.01 and pdksh 5.2.14). +for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH +do eval test \${$as_var+y} \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done + +# Ensure that fds 0, 1, and 2 are open. +if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi +if (exec 3>&2) ; then :; else exec 2>/dev/null; fi + +# The user is always right. +if ${PATH_SEPARATOR+false} :; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + test -r "$as_dir$0" && as_myself=$as_dir$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + printf "%s\n" "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null +then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else $as_nop + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null +then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else $as_nop + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + +# Determine whether it's possible to make 'echo' print without a newline. +# These variables are no longer used directly by Autoconf, but are AC_SUBSTed +# for compatibility with existing Makefiles. +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +# For backward compatibility with old third-party macros, we provide +# the shell variables $as_echo and $as_echo_n. New code should use +# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. +as_echo='printf %s\n' +as_echo_n='printf %s' + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by $as_me, which was +generated by GNU Autoconf 2.71. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to the package provider." + +_ACEOF +ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` +ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config='$ac_cs_config_escaped' +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.71, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2021 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + printf "%s\n" "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + printf "%s\n" "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + printf "%s\n" "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + printf "%s\n" "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +printf "%s\n" "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`printf "%s\n" "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + +ac_config_files="$ac_config_files cfitsio.pc" + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +printf "%s\n" "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` + + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +as_nop=: +if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else $as_nop + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + + +# Reset variables that may have inherited troublesome values from +# the environment. + +# IFS needs to be set, to space, tab, and newline, in precisely that order. +# (If _AS_PATH_WALK were called with IFS unset, it would have the +# side effect of setting IFS to empty, thus disabling word splitting.) +# Quoting is to prevent editors from complaining about space-tab. +as_nl=' +' +export as_nl +IFS=" "" $as_nl" + +PS1='$ ' +PS2='> ' +PS4='+ ' + +# Ensure predictable behavior from utilities with locale-dependent output. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# We cannot yet rely on "unset" to work, but we need these variables +# to be unset--not just set to an empty or harmless value--now, to +# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct +# also avoids known problems related to "unset" and subshell syntax +# in other old shells (e.g. bash 2.01 and pdksh 5.2.14). +for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH +do eval test \${$as_var+y} \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done + +# Ensure that fds 0, 1, and 2 are open. +if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi +if (exec 3>&2) ; then :; else exec 2>/dev/null; fi + +# The user is always right. +if ${PATH_SEPARATOR+false} :; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + test -r "$as_dir$0" && as_myself=$as_dir$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + printf "%s\n" "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null +then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else $as_nop + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null +then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else $as_nop + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + +# Determine whether it's possible to make 'echo' print without a newline. +# These variables are no longer used directly by Autoconf, but are AC_SUBSTed +# for compatibility with existing Makefiles. +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +# For backward compatibility with old third-party macros, we provide +# the shell variables $as_echo and $as_echo_n. New code should use +# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. +as_echo='printf %s\n' +as_echo_n='printf %s' + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by $as_me, which was +generated by GNU Autoconf 2.71. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to the package provider." + +_ACEOF +ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` +ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config='$ac_cs_config_escaped' +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.71, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2021 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + printf "%s\n" "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + printf "%s\n" "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + printf "%s\n" "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + printf "%s\n" "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "cfitsio.pc") CONFIG_FILES="$CONFIG_FILES cfitsio.pc" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +printf "%s\n" "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`printf "%s\n" "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: " >&5 +printf "%s\n" "" >&6; } +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: Congratulations, Makefile update was successful." >&5 +printf "%s\n" " Congratulations, Makefile update was successful." >&6; } +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: You may want to run make now." >&5 +printf "%s\n" " You may want to run make now." >&6; } +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: " >&5 +printf "%s\n" "" >&6; } + + diff --git a/vendor/cfitsio/drvrfile.c b/vendor/cfitsio/drvrfile.c new file mode 100644 index 000000000..a9f022311 --- /dev/null +++ b/vendor/cfitsio/drvrfile.c @@ -0,0 +1,1004 @@ +/* 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 +#include +#include "fitsio2.h" +#include "group.h" /* needed for fits_get_cwd in file_create */ + +#if defined(unix) || defined(__unix__) || defined(__unix) +#include /* needed in file_openfile */ + +#ifdef REPLACE_LINKS +#include +#include +#endif + +#endif + +#ifdef HAVE_FTRUNCATE +#if defined(unix) || defined(__unix__) || defined(__unix) || defined(HAVE_UNISTD_H) +#include /* 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]; + + int status = 0, rootlen, rootlen2, slen; + char *cptr, *cpos; + char cwd[FLEN_FILENAME], absURL[FLEN_FILENAME]; + char rootstring[256], rootstring2[256]; + char username[FLEN_FILENAME], userroot[FLEN_FILENAME], userroot2[FLEN_FILENAME]; + + cptr = getenv("HERA_DATA_DIRECTORY"); + if (cptr) { + /* This environment variable is defined in the Hera data analysis environment. */ + /* It specifies the root directory path to the users data directories. */ + /* CFITSIO will verify that the path to the file that is to be created */ + /* is within this root directory + the user's home directory name. */ + +/* +printf("env = %s\n",cptr); +*/ + if (strlen(cptr) > 200) /* guard against possible string overflows */ + return(FILE_NOT_CREATED); + + /* environment variable has the form "path/one/;/path/two/" where the */ + /* second path is optional */ + + strcpy(rootstring, cptr); + cpos = strchr(rootstring, ';'); + if (cpos) { + *cpos = '\0'; + cpos++; + strcpy(rootstring2, cpos); + } else { + *rootstring2 = '\0'; + } +/* +printf("%s, %s\n", rootstring, rootstring2); +printf("CWD = %s\n", cwd); +printf("rootstring=%s, cwd=%s.\n", rootstring, cwd); +*/ + /* Get the current working directory */ + fits_get_cwd(cwd, &status); + slen = strlen(cwd); + if ((slen < FLEN_FILENAME) && cwd[slen-1] != '/') strcat(cwd,"/"); /* make sure the CWD ends with slash */ + + + /* check that CWD string matches the rootstring */ + rootlen = strlen(rootstring); + if (strncmp(rootstring, cwd, rootlen)) { + ffpmsg("invalid CWD: does not match root data directory"); + return(FILE_NOT_CREATED); + } else { + + /* get the user name from CWD (it follows the root string) */ + strncpy(username, cwd+rootlen, 50); /* limit length of user name */ + username[50]=0; + cpos=strchr(username, '/'); + if (!cpos) { + ffpmsg("invalid CWD: not equal to root data directory + username"); + return(FILE_NOT_CREATED); + } else { + *(cpos+1) = '\0'; /* truncate user name string */ + + /* construct full user root name */ + strcpy(userroot, rootstring); + strcat(userroot, username); + rootlen = strlen(userroot); + + /* construct alternate full user root name */ + strcpy(userroot2, rootstring2); + strcat(userroot2, username); + rootlen2 = strlen(userroot2); + + /* convert the input filename to absolute path relative to the CWD */ + fits_relurl2url(cwd, filename, absURL, &status); + +/* +printf("username = %s\n", username); +printf("userroot = %s\n", userroot); +printf("userroot2 = %s\n", userroot2); +printf("filename = %s\n", filename); +printf("ABS = %s\n", absURL); +*/ + /* check that CWD string matches the rootstring or alternate root string */ + + if ( strncmp(userroot, absURL, rootlen) && + strncmp(userroot2, absURL, rootlen2) ) { + ffpmsg("invalid filename: path not within user directory"); + return(FILE_NOT_CREATED); + } + } + } + /* if we got here, then the input filename appears to be valid */ + } + + *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 - 5) + return(0); + + strcpy(tmpfilename,filename); + strcat(filename,".gz"); + if (file_openfile(filename, 0, &diskfile)) + { +#if HAVE_BZIP2 + strcpy(filename,tmpfilename); + strcat(filename,".bz2"); + if (file_openfile(filename, 0, &diskfile)) + { +#endif + 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 HAVE_BZIP2 + } +#endif + } + } + + 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 */ +#if HAVE_BZIP2 + (memcmp(buffer, "BZ", 2) == 0) || /* BZip2 */ +#endif + (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/vendor/cfitsio/drvrmem.c b/vendor/cfitsio/drvrmem.c new file mode 100644 index 000000000..075e6ea78 --- /dev/null +++ b/vendor/cfitsio/drvrmem.c @@ -0,0 +1,1332 @@ +/* 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 +#include +#include /* apparently needed to define size_t */ +#include "fitsio2.h" + +#if HAVE_BZIP2 +#include "bzlib.h" +#endif + +/* 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); + +#if HAVE_BZIP2 +/* prototype for .bz2 uncompression function (in this file) */ +void bzip2uncompress2mem(char *filename, FILE *diskfile, int hdl, + size_t* filesize, int* status); +#endif + + +#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, filesize; + LONGLONG llsize = 0; + unsigned int modulosize; + 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 in the ISIZE field (modulo 2^32) */ + + fseek(diskfile, 0, 2); /* move to end of file */ + filesize = ftell(diskfile); /* position = size 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 */ + modulosize = buffer[0]; + modulosize |= buffer[1] << 8; + modulosize |= buffer[2] << 16; + modulosize |= buffer[3] << 24; + +/* + the field ISIZE in the gzipped file header only stores 4 bytes and contains + the uncompressed file size modulo 2^32. If the uncompressed file size + is less than the compressed file size (filesize), then one probably needs to + add 2^32 = 4294967296 to the uncompressed file size, assuming that the gzip + produces a compressed file that is smaller than the original file. + + But one must allow for the case of very small files, where the + gzipped file may actually be larger then the original uncompressed file. + Therefore, only perform the modulo 2^32 correction test if the compressed + file is greater than 10,000 bytes in size. (Note: this threhold would + fail only if the original file was greater than 2^32 bytes in size AND gzip + was able to compress it by more than a factor of 400,000 (!) which seems + highly unlikely.) + + Also, obviously, this 2^32 modulo correction cannot be performed if the + finalsize variable is only 32-bits long. Typically, the 'size_t' integer + type must be 8 bytes or larger in size to support data files that are + greater than 2 GB (2^31 bytes) in size. +*/ + finalsize = modulosize; + + if (sizeof(size_t) > 4 && filesize > 10000) { + llsize = (LONGLONG) finalsize; + /* use LONGLONG variable to suppress compiler warning */ + while (llsize < (LONGLONG) filesize) llsize += 4294967296; + + finalsize = (size_t) llsize; + } + + 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 */ + modulosize = buffer[0]; + modulosize |= buffer[1] << 8; + modulosize |= buffer[2] << 16; + modulosize |= buffer[3] << 24; + finalsize = modulosize; + + 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 */ +#if HAVE_BZIP2 + else if (memcmp(buffer, "BZ", 2) == 0) /* BZip2 */ + finalsize = 0; /* for most methods we can't determine final size */ +#endif + 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*/ +#if HAVE_BZIP2 + } else if (strstr(filename, ".bz2")) { + bzip2uncompress2mem(filename, diskfile, hdl, &finalsize, &status); +#endif + } 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); +} + +/*--------------------------------------------------------------------------*/ +int mem_zuncompress_and_write(int hdl, void *buffer, long nbytes) +/* + uncompress input buffer, length nbytes and write bytes to current + position in file. output buffer needs to be at position 0 to start. +*/ +{ + size_t newsize; + int status = 0; + + if (memTable[hdl].currentpos != 0) { + ffpmsg("cannot append uncompressed data (mem_uncompress_and_write)"); + return(WRITE_ERROR); + } + + uncompress2mem_from_mem(buffer, nbytes, + memTable[hdl].memaddrptr, + memTable[hdl].memsizeptr, + memTable[hdl].mem_realloc, + &newsize, &status); + + if (status) { + ffpmsg("unabled to uncompress memory file (mem_uncompress_and_write)"); + return(WRITE_ERROR); + } + + memTable[hdl].currentpos += newsize; + memTable[hdl].fitsfilesize = newsize; + return(0); +} + + +#if HAVE_BZIP2 +void bzip2uncompress2mem(char *filename, FILE *diskfile, int hdl, + size_t* filesize, int* status) { + BZFILE* b; + int bzerror; + char buf[8192]; + size_t total_read = 0; + char* errormsg = NULL; + + *filesize = 0; + *status = 0; + b = BZ2_bzReadOpen(&bzerror, diskfile, 0, 0, NULL, 0); + if (bzerror != BZ_OK) { + BZ2_bzReadClose(&bzerror, b); + if (bzerror == BZ_MEM_ERROR) + ffpmsg("failed to open a bzip2 file: out of memory\n"); + else if (bzerror == BZ_CONFIG_ERROR) + ffpmsg("failed to open a bzip2 file: miscompiled bzip2 library\n"); + else if (bzerror == BZ_IO_ERROR) + ffpmsg("failed to open a bzip2 file: I/O error"); + else + ffpmsg("failed to open a bzip2 file"); + *status = READ_ERROR; + return; + } + bzerror = BZ_OK; + while (bzerror == BZ_OK) { + int nread; + nread = BZ2_bzRead(&bzerror, b, buf, sizeof(buf)); + if (bzerror == BZ_OK || bzerror == BZ_STREAM_END) { + *status = mem_write(hdl, buf, nread); + if (*status) { + BZ2_bzReadClose(&bzerror, b); + if (*status == MEMORY_ALLOCATION) + ffpmsg("Failed to reallocate memory while uncompressing bzip2 file"); + return; + } + total_read += nread; + } else { + if (bzerror == BZ_IO_ERROR) + errormsg = "failed to read bzip2 file: I/O error"; + else if (bzerror == BZ_UNEXPECTED_EOF) + errormsg = "failed to read bzip2 file: unexpected end-of-file"; + else if (bzerror == BZ_DATA_ERROR) + errormsg = "failed to read bzip2 file: data integrity error"; + else if (bzerror == BZ_MEM_ERROR) + errormsg = "failed to read bzip2 file: insufficient memory"; + } + } + BZ2_bzReadClose(&bzerror, b); + if (bzerror != BZ_OK) { + if (errormsg) + ffpmsg(errormsg); + else + ffpmsg("failure closing bzip2 file after reading\n"); + *status = READ_ERROR; + return; + } + *filesize = total_read; +} +#endif diff --git a/vendor/cfitsio/drvrnet.c b/vendor/cfitsio/drvrnet.c new file mode 100644 index 000000000..293368a67 --- /dev/null +++ b/vendor/cfitsio/drvrnet.c @@ -0,0 +1,4503 @@ +/* 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 + + + + 301 Moved Permanently + +

Moved Permanently

+ The document has moved here.

+ + + 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 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. + + **************************************************************** + Note added in 2017: + The redirect format shown above is actually preceded by 2 lines that look like + + HTTP/1.1 302 Found + LOCATION: http://heasarc.gsfc.nasa.gov/FTP/software/ftools/release/other/image.fits.gz + + The CFITSIO parser now looks for the "Location:" string, not the html tag. + **************************************************************** + + + 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 + + + + All binary information is transfered in network format, so use htonl and + ntohl to convert back and forth. + + :== 4 byte length, in network format, the len doesn't include the + length of + :== one of the message opcodes below, 4 bytes, network format + :== depends on opcode + + The response is of the same form with the same opcode sent. Success is + indicated by 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, 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 . Once + again the trailing null is sent. Once again a ROOTD_AUTH message is + returned + + ROOTD_OPEN - 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 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 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 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 + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#ifdef CFITSIO_HAVE_CURL +#include +#endif + +#if defined(unix) || defined(__unix__) || defined(__unix) || defined(HAVE_UNISTD_H) +#include +#endif + +#include +#include +#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 + +/* 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; + +typedef struct /* simple mem struct for receiving files from curl */ +{ + char *memory; + size_t size; +} curlmembuf; + +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, + char *contenttype, + int *contentlength); +static int https_open_network(char *filename, curlmembuf* buffer); +static int ftp_open_network(char *url, FILE **ftpfile, FILE **command, + int *sock); +static int ftps_open_network(char *filename, curlmembuf* buffer); +static int ftp_file_exist(char *url); +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 int ssl_get_with_curl(char *url, curlmembuf* buffer, + char* username, char* password); +static size_t curlToMemCallback(void *buffer, size_t size, size_t nmemb, void *userp); +static int curlProgressCallback(void *clientp, double dltotal, double dlnow, + double ultotal, double ulnow); + +/***************************/ +/* 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; + +static int curl_verbose=0; +static int show_fits_download_progress=0; +static unsigned int net_timeout = 360; /* in seconds */ + +/*--------------------------------------------------------------------------*/ +/* 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], contenttype[SHORTLEN]; + 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)"); + snprintf(errorstr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errorstr); + ffpmsg(" (multiplied x10 for files requiring uncompression)"); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + goto error; + } + + (void) signal(SIGALRM, signal_handler); + + /* Open the network connection */ + + if (http_open_network(filename,&httpfile, contentencoding, + contenttype, &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") || + !strcmp(contenttype, "application/x-gzip") || + !strcmp(contenttype, "application/gzip") || + !strcmp(contenttype, "application/gzip-compressed") || + !strcmp(contenttype, "application/gzipped") || + !strcmp(contenttype, "application/x-compress") || + !strcmp(contenttype, "application/x-compressed") || + 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*net_timeout, + Given the choices for nettimeout above they'll probaby ^C before, but + it's always worth a shot*/ + + alarm(net_timeout*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) { + snprintf(errorstr,MAXLEN,"Content-Length not a multiple of 2880 (http_open) %d", + contentlength); + ffpmsg(errorstr); + } + + /* write a memory file */ + alarm(net_timeout); + 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(net_timeout); /* 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], contenttype[SHORTLEN]; + char errorstr[MAXLEN]; + char recbuf[MAXLEN]; + long len; + int contentlength; + int ii, flen, status; + char firstchar; + + closehttpfile = 0; + closediskfile = 0; + closefdiskfile = 0; + closememfile = 0; + + flen = strlen(netoutfile); + if (!flen) { + /* cfileio made a mistake, should set the netoufile first otherwise + we don't know where to write the output file */ + 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)"); + snprintf(errorstr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errorstr); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + goto error; + } + + signal(SIGALRM, signal_handler); + + /* Open the http connectin */ + alarm(net_timeout); + if ((status = http_open_network(url,&httpfile, contentencoding, + contenttype, &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") || + !strcmp(contenttype, "application/x-gzip") || + !strcmp(contenttype, "application/gzip") || + !strcmp(contenttype, "application/gzip-compressed") || + !strcmp(contenttype, "application/gzipped") || + !strcmp(contenttype, "application/x-compress") || + !strcmp(contenttype, "application/x-compressed") || + ('\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(net_timeout); + 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(net_timeout); + } + 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], contenttype[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; + + flen = strlen(netoutfile); + if (!flen) { + /* cfileio made a mistake, we need to know where to write the file */ + 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)"); + snprintf(errorstr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errorstr); + ffpmsg(" (multiplied x10 for files requiring uncompression)"); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + goto error; + } + + signal(SIGALRM, signal_handler); + + /* Open the network connection */ + alarm(net_timeout); + if ((status = http_open_network(url,&httpfile, contentencoding, + contenttype, &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") || + !strcmp(contenttype, "application/x-gzip") || + !strcmp(contenttype, "application/gzip") || + !strcmp(contenttype, "application/gzip-compressed") || + !strcmp(contenttype, "application/gzipped") || + !strcmp(contenttype, "application/x-compress") || + !strcmp(contenttype, "application/x-compressed") || + ('\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*net_timeout, + Given the choices for nettimeout above they'll probaby ^C before, but + it's always worth a shot*/ + + alarm(net_timeout*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) { + snprintf(errorstr, MAXLEN, + "Content-Length not a multiple of 2880 (http_file_open) %d", + contentlength); + ffpmsg(errorstr); + } + + /* write a file */ + alarm(net_timeout); + 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 length of the file, returned if the http server returns + it +*/ +static int http_open_network(char *url, FILE **httpfile, char *contentencoding, + char *contenttype, 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; + char *scratchstr2; + char *saveptr; + 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)) { + snprintf(errorstr,MAXLEN,"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)) { + snprintf(errorstr,MAXLEN,"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) { + snprintf(tmpstr,MAXLEN,"GET http://%s:%-d%s HTTP/1.0\r\n",host,port,fn); + } else { + snprintf(tmpstr,MAXLEN,"GET %s HTTP/1.0\r\n",fn); + } + + if (strcmp(userpass, "")) { + encode64(strlen(userpass), userpass, MAXLEN, tmpstr2); + snprintf(tmpstr1, SHORTLEN,"Authorization: Basic %s\r\n", tmpstr2); + + if (strlen(tmpstr) + strlen(tmpstr1) > MAXLEN - 1) + { + fclose(*httpfile); + *httpfile=0; + return (FILE_NOT_OPENED); + } + strcat(tmpstr,tmpstr1); + } + +/* snprintf(tmpstr1,SHORTLEN,"User-Agent: HEASARC/CFITSIO/%-8.3f\r\n",ffvers(&version)); */ + +/* snprintf(tmpstr1,SHORTLEN,"User-Agent: CFITSIO/HEASARC/%-8.3f\r\n",ffvers(&version)); */ + snprintf(tmpstr1,SHORTLEN,"User-Agent: FITSIO/HEASARC/%-8.3f\r\n",ffvers(&version)); + + if (strlen(tmpstr) + strlen(tmpstr1) > MAXLEN - 1) + { + fclose(*httpfile); + *httpfile=0; + return (FILE_NOT_OPENED); + } + + strcat(tmpstr,tmpstr1); + + /* HTTP 1.1 servers require the following 'Host: ' string */ + snprintf(tmpstr1,SHORTLEN,"Host: %s:%-d\r\n\r\n",host,port); + + if (strlen(tmpstr) + strlen(tmpstr1) > MAXLEN - 1) + { + fclose(*httpfile); + *httpfile=0; + return (FILE_NOT_OPENED); + } + + strcat(tmpstr,tmpstr1); + + status = NET_SendRaw(sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + /* read the header */ + if (!(fgets(recbuf,MAXLEN,*httpfile))) { + snprintf (errorstr,MAXLEN,"http header short (http_open_network) %s",recbuf); + ffpmsg(errorstr); + fclose(*httpfile); + *httpfile=0; + return (FILE_NOT_OPENED); + } + + *contentlength = 0; + contentencoding[0] = '\0'; + contenttype[0] = '\0'; + + /* Our choices are 200, ok, 302, temporary redirect, or 301 perm redirect */ + sscanf(recbuf,"%s %d",tmpstr,&status); + if (status != 200){ + if (status == 301 || status == 302) { + /* got a redirect */ + +/* + if (status == 302) { + 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,"Location: "); + if (scratchstr != NULL) { + + /* Ok, we found the Location line which gives the redirected URL */ + /* skip the "Location: " charactrers */ + scratchstr += 10; + + /* strip off any end-of-line characters */ + tmpint = strlen(scratchstr); + if (scratchstr[tmpint-1] == '\r') scratchstr[tmpint-1] = '\0'; + tmpint = strlen(scratchstr); + if (scratchstr[tmpint-1] == '\n') scratchstr[tmpint-1] = '\0'; + tmpint = strlen(scratchstr); + if (scratchstr[tmpint-1] == '\r') scratchstr[tmpint-1] = '\0'; + +/* + ffpmsg("to:"); + ffpmsg(scratchstr); + ffpmsg(" "); +*/ + scratchstr2 = strstr(scratchstr,"http://"); + if (scratchstr2 != NULL) { + /* Ok, we found the HTTP redirection is to another HTTP URL. */ + /* We can handle this case directly, here */ + /* skip the "http://" characters */ + scratchstr2 += 7; + strcpy(turl, scratchstr2); + fclose (*httpfile); + *httpfile=0; + + /* note the recursive call to itself */ + return + http_open_network(turl,httpfile, contentencoding, + contenttype, contentlength); + } + + /* It was not a HTTP to HTTP redirection, so see if it HTTP to FTP */ + scratchstr2 = strstr(scratchstr,"ftp://"); + if (scratchstr2 != NULL) { + /* Ok, we found the HTTP redirection is to a FTP URL. */ + /* skip the "ftp://" characters */ + scratchstr2 += 6; + + /* return the new URL string, and set contentencoding to "ftp" as + a flag to the http_checkfile routine + */ + if (strlen(scratchstr2) > FLEN_FILENAME-1) + { + ffpmsg("Error: redirected url string too long (http_open_network)"); + fclose(*httpfile); + *httpfile=0; + return URL_PARSE_ERROR; + } + strcpy(url, scratchstr2); + strcpy(contentencoding,"ftp://"); + fclose (*httpfile); + *httpfile=0; + return 0; + } + + /* Now check for HTTP to HTTPS redirection. */ + scratchstr2 = strstr(scratchstr,"https://"); + if (scratchstr2 != NULL) { + /* skip the "https://" characters */ + scratchstr2 += 8; + + /* return the new URL string, and set contentencoding to "https" as + a flag to the http_checkfile routine + */ + if (strlen(scratchstr2) > FLEN_FILENAME-1) + { + ffpmsg("Error: redirected url string too long (http_open_network)"); + fclose(*httpfile); + return URL_PARSE_ERROR; + } + strcpy(url, scratchstr2); + strcpy(contentencoding,"https://"); + fclose(*httpfile); + *httpfile=0; + return 0; + } + + } + } + + /* if we get here then we couldnt' decide the redirect */ + ffpmsg("but we were unable to find the redirected url in the servers response"); + } + + /* error. could not open the http file */ + fclose(*httpfile); + *httpfile=0; + 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 */ + if (strlen(scratchstr) > SHORTLEN-1) + { + ffpmsg("Error: content-encoding string too long (http_open_network)"); + fclose(*httpfile); + *httpfile=0; + return URL_PARSE_ERROR; + } + strcpy(contentencoding,scratchstr); + } + } + + /* Did we get the content-type header ? */ + if (!strcmp(tmpstr,"Content-Type:")) { + if (NULL != (scratchstr = strstr(recbuf,":"))) { + /* Found the : */ + scratchstr++; /* skip the : */ + scratchstr++; /* skip the extra space */ + if (strlen(scratchstr) > SHORTLEN-1) + { + ffpmsg("Error: content-type string too long (http_open_network)"); + fclose(*httpfile); + *httpfile=0; + return URL_PARSE_ERROR; + } + strcpy(contenttype,scratchstr); + } + } + } + + /* we're done, so return */ + return 0; +} + +/*--------------------------------------------------------------------------*/ +/* This creates a memory file handle with a copy of the URL in filename. The + curl library called from https_open_network will perform file uncompression + if necessary. */ +int https_open(char *filename, int rwmode, int *handle) +{ + curlmembuf inmem; + char errStr[MAXLEN]; + int status=0; + + /* don't do r/w files */ + if (rwmode != 0) { + ffpmsg("Can't open https:// type file with READWRITE access"); + ffpmsg(" Specify an outfile for r/w access (https_open)"); + return (FILE_NOT_OPENED); + } + + inmem.memory=0; + inmem.size=0; + if (setjmp(env) != 0) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Timeout (https_open)"); + snprintf(errStr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errStr); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + + signal(SIGALRM, signal_handler); + alarm(net_timeout); + + if (https_open_network(filename, &inmem)) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Unable to read https file into memory (https_open)"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + alarm(0); + signal(SIGALRM, SIG_DFL); + /* We now have the file transfered from the https server into the + inmem.memory buffer. Now transfer that into a FITS memory file. */ + if ((status = mem_create(filename, handle))) + { + ffpmsg("Unable to create memory file (https_open)"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + + /* Check for gzip magic number */ + if (inmem.size >= 2 && + (unsigned char) inmem.memory[0] == 0x1f && + (unsigned char) inmem.memory[1] == 0x8b) { + LONGLONG fitsfilesize = 0; + + /* Uncompress from memory to memfile */ + status = mem_zuncompress_and_write(*handle, inmem.memory, inmem.size); + mem_size(*handle, &fitsfilesize); + + if ((fitsfilesize > 0) && (fitsfilesize % 2880)) { + snprintf(errStr,MAXLEN,"Uncompressed file length not a multiple of 2880 (https_open) %lld", + fitsfilesize); + ffpmsg(errStr); + } + + } else { + + if (inmem.size % 2880) { + snprintf(errStr,MAXLEN,"Content-Length not a multiple of 2880 (https_open) %zu", + inmem.size); + ffpmsg(errStr); + } + + /* Straight copy of data */ + status = mem_write(*handle, inmem.memory, inmem.size); + } + if (status) + { + ffpmsg("Error copying https file into memory (https_open)"); + ffpmsg(filename); + free(inmem.memory); + mem_close_free(*handle); + return (FILE_NOT_OPENED); + } + free(inmem.memory); + return mem_seek(*handle, 0); + +} + +/*--------------------------------------------------------------------------*/ +int https_file_open(char *filename, int rwmode, int *handle) +{ + int ii, flen; + char errStr[MAXLEN]; + curlmembuf inmem; + + /* 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( https_open(filename, READONLY, handle) ); + } + + flen = strlen(netoutfile); + if (!flen) + { + /* cfileio made a mistake, we need to know where to write the file */ + ffpmsg("Output file not set, shouldn't have happened (https_file_open)"); + return (FILE_NOT_OPENED); + } + + inmem.memory=0; + inmem.size=0; + if (setjmp(env) != 0) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Timeout (https_file_open)"); + snprintf(errStr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errStr); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + signal(SIGALRM, signal_handler); + alarm(net_timeout); + if (https_open_network(filename, &inmem)) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Unable to read https file into memory (https_file_open)"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + alarm(0); + signal(SIGALRM, SIG_DFL); + + if (*netoutfile == '!') + { + /* user wants to clobber disk file, if it already exists */ + for (ii = 0; ii < flen; ii++) + netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */ + + file_remove(netoutfile); + } + + /* Create the output file */ + if (file_create(netoutfile,handle)) + { + ffpmsg("Unable to create output file (https_file_open)"); + ffpmsg(netoutfile); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + + if (inmem.size % 2880) + { + snprintf(errStr, MAXLEN, + "Content-Length not a multiple of 2880 (https_file_open) %zu", + inmem.size); + ffpmsg(errStr); + } + + if (file_write(*handle, inmem.memory, inmem.size)) + { + ffpmsg("Error copying https file to disk file (https_file_open)"); + ffpmsg(filename); + ffpmsg(netoutfile); + free(inmem.memory); + file_close(*handle); + return (FILE_NOT_OPENED); + } + free(inmem.memory); + file_close(*handle); + + return file_open(netoutfile, rwmode, handle); +} + +/*--------------------------------------------------------------------------*/ +/* Callback function curl library uses during https connection to transfer + server file into memory */ +size_t curlToMemCallback(void *buffer, size_t size, size_t nmemb, void *userp) +{ + curlmembuf* inmem = (curlmembuf* )userp; + size_t transferSize = size*nmemb; + if (!inmem->size) + { + /* First time through - initialize with malloc */ + inmem->memory = (char *)malloc(transferSize); + } + else + inmem->memory = realloc(inmem->memory, inmem->size+transferSize); + if (inmem->memory == NULL) + { + ffpmsg("realloc error - not enough memory (curlToMemCallback)\n"); + return 0; + } + memcpy(&(inmem->memory[inmem->size]), buffer, transferSize); + inmem->size += transferSize; + + return transferSize; +} + +/*--------------------------------------------------------------------------*/ +/* Callback function for displaying status bar during download */ +int curlProgressCallback(void *clientp, double dltotal, double dlnow, + double ultotal, double ulnow) +{ + int i, fullBar = 50, nToDisplay = 0; + int percent = 0; + double fracCompleted = 0.0; + char *urlname=0; + static int isComplete = 0; + static int isFirst = 1; + + /* isFirst is true the very first time this is entered. Afterwards it + should get reset to true when isComplete is first detected to have + toggled from true to false. */ + if (dltotal == 0.0) + { + if (isComplete) + isFirst = 1; + isComplete = 0; + return 0; + } + + fracCompleted = dlnow/dltotal; + percent = (int)ceil(fracCompleted*100.0 - 0.5); + if (isComplete && percent < 100) + isFirst = 1; + if (!isComplete || percent < 100) + { + if (isFirst) + { + urlname = (char *)clientp; + if (urlname) + { + fprintf(stderr,"Downloading "); + fprintf(stderr,"%s",urlname); + fprintf(stderr,"...\n"); + } + isFirst = 0; + } + isComplete = (percent >= 100) ? 1 : 0; + nToDisplay = (int)ceil(fracCompleted*fullBar - 0.5); + /* Can dlnow ever be > dltotal? Just in case... */ + if (nToDisplay > fullBar) + nToDisplay = fullBar; + fprintf(stderr,"%3d%% [",percent); + for (i=0; i 0) + net_timeout = (unsigned int)sec; + return (int)net_timeout; +} + +/*--------------------------------------------------------------------------*/ +int ftps_open(char *filename, int rwmode, int *handle) +{ + curlmembuf inmem; + char errStr[MAXLEN]; + char localFilename[MAXLEN]; /* may have .gz or .Z appended in ftps_open_network.*/ + unsigned char firstByte=0,secondByte=0; + int status=0; + FILE *compressedFile=0; + + strcpy(localFilename,filename); + + /* don't do r/w files */ + if (rwmode != 0) { + ffpmsg("Can't open ftps:// type file with READWRITE access"); + ffpmsg(" Specify an outfile for r/w access (ftps_open)"); + return (FILE_NOT_OPENED); + } + + inmem.memory=0; + inmem.size=0; + if (setjmp(env) != 0) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Timeout (ftps_open)"); + snprintf(errStr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errStr); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + + signal(SIGALRM, signal_handler); + alarm(net_timeout); + + if (ftps_open_network(localFilename, &inmem)) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Unable to read ftps file into memory (ftps_open)"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + + alarm(0); + signal(SIGALRM, SIG_DFL); + + if (strcmp(localFilename, filename)) + { + /* ftps_open_network has already checked that this is safe to + copy into string of size FLEN_FILENAME */ + strcpy(filename, localFilename); + } + + /* We now have the file transfered from the ftps server into the + inmem.memory buffer. Now transfer that into a FITS memory file. */ + if ((status = mem_create(filename, handle))) + { + ffpmsg("Unable to create memory file (ftps_open)"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + if (inmem.size > 1) + { + firstByte = (unsigned char)inmem.memory[0]; + secondByte = (unsigned char)inmem.memory[1]; + } + if (firstByte == 0x1f && secondByte == 0x8b || + strstr(localFilename,".Z")) + { +#ifdef HAVE_FMEMOPEN + compressedFile = fmemopen(inmem.memory, inmem.size, "r"); +#endif + if (!compressedFile) + { + ffpmsg("Error creating file in memory (ftps_open)"); + free(inmem.memory); + return(FILE_NOT_OPENED); + } + if(mem_uncompress2mem(localFilename,compressedFile,*handle)) + { + ffpmsg("Error writing compressed memory file (ftps_open)"); + ffpmsg(filename); + fclose(compressedFile); + free(inmem.memory); + return(FILE_NOT_OPENED); + } + fclose(compressedFile); + } + else + { + if (inmem.size % 2880) + { + snprintf(errStr,MAXLEN,"Content-Length not a multiple of 2880 (ftps_open) %zu", + inmem.size); + ffpmsg(errStr); + } + status = mem_write(*handle, inmem.memory, inmem.size); + if (status) + { + ffpmsg("Error copying https file into memory (ftps_open)"); + ffpmsg(filename); + free(inmem.memory); + mem_close_free(*handle); + return (FILE_NOT_OPENED); + } + } + free(inmem.memory); + return mem_seek(*handle, 0); +} + +/*--------------------------------------------------------------------------*/ +int ftps_file_open(char *filename, int rwmode, int *handle) +{ + int ii, flen, status=0; + char errStr[MAXLEN]; + char localFilename[MAXLEN]; /* may have .gz or .Z appended */ + unsigned char firstByte=0,secondByte=0; + curlmembuf inmem; + FILE *compressedInFile=0; + + strcpy(localFilename, filename); + + /* 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( ftps_open(filename, READONLY, handle) ); + } + + flen = strlen(netoutfile); + if (!flen) + { + /* cfileio made a mistake, we need to know where to write the file */ + ffpmsg("Output file not set, shouldn't have happened (ftps_file_open)"); + return (FILE_NOT_OPENED); + } + + inmem.memory=0; + inmem.size=0; + if (setjmp(env) != 0) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Timeout (ftps_file_open)"); + snprintf(errStr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errStr); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + signal(SIGALRM, signal_handler); + alarm(net_timeout); + if (ftps_open_network(localFilename, &inmem)) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Unable to read ftps file into memory (ftps_file_open)"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + alarm(0); + signal(SIGALRM, SIG_DFL); + + if (strstr(localFilename, ".Z")) + { + ffpmsg(".Z decompression not supported for file output (ftps_file_open)"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + + if (strcmp(localFilename, filename)) + { + /* ftps_open_network has already checked that this is safe to + copy into string of size FLEN_FILENAME */ + strcpy(filename, localFilename); + } + + if (*netoutfile == '!') + { + /* user wants to clobber disk file, if it already exists */ + for (ii = 0; ii < flen; ii++) + netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */ + + file_remove(netoutfile); + } + + /* Create the output file */ + if (file_create(netoutfile,handle)) + { + ffpmsg("Unable to create output file (ftps_file_open)"); + ffpmsg(netoutfile); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + + if (inmem.size > 1) + { + firstByte = (unsigned char)inmem.memory[0]; + secondByte = (unsigned char)inmem.memory[1]; + } + if (firstByte == 0x1f && secondByte == 0x8b) + { + /* Doing a file create/close/reopen to mimic the procedure in + ftp_file_open. The earlier call to file_create ensures that + checking is performed for the Hera case. */ + file_close(*handle); + /* Reopen with direct call to fopen to set the outfile pointer */ + outfile = fopen(netoutfile,"w"); + if (!outfile) + { + ffpmsg("Unable to reopen the output file (ftps_file_open)"); + ffpmsg(netoutfile); + free(inmem.memory); + return(FILE_NOT_OPENED); + } + +#ifdef HAVE_FMEMOPEN + compressedInFile = fmemopen(inmem.memory, inmem.size, "r"); +#endif + if (!compressedInFile) + { + ffpmsg("Error creating compressed file in memory (ftps_file_open)"); + free(inmem.memory); + fclose(outfile); + return(FILE_NOT_OPENED); + } + if (uncompress2file(filename, compressedInFile, outfile, &status)) + { + ffpmsg("Unable to uncompress the output file (ftps_file_open)"); + ffpmsg(filename); + ffpmsg(netoutfile); + fclose(outfile); + fclose(compressedInFile); + free(inmem.memory); + return(FILE_NOT_OPENED); + } + fclose(outfile); + fclose(compressedInFile); + } + else + { + if (inmem.size % 2880) + { + snprintf(errStr, MAXLEN, + "Content-Length not a multiple of 2880 (ftps_file_open) %zu", + inmem.size); + ffpmsg(errStr); + } + + if (file_write(*handle, inmem.memory, inmem.size)) + { + ffpmsg("Error copying ftps file to disk file (ftps_file_open)"); + ffpmsg(filename); + ffpmsg(netoutfile); + free(inmem.memory); + file_close(*handle); + return (FILE_NOT_OPENED); + } + file_close(*handle); + } + free(inmem.memory); + + return file_open(netoutfile, rwmode, handle); + +} + +/*--------------------------------------------------------------------------*/ +int ftps_compress_open(char *filename, int rwmode, int *handle) +{ + int ii, flen, status=0; + char errStr[MAXLEN]; + char localFilename[MAXLEN]; /* may have .gz or .Z appended */ + unsigned char firstByte=0,secondByte=0; + curlmembuf inmem; + FILE *compressedInFile=0; + + /* don't do r/w files */ + if (rwmode != 0) { + ffpmsg("Compressed files must be r/o"); + return (FILE_NOT_OPENED); + } + + strcpy(localFilename, filename); + + flen = strlen(netoutfile); + if (!flen) + { + /* cfileio made a mistake, we need to know where to write the file */ + ffpmsg("Output file not set, shouldn't have happened (ftps_compress_open)"); + return (FILE_NOT_OPENED); + } + + inmem.memory=0; + inmem.size=0; + if (setjmp(env) != 0) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Timeout (ftps_compress_open)"); + snprintf(errStr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errStr); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + signal(SIGALRM, signal_handler); + alarm(net_timeout); + if (ftps_open_network(localFilename, &inmem)) + { + alarm(0); + signal(SIGALRM, SIG_DFL); + ffpmsg("Unable to read ftps file into memory (ftps_compress_open)"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + alarm(0); + signal(SIGALRM, SIG_DFL); + + if (strcmp(localFilename, filename)) + { + /* ftps_open_network has already checked that this is safe to + copy into string of size FLEN_FILENAME */ + strcpy(filename, localFilename); + } + if (inmem.size > 1) + { + firstByte = (unsigned char)inmem.memory[0]; + secondByte = (unsigned char)inmem.memory[1]; + } + if ((firstByte == 0x1f && secondByte == 0x8b) || + strstr(localFilename,".gz") || strstr(localFilename,".Z")) + { + if (*netoutfile == '!') + { + /* user wants to clobber disk file, if it already exists */ + for (ii = 0; ii < flen; ii++) + netoutfile[ii] = netoutfile[ii + 1]; /* remove '!' */ + + file_remove(netoutfile); + } + /* Create the output file */ + if (file_create(netoutfile,handle)) + { + ffpmsg("Unable to create output file (ftps_compress_open)"); + ffpmsg(netoutfile); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + if (file_write(*handle, inmem.memory, inmem.size)) + { + ffpmsg("Error copying ftps file to disk file (ftps_file_open)"); + ffpmsg(filename); + ffpmsg(netoutfile); + free(inmem.memory); + file_close(*handle); + return (FILE_NOT_OPENED); + } + file_close(*handle); + + /* File is on disk, let's uncompress it into memory */ + if (NULL == (diskfile = fopen(netoutfile,"r"))) { + ffpmsg("Unable to reopen disk file (ftps_compress_open)"); + ffpmsg(netoutfile); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + + if ((status = mem_create(localFilename,handle))) { + ffpmsg("Unable to create memory file (ftps_compress_open)"); + ffpmsg(localFilename); + free(inmem.memory); + fclose(diskfile); + diskfile=0; + return (FILE_NOT_OPENED); + } + + status = mem_uncompress2mem(localFilename,diskfile,*handle); + fclose(diskfile); + diskfile=0; + + if (status) { + ffpmsg("Error writing compressed memory file (ftps_compress_open)"); + free(inmem.memory); + mem_close_free(*handle); + return (FILE_NOT_OPENED); + } + + } + else + { + ffpmsg("Cannot write uncompressed infile to compressed outfile (ftps_compress_open)"); + free(inmem.memory); + return (FILE_NOT_OPENED); + } + + free(inmem.memory); + + return mem_seek(*handle,0); + +} + +/*--------------------------------------------------------------------------*/ +int ftps_open_network(char *filename, curlmembuf* buffer) +{ + char agentStr[SHORTLEN]; + char url[MAXLEN]; + char tmphost[SHORTLEN]; /* work array for separating user/pass/host names */ + char *username=0; + char *password=0; + char *hostname=0; + char *dirpath=0; + char *strptr=0; + float version=0.0; + int iDirpath=0, len=0, origLen=0; + int status=0; + + strcpy(url,"ftp://"); + + /* The filename may already contain a username and password, as indicated + by a '@' within the host part of the name (which we'll define as the substring + before the first '/'). If not, we'll set a default username:password */ + len = strlen(filename); + for (iDirpath=0; iDirpath SHORTLEN-1) + { + ffpmsg("Host name is too long in URL (ftps_open_network)"); + return (FILE_NOT_OPENED); + } + strncpy(tmphost, filename, iDirpath); + dirpath = &filename[iDirpath]; + tmphost[iDirpath]='\0'; + + /* There could be more than one '@' since they can also exist in the + username or password. Find the right-most '@' and assume that it + delimits the host name. */ + hostname = strrchr(tmphost, '@'); + if (hostname) + { + *hostname = '\0'; + ++hostname; + /* Assume first occurrence of ':' is indicative of password delimiter. */ + password = strchr(tmphost, ':'); + if (password) + { + *password = '\0'; + ++password; + } + username = tmphost; + } + else + hostname = tmphost; + + if (!username || strlen(username)==0) + username = "anonymous"; + if (!password || strlen(password)==0) + { + snprintf(agentStr,SHORTLEN,"User-Agent: FITSIO/HEASARC/%-8.3f",ffvers(&version)); + password = agentStr; + } + + /* url may eventually have .gz or .Z appended to it */ + if (strlen(url) + strlen(hostname) + strlen(dirpath) > MAXLEN-4) + { + ffpmsg("Full URL name is too long (ftps_open_network)"); + return (FILE_NOT_OPENED); + } + strcat(url, hostname); + strcat(url, dirpath); + +/* printf("url = %s\n",url); + printf("username = %s\n",username); + printf("password = %s\n",password); + printf("hostname = %s\n",hostname); +*/ + + origLen = strlen(url); + status = ssl_get_with_curl(url, buffer, username, password); + /* If original url has .gz or .Z appended, do the same to the original filename. + Note that url also differs from original filename at this point, since + filename may have included username@password (which url would not). */ + len = strlen(url); + if ((len-origLen) == 2 || (len-origLen) == 3) + { + if (strlen(filename) > FLEN_FILENAME - 4) + { + ffpmsg("Filename is too long to append compression ext (ftps_open_network)"); + /* buffer memory must be freed by calling routine */ + return (FILE_NOT_OPENED); + } + strptr = url + origLen; + strcat(filename, strptr); + } + return status; + + } + +/*--------------------------------------------------------------------------*/ +/* Function to perform common curl interfacing for https or ftps transfers */ + +int ssl_get_with_curl(char *url, curlmembuf* buffer, char* username, + char* password) +{ + /* These settings will force libcurl to perform host and peer authentication. + If it fails, this routine will try again without authentication (unless + user forbids this via CFITSIO_VERIFY_HTTPS environment variable). + */ + long verifyPeer = 1; + long verifyHost = 2; + char errStr[MAXLEN]; + char agentStr[MAXLEN]; + float version=0.0; + char *tmpUrl=0; + char *verify=0; + int isFtp = (strstr(url,"ftp://") != NULL); + int experimentWithCompression = (!strstr(url,".gz") && !strstr(url,".Z") + && !strstr(url,"?")); + int notFound=1; + #ifdef CFITSIO_HAVE_CURL + CURL *curl=0; + CURLcode res; + char curlErrBuf[CURL_ERROR_SIZE]; + + if (strstr(url,".Z") && !isFtp) + { + ffpmsg("x-compress .Z format not currently supported with curl https transfers"); + return(FILE_NOT_OPENED); + } + + /* Will ASSUME curl_global_init has been called by this point. + It is not thread-safe to call it here. */ + curl = curl_easy_init(); + + res = curl_easy_setopt(curl, CURLOPT_SSL_VERIFYPEER, verifyPeer); + if (res != CURLE_OK) + { + ffpmsg("ERROR: CFITSIO was built with a libcurl library that "); + ffpmsg("does not have SSL support, and therefore can't perform https or ftps transfers."); + return (FILE_NOT_OPENED); + } + curl_easy_setopt(curl, CURLOPT_SSL_VERIFYHOST, verifyHost); + + curl_easy_setopt(curl, CURLOPT_VERBOSE, (long)curl_verbose); + curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, curlToMemCallback); + snprintf(agentStr,MAXLEN,"FITSIO/HEASARC/%-8.3f",ffvers(&version)); + curl_easy_setopt(curl, CURLOPT_USERAGENT,agentStr); + + buffer->memory = 0; /* malloc/realloc will grow this in the callback function */ + buffer->size = 0; + curl_easy_setopt(curl, CURLOPT_WRITEDATA, (void *)buffer); + curl_easy_setopt(curl, CURLOPT_ERRORBUFFER, curlErrBuf); + curlErrBuf[0]=0; + /* This is needed for easy_perform to return an error whenever http server + returns an error >= 400, ie. if it can't find the requested file. */ + curl_easy_setopt(curl, CURLOPT_FAILONERROR, 1L); + /* This turns on automatic decompression for all recognized types. */ + curl_easy_setopt(curl, CURLOPT_ENCODING, ""); + + /* tmpUrl should be large enough to accomodate original url + ".gz" */ + tmpUrl = (char *)malloc(strlen(url)+4); + strcpy(tmpUrl, url); + if (show_fits_download_progress) + { + curl_easy_setopt(curl, CURLOPT_PROGRESSFUNCTION, curlProgressCallback); + curl_easy_setopt(curl, CURLOPT_PROGRESSDATA, tmpUrl); + curl_easy_setopt(curl, CURLOPT_NOPROGRESS, 0L); + } + else + curl_easy_setopt(curl, CURLOPT_NOPROGRESS, 1L); + + /* USESSL only necessary for ftps, though it may not hurt anything + if it were also set for https. */ + if (isFtp) + { + curl_easy_setopt(curl, CURLOPT_USE_SSL, CURLUSESSL_ALL); + if (username) + curl_easy_setopt(curl, CURLOPT_USERNAME, username); + if (password) + curl_easy_setopt(curl, CURLOPT_PASSWORD, password); + } + + /* Unless url already contains a .gz, .Z or '?' (probably from a cgi script), + first try with .gz appended. */ + + if (experimentWithCompression) + strcat(tmpUrl, ".gz"); + + /* First attempt: verification on */ + curl_easy_setopt(curl, CURLOPT_URL, tmpUrl); + res = curl_easy_perform(curl); + if (res != CURLE_OK && res != CURLE_HTTP_RETURNED_ERROR && + res != CURLE_REMOTE_FILE_NOT_FOUND) + { + /* CURLE_HTTP_RETURNED_ERROR is what gets returned if HTTP server + returns an error code >= 400. CURLE_REMOTE_FILE_NOT_FOUND may + be returned by an ftp server. If these are not causing this error, + assume it is a verification issue. + Try again with verification removed, unless user disallowed it + via environment variable. */ + verify = getenv("CFITSIO_VERIFY_HTTPS"); + if (verify) + { + if (verify[0] == 'T' || verify[0] == 't') + { + snprintf(errStr,MAXLEN,"libcurl error: %d",res); + ffpmsg(errStr); + if (strlen(curlErrBuf)) + ffpmsg(curlErrBuf); + curl_easy_cleanup(curl); + free(tmpUrl); + return (FILE_NOT_OPENED); + } + } + verifyPeer = 0; + verifyHost = 0; + curl_easy_setopt(curl, CURLOPT_SSL_VERIFYPEER, verifyPeer); + curl_easy_setopt(curl, CURLOPT_SSL_VERIFYHOST, verifyHost); + /* Second attempt: no verification, .gz appended */ + res = curl_easy_perform(curl); + if (res != CURLE_OK) + { + if (isFtp && experimentWithCompression) + { + strcpy(tmpUrl, url); + strcat(tmpUrl, ".Z"); + curl_easy_setopt(curl, CURLOPT_URL, tmpUrl); + /* For ftps, make another attempt with .Z */ + res = curl_easy_perform(curl); + if (res == CURLE_OK) + { + /* Success, but should still warn */ + fprintf(stderr, "Warning: Unable to perform SSL verification on https transfer from: %s\n", + tmpUrl); + notFound=0; + } + } + + /* If we've been appending .gz or .Z, try a final time without. */ + if (experimentWithCompression && notFound) + { + strcpy(tmpUrl, url); + curl_easy_setopt(curl, CURLOPT_URL, tmpUrl); + /* attempt with no verification, no .gz or .Z appended */ + res = curl_easy_perform(curl); + if (res != CURLE_OK) + { + snprintf(errStr,MAXLEN,"libcurl error: %d",res); + ffpmsg(errStr); + if (strlen(curlErrBuf)) + ffpmsg(curlErrBuf); + curl_easy_cleanup(curl); + free(tmpUrl); + return (FILE_NOT_OPENED); + } + else + /* Success, but should still warn */ + fprintf(stderr, "Warning: Unable to perform SSL verification on https transfer from: %s\n", + tmpUrl); + } + else if (notFound) + { + snprintf(errStr,MAXLEN,"libcurl error: %d",res); + ffpmsg(errStr); + if (strlen(curlErrBuf)) + ffpmsg(curlErrBuf); + curl_easy_cleanup(curl); + free(tmpUrl); + return (FILE_NOT_OPENED); + } + } + else + /* Success, but still issue warning */ + fprintf(stderr, "Warning: Unable to perform SSL verification on https transfer from: %s\n", + tmpUrl); + + } + else if (res == CURLE_HTTP_RETURNED_ERROR || res == CURLE_REMOTE_FILE_NOT_FOUND) + { + /* .gz extension failed and verification isn't the problem. + No need to relax peer/host checking */ + /* Unless url already contained a .gz, .Z or '?' (probably from a cgi script), + try again with original url unappended (but first try .Z if this is ftps). */ + if (experimentWithCompression) + { + if (isFtp) + { + strcpy(tmpUrl, url); + strcat(tmpUrl, ".Z"); + curl_easy_setopt(curl, CURLOPT_URL, tmpUrl); + res = curl_easy_perform(curl); + if (res == CURLE_OK) + notFound = 0; + } + if (notFound) + { + strcpy(tmpUrl, url); + curl_easy_setopt(curl, CURLOPT_URL, tmpUrl); + res = curl_easy_perform(curl); + if (res != CURLE_OK) + { + snprintf(errStr,MAXLEN,"libcurl error: %d",res); + ffpmsg(errStr); + if (strlen(curlErrBuf)) + ffpmsg(curlErrBuf); + curl_easy_cleanup(curl); + free(tmpUrl); + return (FILE_NOT_OPENED); + } + } + } + else + { + snprintf(errStr,MAXLEN,"libcurl error: %d",res); + ffpmsg(errStr); + if (strlen(curlErrBuf)) + ffpmsg(curlErrBuf); + curl_easy_cleanup(curl); + free(tmpUrl); + return (FILE_NOT_OPENED); + } + } + + /* If we made it here, assume tmpUrl was successful. Calling routines + must make sure url can hold up to 3 extra chars */ + strcpy(url, tmpUrl); + + free(tmpUrl); + curl_easy_cleanup(curl); + + #else + ffpmsg("ERROR: This CFITSIO build was not compiled with the libcurl library package "); + ffpmsg("and therefore it cannot perform HTTPS or FTPS connections."); + return (FILE_NOT_OPENED); + + #endif + 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 errorstr[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 (ftp_open)"); + snprintf(errorstr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errorstr); + ffpmsg(" (multiplied x10 for files requiring uncompression)"); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + 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(net_timeout); + if (ftp_open_network(filename,&ftpfile,&command,&sock)) { + + alarm(0); + ffpmsg("Unable to open following ftp file (ftp_open):"); + ffpmsg(filename); + 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(filename,".gz") || + strstr(filename,".Z") || + ('\037' == firstchar)) { + + status = 0; + /* A bit arbritary really, the user will probably hit ^C */ + alarm(net_timeout*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(net_timeout); + 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(net_timeout); + } + } + + /* close and clean up */ + fclose(ftpfile); + closeftpfile--; + + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + closecommandfile--; + + signal(SIGALRM, SIG_DFL); + alarm(0); + + return mem_seek(*handle,0); + + error: + alarm(0); /* clear it */ + if (closecommandfile) { + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + } + 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 errorstr[MAXLEN]; + 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 (ftp_file_open)"); + snprintf(errorstr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errorstr); + ffpmsg(" (multiplied x10 for files requiring uncompression)"); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + 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(net_timeout); + 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*net_timeout, + Given the choices for nettimeout above they'll probaby ^C before, but + it's always worth a shot*/ + + alarm(net_timeout*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(net_timeout); + 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(net_timeout); + } + file_close(*handle); + } + fclose(ftpfile); + closeftpfile--; + + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + 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); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + } + 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 errorstr[MAXLEN]; + 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 (ftp_compress_open)"); + snprintf(errorstr, MAXLEN, "Download timeout exceeded: %d seconds",net_timeout); + ffpmsg(errorstr); + ffpmsg(" Timeout may be adjusted with fits_set_timeout"); + 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(net_timeout); + + 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(net_timeout); + 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(net_timeout); + } + + file_close(*handle); + closediskfile--; + fclose(ftpfile); + closeftpfile--; + /* Close down the ftp connection */ + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + 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); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + } + 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 */ + +static 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 agentStr[SHORTLEN]; + char *newhost; + char *username; + char *password; + char fn[MAXLEN]; + char *newfn; + char *passive; + char *tstr; + char *saveptr; + char ip[SHORTLEN]; + char turl[MAXLEN]; + int port; + int ii,tryingtologin = 1; + float version=0.0; + + /* parse the URL */ + if (strlen(filename) > MAXLEN - 7) { + ffpmsg("ftp filename is too long (ftp_open_network)"); + return (FILE_NOT_OPENED); + } + + strcpy(turl,"ftp://"); + strcat(turl,filename); + if (NET_ParseUrl(turl,proto,host,&port,fn)) { + snprintf(errorstr,MAXLEN,"URL Parse Error (ftp_open) %s",filename); + ffpmsg(errorstr); + return (FILE_NOT_OPENED); + } + + port = 21; + /* We might have a user name. If not, set defaults for username and password */ + username = "anonymous"; + snprintf(agentStr,SHORTLEN,"User-Agent: FITSIO/HEASARC/%-8.3f",ffvers(&version)); + password = agentStr; + /* 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; + } + + for (ii = 0; ii < 10; ii++) { /* make up to 10 attempts to log in */ + + /* 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_netowrk)"); + return (FILE_NOT_OPENED); + } + + /* Wait for the 220 response */ + if (ftp_status(*command,"220 ")) { + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + +/* ffpmsg("sleeping for 5 in ftp_open_network, then try again"); */ + + sleep (5); /* take a nap and hope ftp server sorts itself out in the meantime */ + + } else { + tryingtologin = 0; + break; + } + } + + if (tryingtologin) { /* the 10 attempts were not successful */ + ffpmsg ("error connecting to remote server, no 220 seen (ftp_open_network)"); + return (FILE_NOT_OPENED); + } + + /* Send the user name and wait for the right response */ + snprintf(tmpstr,MAXLEN,"USER %s\r\n",username); + + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(*command,"331 ")) { + ffpmsg ("USER error no 331 seen (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + + /* Send the password and wait for the right response */ + snprintf(tmpstr,MAXLEN,"PASS %s\r\n",password); + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(*command,"230 ")) { + ffpmsg ("PASS error, no 230 seen (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + + /* now do the cwd command */ + newfn = strrchr(fn,'/'); + if (newfn == NULL) { + strcpy(tmpstr,"CWD /\r\n"); + newfn = fn; + } else { + *newfn = '\0'; + newfn++; + if (strlen(fn) == 0) { + strcpy(tmpstr,"CWD /\r\n"); + } else { + /* remove the leading slash */ + if (fn[0] == '/') { + snprintf(tmpstr,MAXLEN,"CWD %s\r\n",&fn[1]); + } else { + snprintf(tmpstr,MAXLEN,"CWD %s\r\n",fn); + } + } + } + + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(*command,"250 ")) { + ffpmsg ("CWD error, no 250 seen (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + + if (!strlen(newfn)) { + ffpmsg("Null file name (ftp_open)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + + /* Always use binary mode */ + snprintf(tmpstr,MAXLEN,"TYPE I\r\n"); + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(*command,"200 ")) { + ffpmsg ("TYPE I error, 200 not seen (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + + status = NET_SendRaw(*sock,"PASV\r\n",6,NET_DEFAULT); + + if (!(fgets(recbuf,MAXLEN,*command))) { + ffpmsg ("PASV error (ftp_open)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + 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_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + + *passive = '\0'; + passive++; + ip[0] = '\0'; + + /* Messy parsing of response from PASV *command */ + + if (!(tstr = ffstrtok(passive,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + strcpy(ip,tstr); + strcat(ip,"."); + + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + strcat(ip,tstr); + strcat(ip,"."); + + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + strcat(ip,tstr); + strcat(ip,"."); + + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + strcat(ip,tstr); + + /* Done the ip number, now do the port # */ + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + sscanf(tstr,"%d",&port); + port *= 256; + + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + sscanf(tstr,"%d",&tmpint); + port += tmpint; + + if (!strlen(newfn)) { + ffpmsg("Null file name (ftp_open_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + + /* 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_network)"); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + + /* Send the retrieve command */ + snprintf(tmpstr,MAXLEN,"RETR %s\r\n",newfn); + status = NET_SendRaw(*sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(*command,"150 ")) { + fclose(*ftpfile); + NET_SendRaw(sock1,"QUIT\r\n",6,NET_DEFAULT); + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); + } + return 0; /* successfully opened the ftp file */ + } + + /* no passive mode */ + + fclose(*command); + NET_SendRaw(*sock,"QUIT\r\n",6,NET_DEFAULT); + return (FILE_NOT_OPENED); +} +/*--------------------------------------------------------------------------*/ +/* Open a ftp connection to see if the file exists (return 1) or not (return 0) */ + +int ftp_file_exist(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 *saveptr; + char ip[SHORTLEN]; + char turl[MAXLEN]; + int port; + int ii, tryingtologin = 1; + + /* parse the URL */ + if (strlen(filename) > MAXLEN - 7) { + ffpmsg("ftp filename is too long (ftp_file_exist)"); + return 0; + } + + strcpy(turl,"ftp://"); + strcat(turl,filename); + if (NET_ParseUrl(turl,proto,host,&port,fn)) { + snprintf(errorstr,MAXLEN,"URL Parse Error (ftp_file_exist) %s",filename); + ffpmsg(errorstr); + return 0; + } + + 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; + } + + for (ii = 0; ii < 10; ii++) { /* make up to 10 attempts to log in */ + + /* 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 ("Failed to convert socket to stdio file (ftp_file_exist)"); + return 0; + } + + /* Wait for the 220 response */ + if (ftp_status(command,"220")) { + ffpmsg ("error connecting to remote server, no 220 seen (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + +/* ffpmsg("sleeping for 5 in ftp_file_exist, then try again"); */ + + sleep (5); /* take a nap and hope ftp server sorts itself out in the meantime */ + + } else { + tryingtologin = 0; + break; + } + + } + + if (tryingtologin) { /* the 10 attempts were not successful */ + ffpmsg ("error connecting to remote server, no 220 seen (ftp_open_network)"); + return (0); + } + + /* Send the user name and wait for the right response */ + snprintf(tmpstr,MAXLEN,"USER %s\r\n",username); + + status = NET_SendRaw(sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + /* If command is refused due to the connection requiring SSL (ie. an + fpts connection), this is where it will first be detected by way + of a 550 error code. */ + + status = ftp_status(command,"331 "); + if (status == 550) + { + ffpmsg ("Server is requesting SSL, will switch to ftps (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return -1; + } + else if (status) { + ffpmsg ("USER error no 331 seen (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + /* Send the password and wait for the right response */ + snprintf(tmpstr,MAXLEN,"PASS %s\r\n",password); + status = NET_SendRaw(sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(command,"230 ")) { + ffpmsg ("PASS error, no 230 seen (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + /* now do the cwd command */ + newfn = strrchr(fn,'/'); + if (newfn == NULL) { + strcpy(tmpstr,"CWD /\r\n"); + newfn = fn; + } else { + *newfn = '\0'; + newfn++; + if (strlen(fn) == 0) { + strcpy(tmpstr,"CWD /\r\n"); + } else { + /* remove the leading slash */ + if (fn[0] == '/') { + snprintf(tmpstr,MAXLEN,"CWD %s\r\n",&fn[1]); + } else { + snprintf(tmpstr,MAXLEN,"CWD %s\r\n",fn); + } + } + } + + status = NET_SendRaw(sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(command,"250 ")) { + ffpmsg ("CWD error, no 250 seen (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + if (!strlen(newfn)) { + ffpmsg("Null file name (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + /* Always use binary mode */ + snprintf(tmpstr,MAXLEN,"TYPE I\r\n"); + status = NET_SendRaw(sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(command,"200 ")) { + ffpmsg ("TYPE I error, 200 not seen (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + status = NET_SendRaw(sock,"PASV\r\n",6,NET_DEFAULT); + + if (!(fgets(recbuf,MAXLEN,command))) { + ffpmsg ("PASV error (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + /* 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_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + *passive = '\0'; + passive++; + ip[0] = '\0'; + + /* Messy parsing of response from PASV command */ + + if (!(tstr = ffstrtok(passive,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + strcpy(ip,tstr); + strcat(ip,"."); + + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + strcat(ip,tstr); + strcat(ip,"."); + + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + strcat(ip,tstr); + strcat(ip,"."); + + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + strcat(ip,tstr); + + /* Done the ip number, now do the port # */ + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + sscanf(tstr,"%d",&port); + port *= 256; + + if (!(tstr = ffstrtok(NULL,",)",&saveptr))) { + ffpmsg ("PASV error (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + sscanf(tstr,"%d",&tmpint); + port += tmpint; + + if (!strlen(newfn)) { + ffpmsg("Null file name (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + /* Connect to the data port */ + sock1 = NET_TcpConnect(ip,port); + if (NULL == (ftpfile = fdopen(sock1,"r"))) { + ffpmsg ("Could not connect to passive port (ftp_file_exist)"); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + /* Send the retrieve command */ + snprintf(tmpstr,MAXLEN,"RETR %s\r\n",newfn); + status = NET_SendRaw(sock,tmpstr,strlen(tmpstr),NET_DEFAULT); + + if (ftp_status(command,"150 ")) { + fclose(ftpfile); + NET_SendRaw(sock1,"QUIT\r\n",6,NET_DEFAULT); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; + } + + /* if we got here then the file probably exists */ + + fclose(ftpfile); + NET_SendRaw(sock1,"QUIT\r\n",6,NET_DEFAULT); + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 1; + } + + /* no passive mode */ + + fclose(command); + NET_SendRaw(sock,"QUIT\r\n",6,NET_DEFAULT); + return 0; +} + +/*--------------------------------------------------------------------------*/ +/* return a socket which results from connection to hostname on port port */ +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("ERROR: NET_TcpConnect 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; + } + } + + 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; + + if (strlen(urlcopy) > SHORTLEN-1) + { + free(urlcopyorig); + return 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 */ + if (strlen(urlcopy) > SHORTLEN-1) + { + free(urlcopyorig); + return 1; + } + 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) { + if (strlen(urlcopy) > MAXLEN-1) + { + free(urlcopyorig); + return 1; + } + strcpy(fn,urlcopy); + } + free(urlcopyorig); + return 0; +} + +/*--------------------------------------------------------------------------*/ +int http_checkfile (char *urltype, char *infile, char *outfile1) +{ + +/* Small helper functions to set the netoutfile static string */ +/* Called by cfileio after parsing the output file off of the input file url */ + + char newinfile[MAXLEN]; + FILE *httpfile=0; + char contentencoding[MAXLEN], contenttype[MAXLEN]; + int contentlength; + int foundfile = 0; + int status=0; + + /* set defaults */ + strcpy(urltype,"http://"); + + if (strlen(outfile1)) { + /* don't copy the "file://" prefix, if present. */ + if (!strncmp(outfile1, "file://", 7) ) { + strcpy(netoutfile,outfile1+7); + } else { + strcpy(netoutfile,outfile1); + } + } + + if (strstr(infile, "?")) { + /* Special case where infile name contains a "?". */ + /* This is probably a CGI string; no point in testing if it exists */ + /* so just set urltype and netoutfile if necessary, then return */ + + if (strlen(outfile1)) { /* was an outfile specified? */ + strcpy(urltype,"httpfile://"); + + /* don't copy the "file://" prefix, if present. */ + if (!strncmp(outfile1, "file://", 7) ) { + strcpy(netoutfile,outfile1+7); + } else { + strcpy(netoutfile,outfile1); + } + } + return 0; /* case where infile name contains "?" */ + } + + /* + If the specified infile file name does not contain a .gz or .Z suffix, + then first test if a .gz compressed version of the file exists, and if not + then test if a .Z version of the file exists. (because it will be much + faster to read the compressed file). If the compressed files do not exist, + then finally just open the infile name exactly as specified. + */ + + if (!strstr(infile,".gz") && (!strstr(infile,".Z"))) { + /* The infile string does not contain the name of a compressed file. */ + /* Fisrt, look for a .gz compressed version of the file. */ + + if (strlen(infile) + 3 > MAXLEN-1) + { + return URL_PARSE_ERROR; + } + strcpy(newinfile,infile); + strcat(newinfile,".gz"); + + status = http_open_network(newinfile,&httpfile, contentencoding, + contenttype, &contentlength); + if (!status) { + if (!strcmp(contentencoding, "ftp://")) { + /* this is a signal from http_open_network that indicates that */ + /* the http server returned a 301 or 302 redirect to a FTP URL. */ + /* Check that the file exists, because redirect many not be reliable */ + + if (ftp_file_exist(newinfile)>0) { + /* The ftp .gz compressed file is there, all is good! */ + strcpy(urltype, "ftp://"); + if (strlen(newinfile) > FLEN_FILENAME-1) + { + return URL_PARSE_ERROR; + } + strcpy(infile,newinfile); + + if (strlen(outfile1)) { + /* there is an output file; might need to modify the urltype */ + + 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 */ + } else { + /* input file is compressed */ + if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) { + strcpy(urltype,"ftpcompress://"); + } else { + strcpy(urltype,"ftpfile://"); + } + } + } + + return 0; /* found the .gz compressed ftp file */ + } + /* fall through to here if ftp redirect does not exist */ + } else if (!strcmp(contentencoding, "https://")) { + /* the http server returned a 301 or 302 redirect to an HTTPS URL. */ + https_checkfile(urltype, infile, outfile1); + /* For https we're not testing for compressed extensions at + this stage. It will all be done in https_open_network. Therefore + leave infile alone and do immediate return. */ + return 0; + } else { + /* found the http .gz compressed file */ + if (httpfile) + fclose(httpfile); + foundfile = 1; + if (strlen(newinfile) > FLEN_FILENAME-1) + { + return URL_PARSE_ERROR; + } + strcpy(infile,newinfile); + } + } + else if (status != FILE_NOT_OPENED) + { + /* Some other error occured aside from not finding file, such as + a url parsing error. Don't continue trying with other extensions. */ + return status; + } + + if (!foundfile) { + /* did not find .gz compressed version of the file, so look for .Z file. */ + + if (strlen(infile+2) > MAXLEN-1) + { + return URL_PARSE_ERROR; + } + strcpy(newinfile,infile); + strcat(newinfile,".Z"); + if (!http_open_network(newinfile,&httpfile, contentencoding, + contenttype, &contentlength)) { + + if (!strcmp(contentencoding, "ftp://")) { + /* this is a signal from http_open_network that indicates that */ + /* the http server returned a 301 or 302 redirect to a FTP URL. */ + /* Check that the file exists, because redirect many not be reliable */ + + if (ftp_file_exist(newinfile)>0) { + /* The ftp .Z compressed file is there, all is good! */ + strcpy(urltype, "ftp://"); + if (strlen(newinfile) > FLEN_FILENAME-1) + { + return URL_PARSE_ERROR; + } + strcpy(infile,newinfile); + + if (strlen(outfile1)) { + /* there is an output file; might need to modify the urltype */ + + 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 */ + } else { + /* input file is compressed */ + if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) { + strcpy(urltype,"ftpcompress://"); + } else { + strcpy(urltype,"ftpfile://"); + } + } + } + return 0; /* found the .Z compressed ftp file */ + } + /* fall through to here if ftp redirect does not exist */ + } else { + /* found the http .Z compressed file */ + if (httpfile) + fclose(httpfile); + foundfile = 1; + if (strlen(newinfile) > FLEN_FILENAME-1) + { + return URL_PARSE_ERROR; + } + strcpy(infile,newinfile); + } + } + } + } /* end of case where infile does not contain .gz or .Z */ + + if (!foundfile) { + /* look for the base file.name */ + + strcpy(newinfile,infile); + if (!http_open_network(newinfile,&httpfile, contentencoding, + contenttype, &contentlength)) { + + if (!strcmp(contentencoding, "ftp://")) { + /* this is a signal from http_open_network that indicates that */ + /* the http server returned a 301 or 302 redirect to a FTP URL. */ + /* Check that the file exists, because redirect many not be reliable */ + + if (ftp_file_exist(newinfile)>0) { + /* The ftp file is there, all is good! */ + strcpy(urltype, "ftp://"); + if (strlen(newinfile) > FLEN_FILENAME-1) + { + return URL_PARSE_ERROR; + } + strcpy(infile,newinfile); + + if (strlen(outfile1)) { + /* there is an output file; might need to modify the urltype */ + + 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; + } else { + + /* input file is not compressed */ + strcpy(urltype,"ftpfile://"); + } + } + return 0; /* found the ftp file */ + } + /* fall through to here if ftp redirect does not exist */ + } else if (!strcmp(contentencoding, "https://")) { + /* the http server returned a 301 or 302 redirect to an HTTPS URL. */ + https_checkfile(urltype, infile, outfile1); + /* For https we're not testing for compressed extensions at + this stage. It will all be done in https_open_network. Therefore + leave infile alone and do immediate return. */ + return 0; + } else { + /* found the base named file */ + if (httpfile) + fclose(httpfile); + foundfile = 1; + if (strlen(newinfile) > FLEN_FILENAME-1) + { + return URL_PARSE_ERROR; + } + strcpy(infile,newinfile); + } + + } + } + + if (!foundfile) { + return (FILE_NOT_OPENED); + } + + if (strlen(outfile1)) { + /* there is an output file */ + + 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; */ + strcpy(urltype,"httpfile://"); + return 0; + } + + 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; +} + +/*--------------------------------------------------------------------------*/ +int https_checkfile (char *urltype, char *infile, char *outfile1) +{ + /* set default */ + strcpy(urltype,"https://"); + + if (strlen(outfile1)) + { + /* 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)) + strcpy(urltype,"httpsmem://"); + else + strcpy(urltype,"httpsfile://"); + } + + return 0; +} + +/*--------------------------------------------------------------------------*/ +int ftps_checkfile (char *urltype, char *infile, char *outfile1) +{ + strcpy(urltype,"ftps://"); + if (strlen(outfile1)) + { + /* 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)) + strcpy(urltype,"ftpsmem://"); + else + { + if (strstr(outfile1,".gz") || strstr(outfile1,".Z")) + { + /* Note that for Curl dependent handlers, we can't check + at this point if infile will have a .gz or .Z appended. + If it does not, the ftpscompress 'open' handler will fail.*/ + strcpy(urltype,"ftpscompress://"); + } + else + strcpy(urltype,"ftpsfile://"); + } + } + return 0; +} + +/*--------------------------------------------------------------------------*/ +int ftp_checkfile (char *urltype, char *infile, char *outfile1) +{ + char newinfile[MAXLEN]; + FILE *ftpfile; + FILE *command; + int sock; + int foundfile = 0; + int status=0; + + /* Small helper functions to set the netoutfile static string */ + + /* default to ftp:// if no outfile specified */ + strcpy(urltype,"ftp://"); + + if (!strstr(infile,".gz") && (!strstr(infile,".Z"))) { + /* The infile string does not contain the name of a compressed file. */ + /* Fisrt, look for a .gz compressed version of the file. */ + + if (strlen(infile)+3 > MAXLEN-1) + { + return URL_PARSE_ERROR; + } + strcpy(newinfile,infile); + strcat(newinfile,".gz"); + + /* look for .gz version of the file */ + status = ftp_file_exist(newinfile); + if (status > 0) { + foundfile = 1; + if (strlen(newinfile) > FLEN_FILENAME-1) + return URL_PARSE_ERROR; + strcpy(infile,newinfile); + } + else if (status < 0) + { + /* Server is demanding an SSL connection. + Change urltype and exit. */ + ftps_checkfile(urltype, infile, outfile1); + return 0; + } + + if (!foundfile) { + if (strlen(infile)+2 > MAXLEN-1) + { + return URL_PARSE_ERROR; + } + strcpy(newinfile,infile); + strcat(newinfile,".Z"); + + /* look for .Z version of the file */ + if (ftp_file_exist(newinfile)) { + foundfile = 1; + if (strlen(newinfile) > FLEN_FILENAME-1) + return URL_PARSE_ERROR; + strcpy(infile,newinfile); + } + } + } + + if (!foundfile) { + strcpy(newinfile,infile); + + /* look for the base file */ + status = ftp_file_exist(newinfile); + if (status > 0) { + foundfile = 1; + if (strlen(newinfile) > FLEN_FILENAME-1) + return URL_PARSE_ERROR; + strcpy(infile,newinfile); + } + else if (status < 0) + { + /* Server is demanding an SSL connection. + Change urltype and exit. */ + ftps_checkfile(urltype, infile, outfile1); + return 0; + } + } + + if (!foundfile) { + return (FILE_NOT_OPENED); + } + + if (strlen(outfile1)) { + /* there is an output file; might need to modify the urltype */ + + /* 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 (strstr(infile,".gz") || (strstr(infile,".Z"))) { + /* input file is compressed */ + if (strstr(outfile1,".gz") || (strstr(outfile1,".Z"))) { + strcpy(urltype,"ftpcompress://"); + } else { + strcpy(urltype,"ftpfile://"); + } + } else { + strcpy(urltype,"ftpfile://"); + } + } + 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 */ + + /* Modified 2/19 to return the numerical value of the returned status when + it differs from the requested status. */ + + char recbuf[MAXLEN], errorstr[SHORTLEN]; + int len, ftpcode=0; + + len = strlen(statusstr); + while (1) { + + if (!(fgets(recbuf,MAXLEN,ftp))) { + snprintf(errorstr,SHORTLEN,"ERROR: ftp_status wants %s but fgets returned 0",statusstr); + ffpmsg(errorstr); + return 1; /* error reading */ + } + + 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. */ + snprintf(errorstr,SHORTLEN,"ERROR ftp_status wants %s but got %s", statusstr, recbuf); + ffpmsg(errorstr); + /* Return the numerical code, if string can be converted to int. + But must not return 0 from here. */ + ftpcode = atoi(recbuf); + return ftpcode ? ftpcode : 1; + } + snprintf(errorstr,SHORTLEN,"ERROR ftp_status wants %s but got unexpected %s", statusstr, recbuf); + ffpmsg(errorstr); + } +} + +/* + *---------------------------------------------------------------------- + * + * 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 */ + snprintf(msg,SHORTLEN,"%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); + } + + 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 */ + snprintf(msg,SHORTLEN,"%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); + + 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 */ + if (strlen(url)+7 > MAXLEN-1) + { + ffpmsg("Error: url too long"); + return(FILE_NOT_OPENED); + } + strcpy(turl,"root://"); + strcat(turl,url); + if (NET_ParseUrl(turl,proto,host,&port,fn)) { + snprintf(errorstr,MAXLEN,"URL Parse Error (root_open) %s",url); + ffpmsg(errorstr); + return (FILE_NOT_OPENED); + } + + /* Connect to the remote host */ + *sock = NET_TcpConnect(host,port); + if (*sock < 0) { + ffpmsg("Couldn't connect to host (root_openfile)"); + return (FILE_NOT_OPENED); + } + + /* get the username */ + if (NULL != getenv("ROOTUSERNAME")) { + if (strlen(getenv("ROOTUSERNAME")) > MAXLEN-1) + { + ffpmsg("root user name too long (root_openfile)"); + return (FILE_NOT_OPENED); + } + 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); + } + + if (op != ROOTD_AUTH) { + ffpmsg("ERROR on ROOTD_USER"); + ffpmsg(recbuf); + return (FILE_NOT_OPENED); + } + + + /* now the password */ + if (NULL != getenv("ROOTPASSWORD")) { + if (strlen(getenv("ROOTPASSWORD")) > MAXLEN-1) + { + ffpmsg("root password too long (root_openfile)"); + return (FILE_NOT_OPENED); + } + 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 MAXLEN-1) + { + ffpmsg("root file name too long (root_openfile)"); + return (FILE_NOT_OPENED); + } + 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); + } + + 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 + + + + + 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); + hdr[1] = htonl(op); + + 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 + + + + */ + + int recv1 = 0; + int len; + int status; + char recbuf[MAXLEN]; + + status = NET_RecvRaw(sock,&len,4); + + if (status < 0) { + return status; + } + recv1 += status; + + len = ntohl(len); + + /* 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); + + 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 +#include +#include +#include +#include +#include +#include + +#if defined(unix) || defined(__unix__) || defined(__unix) || defined(HAVE_UNISTD_H) +#include +#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>\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="); + snprintf(buf, 1000,"%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>\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 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_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/vendor/cfitsio/drvrsmem.h b/vendor/cfitsio/drvrsmem.h new file mode 100644 index 000000000..52ac7d7c8 --- /dev/null +++ b/vendor/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 /* this is necessary for Solaris/Linux */ +#include +#include + +#ifdef _AIX +#include +#else +#include +#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/vendor/cfitsio/editcol.c b/vendor/cfitsio/editcol.c new file mode 100644 index 000000000..43cdcbbcd --- /dev/null +++ b/vendor/cfitsio/editcol.c @@ -0,0 +1,3227 @@ +/* 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 +#include +#include +#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 4 special cases that represent unsigned integers + or signed bytes */ + if (longbitpix == USHORT_IMG) + longbitpix = SHORT_IMG; + else if (longbitpix == ULONG_IMG) + longbitpix = LONG_IMG; + else if (longbitpix == SBYTE_IMG) + longbitpix = BYTE_IMG; + else if (longbitpix == ULONGLONG_IMG) + longbitpix = LONGLONG_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) + { + snprintf(message, FLEN_ERRMSG, + "Illegal value for BITPIX keyword: %d", bitpix); + ffpmsg(message); + return(*status = BAD_BITPIX); + } + + if (naxis < 0 || naxis > 999) + { + snprintf(message, FLEN_ERRMSG, + "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) + { + snprintf(message, FLEN_ERRMSG, + "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 * (labs(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 + or a signed byte 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); + } + else if (bitpix == ULONGLONG_IMG) + { + strcpy(comment, "offset data range to that of unsigned long long"); + ffukyg(fptr, "BZERO", 9223372036854775808., 0, comment, status); + strcpy(comment, "default scaling factor"); + ffukyg(fptr, "BSCALE", 1.0, 0, comment, status); + } + else if (bitpix == SBYTE_IMG) + { + strcpy(comment, "offset data range to that of signed byte"); + ffukyg(fptr, "BZERO", -128., 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; + char card[FLEN_CARD]; + 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 (fficls)"); + 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++) + { + if (strlen(tform[ii]) > FLEN_VALUE-1) + { + ffpmsg("Column format string too long (fficls)"); + return (*status=BAD_TFORM); + } + 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 */ + if (strchr(tfm, 'Q')) + delbyte += 16; + else + 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 if (abs(datacode) == TULONGLONG) + { + /* Replace the 'W' with an 'K' in the TFORMn code */ + cptr = tfm; + while (*cptr != 'W') + cptr++; + + *cptr = 'K'; + ffpkys(fptr, keyname, tfm, comm, status); + + /* write the TZEROn and TSCALn keywords */ + ffkeyn("TZERO", colnum, card, status); + strcat(card, " "); /* make sure name is >= 8 chars long */ + *(card+8) = '\0'; + strcat(card, "= 9223372036854775808 / offset for unsigned integers"); + fits_write_record(fptr, card, 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); + + /* Must reset colptr before using it again. (fptr->Fptr)->tableptr + may have been reallocated down in ffbinit via the call to ffiblk above.*/ + colptr = (fptr->Fptr)->tableptr; + colptr += (colnum - 1); + + 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 snprintf is platform dependent ( %lld, %ld, %I64d ) */ + + snprintf(tfm,FLEN_VALUE,"%.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, otypecode, etypecode, anynull; + int inHduType, outHduType; + long tfields, repeat, orepeat, width, owidth, 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; + long long int *jjvalues = 0; + unsigned long long int *ujjvalues = 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 */ + inHduType = (infptr->Fptr)->hdutype; + + 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 */ + outHduType = (outfptr->Fptr)->hdutype; + + if (*status > 0) + return(*status); + + if (inHduType == IMAGE_HDU || outHduType == IMAGE_HDU) + { + ffpmsg + ("Can not copy columns to or from IMAGE HDUs (ffcpcl)"); + return(*status = NOT_TABLE); + } + + if ( inHduType == BINARY_TBL && outHduType == 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); + /* ... and equivalent type code */ + ffeqty(infptr, incol, &etypecode, 0, 0, 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 (inHduType == ASCII_TBL && outHduType == 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); + } + + if ((infptr->Fptr == outfptr->Fptr) + && (infptr->HDUposition == outfptr->HDUposition) + && (colnum <= incol)) { + incol++; /* the input column has been shifted over */ + } + + /* 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 (inHduType == ASCII_TBL && outHduType == 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; + /* get the datatype and vector repeat length of the output column */ + ffgtcl(outfptr, outcol, &otypecode, &orepeat, &owidth, status); + + if (orepeat != repeat) { + ffpmsg("Input and output vector columns must have same length (ffcpcl)"); + return(*status = BAD_TFORM); + } + } + + 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 + 7) / 8; /* convert from bits to bytes */ + else if (typecode == TSTRING && inHduType == 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.; + } + /* These are unsigned long-long ints that are not rescaled to floating point numbers */ + else if (typecode == TLONGLONG && etypecode == TULONGLONG) { + + ujjvalues = (unsigned long long int *) calloc(maxloop, sizeof(unsigned long long int) ); + if (!ujjvalues) + { + ffpmsg + ("malloc failed to get memory for unsigned long long int (ffcpcl)"); + return(*status = ARRAY_TOO_BIG); + } + } + /* These are long-long ints that are not rescaled to floating point numbers */ + else if (typecode == TLONGLONG && etypecode != TDOUBLE) { + + jjvalues = (long long int *) calloc(maxloop, sizeof(long long int) ); + if (!jjvalues) + { + ffpmsg + ("malloc failed to get memory for long long int (ffcpcl)"); + return(*status = ARRAY_TOO_BIG); + } + } + else /* other 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); + + /* Neither TULONGLONG nor TLONGLONG does null checking. Whatever + null value is in input table is transferred to output table + without checking. Since the TNULL value was copied, this + should preserve null values */ + else if (typecode == TLONGLONG && etypecode == TULONGLONG) + ffgcvujj(infptr, incol, firstrow, firstelem, ntodo, /*nulval*/ 0, + ujjvalues, &anynull, status); + + else if (typecode == TLONGLONG && etypecode != TDOUBLE) + ffgcvjj(infptr, incol, firstrow, firstelem, ntodo, /*nulval*/ 0, + jjvalues, &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 if (typecode == TLONGLONG && etypecode == TULONGLONG) + { /* No null checking because we did none to read */ + ffpclujj(outfptr, colnum, firstrow, firstelem, ntodo, + ujjvalues, status); + } + else if (typecode == TLONGLONG && etypecode != TDOUBLE) + { /* No null checking because we did none to read */ + ffpcljj(outfptr, colnum, firstrow, firstelem, ntodo, + jjvalues, 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); + } + if (ujjvalues) free(ujjvalues); + if (jjvalues) free(jjvalues); + if (dvalues) free(dvalues); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffccls(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int incol, /* I - number of first input column */ + int outcol, /* I - number for first output column */ + int ncols, /* I - number of columns to copy from input to output */ + int create_col, /* I - create new col if TRUE, else overwrite */ + int *status) /* IO - error status */ +/* + copy multiple columns from infptr and insert them in the outfptr + table. Optimized for multiple-column case since it only expands the + output file once using fits_insert_cols() instead of calling + fits_insert_col() multiple times. +*/ +{ + int tstatus, colnum, typecode, otypecode, anynull; + int inHduType, outHduType; + long tfields, repeat, orepeat, width, owidth, 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; + int typecodes[1000]; + char *ttypes[1000], *tforms[1000], keyarr[1001][FLEN_CARD]; + int ikey = 0; + int icol, incol1, outcol1; + + if (*status > 0) + return(*status); + + /* Do not allow more than internal array limit to be copied */ + if (ncols > 1000) return (*status = ARRAY_TOO_BIG); + + 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 */ + inHduType = (infptr->Fptr)->hdutype; + + 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 */ + outHduType = (outfptr->Fptr)->hdutype; + + if (*status > 0) + return(*status); + + if (inHduType == IMAGE_HDU || outHduType == IMAGE_HDU) + { + ffpmsg + ("Can not copy columns to or from IMAGE HDUs (ffccls)"); + return(*status = NOT_TABLE); + } + + if ( (inHduType == BINARY_TBL && outHduType == ASCII_TBL) || + (inHduType == ASCII_TBL && outHduType == BINARY_TBL) ) + { + ffpmsg + ("Copying between Binary and ASCII tables is not supported (ffccls)"); + return(*status = NOT_BTABLE); + } + + /* Do not allow copying multiple columns in the same HDU because the + permutations of possible overlapping copies is mind-bending */ + if ((infptr->Fptr == outfptr->Fptr) + && (infptr->HDUposition == outfptr->HDUposition)) + { + ffpmsg + ("Copying multiple columns in same HDU is not supported (ffccls)"); + return(*status = NOT_BTABLE); + } + + /* Retrieve the number of columns in output file */ + tstatus=0; + if (ffgkyj(outfptr, "TFIELDS", &tfields, 0, &tstatus)) + { + ffpmsg + ("Could not read TFIELDS keyword in output table (ffccls)"); + return(*status = NO_TFIELDS); + } + + colnum = minvalue((int) tfields + 1, outcol); /* output col. number */ + + /* Collect data about input column (type, repeat, etc) */ + for (incol1 = incol, outcol1 = colnum, icol = 0; + icol < ncols; + icol++, incol1++, outcol1++) + { + ffgtcl(infptr, incol1, &typecode, &repeat, &width, status); + + if (typecode < 0) + { + ffpmsg("Variable-length columns are not supported (ffccls)"); + return(*status = BAD_TFORM); + } + + typecodes[icol] = typecode; + + tstatus = 0; + ffkeyn("TTYPE", incol1, keyname, &tstatus); + ffgkys(infptr, keyname, ttype, ttype_comm, &tstatus); + + ffkeyn("TFORM", incol1, keyname, &tstatus); + + if (ffgkys(infptr, keyname, tform, tform_comm, &tstatus) ) + { + ffpmsg + ("Could not find TTYPE and TFORM keywords in input table (ffccls)"); + return(*status = NO_TFORM); + } + + /* If creating columns, we need to save these values */ + if ( create_col ) { + tforms[icol] = keyarr[ikey++]; + ttypes[icol] = keyarr[ikey++]; + + strcpy(tforms[icol], tform); + strcpy(ttypes[icol], ttype); + } else { + /* If not creating columns, then check the datatype and vector + repeat length of the output column */ + ffgtcl(outfptr, outcol1, &otypecode, &orepeat, &owidth, status); + + if (orepeat != repeat) { + ffpmsg("Input and output vector columns must have same length (ffccls)"); + return(*status = BAD_TFORM); + } + } + } + + /* Insert columns into output file and copy all meta-data + keywords, if requested */ + if (create_col) + { + /* create the empty columns */ + if (fficls(outfptr, colnum, ncols, ttypes, tforms, status) > 0) + { + ffpmsg + ("Could not append new columns to output file (ffccls)"); + return(*status); + } + + /* Copy meta-data strings from input column to output */ + for (incol1 = incol, outcol1 = colnum, icol = 0; + icol < ncols; + icol++, incol1++, outcol1++) + { + /* copy the comment strings from the input file for TTYPE and TFORM */ + ffkeyn("TTYPE", incol1, keyname, status); + ffgkys(infptr, keyname, ttype, ttype_comm, status); + ffkeyn("TTYPE", outcol1, keyname, status); + ffmcom(outfptr, keyname, ttype_comm, status); + + ffkeyn("TFORM", incol1, keyname, status); + ffgkys(infptr, keyname, tform, tform_comm, status); + ffkeyn("TFORM", outcol1, keyname, status); + ffmcom(outfptr, keyname, tform_comm, status); + + /* copy other column-related keywords if they exist */ + + ffcpky(infptr, outfptr, incol1, outcol1, "TUNIT", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TSCAL", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TZERO", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TDISP", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TLMIN", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TLMAX", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TDIM", status); + + /* WCS keywords */ + ffcpky(infptr, outfptr, incol1, outcol1, "TCTYP", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TCUNI", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TCRVL", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TCRPX", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TCDLT", status); + ffcpky(infptr, outfptr, incol1, outcol1, "TCROT", status); + + ffcpky(infptr, outfptr, incol1, outcol1, "TNULL", status); + + } + + /* rescan header to recognize the new keywords */ + if (ffrdef(outfptr, status) ) + return(*status); + } + + /* Copy columns using standard ffcpcl(); do this in a loop because + the I/O-intensive column expanding is done */ + for (incol1 = incol, outcol1 = colnum, icol = 0; + icol < ncols; + icol++, incol1++, outcol1++) + { + ffcpcl(infptr, outfptr, incol1, outcol1, 0, status); + } + + 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, icol; + LONGLONG iVarCol, inPos, outPos, nVarBytes, nVarAllocBytes = 0; + unsigned char *buffer, *varColBuff=0; + int nInVarCols=0, nOutVarCols=0, varColDiff=0; + int *inVarCols=0, *outVarCols=0; + long nNewBlocks; + LONGLONG hrepeat=0, hoffset=0; + tcolumn *colptr=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 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); + } + + if ((infptr->Fptr)->tfield != (outfptr->Fptr)->tfield) + { + ffpmsg + ("Input and output tables do not have same number of columns (ffcprw)"); + return(*status = BAD_COL_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); + } + + inVarCols = malloc(infptr->Fptr->tfield*sizeof(int)); + outVarCols = malloc(outfptr->Fptr->tfield*sizeof(int)); + fffvcl(infptr, &nInVarCols, inVarCols, status); + fffvcl(outfptr, &nOutVarCols, outVarCols, status); + if (nInVarCols != nOutVarCols) + varColDiff=1; + else + { + for (ii=0; iiFptr)->tableptr; + for (icol=0; icol<(infptr->Fptr)->tfield; ++icol) + { + if (iVarCol < nInVarCols && inVarCols[iVarCol] == icol+1) + { + /* Copy from a variable length column */ + + ffgdesll(infptr, icol+1, ii, &hrepeat, &hoffset, status); + /* If this is a bit column, hrepeat will be number of + bits, not bytes. If it is a string column, hrepeat + is the number of bytes, twidth is the max col width + and can be ignored.*/ + if (colptr->tdatatype == -TBIT) + { + nVarBytes = (hrepeat+7)/8; + } + else if (colptr->tdatatype == -TSTRING) + { + nVarBytes = hrepeat; + } + else + { + nVarBytes = hrepeat*colptr->twidth*sizeof(char); + } + inPos = (infptr->Fptr)->datastart + (infptr->Fptr)->heapstart + + hoffset; + outPos = (outfptr->Fptr)->datastart + (outfptr->Fptr)->heapstart + + (outfptr->Fptr)->heapsize; + ffmbyt(infptr, inPos, REPORT_EOF, 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 ( !((outfptr->Fptr)->lasthdu) ) + { + if (outPos+nVarBytes > + (outfptr->Fptr)->headstart[(outfptr->Fptr)->curhdu+1]) + { + nNewBlocks = (long)(((outPos+nVarBytes - 1 - + (outfptr->Fptr)->headstart[(outfptr->Fptr)-> + curhdu+1]) / 2880) + 1); + if (ffiblk(outfptr, nNewBlocks, 1, status) > 0) + { + ffpmsg("Failed to extend the size of the variable length heap (ffcprw)"); + goto CLEANUP_RETURN; + } + + } + } + if (nVarBytes) + { + if (nVarBytes > nVarAllocBytes) + { + /* Grow the copy buffer to accomodate the new maximum size. + Note it is safe to call realloc() with null input pointer, + which is equivalent to malloc(). */ + unsigned char *varColBuff1 = (unsigned char *) realloc(varColBuff, nVarBytes); + if (! varColBuff1) + { + *status = MEMORY_ALLOCATION; + ffpmsg("failed to allocate memory for variable column copy (ffcprw)"); + goto CLEANUP_RETURN; + } + /* Record the new state */ + varColBuff = varColBuff1; + nVarAllocBytes = nVarBytes; + } + /* Copy date from input to output */ + ffgbyt(infptr, nVarBytes, varColBuff, status); + ffmbyt(outfptr, outPos, IGNORE_EOF, status); + ffpbyt(outfptr, nVarBytes, varColBuff, status); + } + ffpdes(outfptr, icol+1, jj, hrepeat, (outfptr->Fptr)->heapsize, status); + (outfptr->Fptr)->heapsize += nVarBytes; + ++iVarCol; + } + ++colptr; + } + ++jj; + } + } + else + { + /* copy the rows, 1 at a time */ + 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); + + CLEANUP_RETURN: + free(buffer); + free(inVarCols); + free(outVarCols); + if (varColBuff) free(varColBuff); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcpsr(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 */ + char *row_status, /* I - quality list of rows to keep (1) or not keep (0) */ + 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, i0, icol; + LONGLONG iVarCol, inPos, outPos, nVarBytes, nVarAllocBytes = 0; + unsigned char *buffer, *varColBuff=0; + int nInVarCols=0, nOutVarCols=0, varColDiff=0; + int *inVarCols=0, *outVarCols=0; + long nNewBlocks; + LONGLONG hrepeat=0, hoffset=0; + tcolumn *colptr=0; + LONGLONG n_good_rows = nrows; + + 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); + } + + if ((infptr->Fptr)->tfield != (outfptr->Fptr)->tfield) + { + ffpmsg + ("Input and output tables do not have same number of columns (ffcprw)"); + return(*status = BAD_COL_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); + } + + inVarCols = malloc(infptr->Fptr->tfield*sizeof(int)); + outVarCols = malloc(outfptr->Fptr->tfield*sizeof(int)); + fffvcl(infptr, &nInVarCols, inVarCols, status); + fffvcl(outfptr, &nOutVarCols, outVarCols, status); + if (nInVarCols != nOutVarCols) + varColDiff=1; + else + { + for (ii=0; iiFptr)->tableptr; + for (icol=0; icol<(infptr->Fptr)->tfield; ++icol) + { + if (iVarCol < nInVarCols && inVarCols[iVarCol] == icol+1) + { + /* Copy from a variable length column */ + + ffgdesll(infptr, icol+1, ii, &hrepeat, &hoffset, status); + /* If this is a bit column, hrepeat will be number of + bits, not bytes. If it is a string column, hrepeat + is the number of bytes, twidth is the max col width + and can be ignored.*/ + if (colptr->tdatatype == -TBIT) + { + nVarBytes = (hrepeat+7)/8; + } + else if (colptr->tdatatype == -TSTRING) + { + nVarBytes = hrepeat; + } + else + { + nVarBytes = hrepeat*colptr->twidth*sizeof(char); + } + inPos = (infptr->Fptr)->datastart + (infptr->Fptr)->heapstart + + hoffset; + outPos = (outfptr->Fptr)->datastart + (outfptr->Fptr)->heapstart + + (outfptr->Fptr)->heapsize; + ffmbyt(infptr, inPos, REPORT_EOF, 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 ( !((outfptr->Fptr)->lasthdu) ) + { + if (outPos+nVarBytes > + (outfptr->Fptr)->headstart[(outfptr->Fptr)->curhdu+1]) + { + nNewBlocks = (long)(((outPos+nVarBytes - 1 - + (outfptr->Fptr)->headstart[(outfptr->Fptr)-> + curhdu+1]) / 2880) + 1); + if (ffiblk(outfptr, nNewBlocks, 1, status) > 0) + { + ffpmsg("Failed to extend the size of the variable length heap (ffcprw)"); + goto CLEANUP_RETURN; + } + + } + } + if (nVarBytes) + { + if (nVarBytes > nVarAllocBytes) + { + /* Grow the copy buffer to accomodate the new maximum size. + Note it is safe to call realloc() with null input pointer, + which is equivalent to malloc(). */ + unsigned char *varColBuff1 = (unsigned char *) realloc(varColBuff, nVarBytes); + if (! varColBuff1) + { + *status = MEMORY_ALLOCATION; + ffpmsg("failed to allocate memory for variable column copy (ffcprw)"); + goto CLEANUP_RETURN; + } + /* Record the new state */ + varColBuff = varColBuff1; + nVarAllocBytes = nVarBytes; + } + /* Copy date from input to output */ + ffgbyt(infptr, nVarBytes, varColBuff, status); + ffmbyt(outfptr, outPos, IGNORE_EOF, status); + ffpbyt(outfptr, nVarBytes, varColBuff, status); + } + ffpdes(outfptr, icol+1, jj, hrepeat, (outfptr->Fptr)->heapsize, status); + (outfptr->Fptr)->heapsize += nVarBytes; + ++iVarCol; + } + ++colptr; + } + ++jj; + } + } + else + { + /* copy the rows, 1 at a time */ + n_good_rows = 0; + for (ii = firstrow, i0 = 0; i0 < nrows; i0++, ii++) + { + /* Ignore rows with row_status[] == 0 */ + if (row_status && !row_status[i0]) continue; + + fits_read_tblbytes (infptr, ii, 1, innaxis1, buffer, status); + fits_write_tblbytes(outfptr, jj, 1, innaxis1, buffer, status); + n_good_rows ++; + jj++; + } + } + outnaxis2 += n_good_rows; + fits_update_key(outfptr, TLONGLONG, "NAXIS2", &outnaxis2, 0, status); + + CLEANUP_RETURN: + free(buffer); + free(inVarCols); + free(outVarCols); + if (varColBuff) free(varColBuff); + 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; + /* If the last row hasn't yet been accessed in full, it's possible + that logfilesize hasn't been updated to account for it (by way + of an ffldrc call). This could cause ffgtbb to return with an + EOF error. To prevent this, we must increase logfilesize here. + */ + if ((fptr->Fptr)->logfilesize < (fptr->Fptr)->datastart + + (fptr->Fptr)->heapstart) + { + (fptr->Fptr)->logfilesize = (((fptr->Fptr)->datastart + + (fptr->Fptr)->heapstart + 2879)/2880)*2880; + } + + 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); + /* NOTE: because of null termination, it is not + equivalent to use strcpy() for the same calls */ + 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 fffvcl(fitsfile *fptr, /* I - FITS file pointer */ + int *nvarcols, /* O - Number of variable length columns found */ + int *colnums, /* O - 1-based variable column positions */ + int *status) /* IO - error status */ +{ +/* + Internal function to identify which columns in a binary table are variable length. + The colnums array will be filled with nvarcols elements - the 1-based numbers + of all variable length columns in the table. This ASSUMES calling function + has passed in a colnums array large enough to hold these (colnums==NULL also + allowed). +*/ + int tfields=0,icol; + tcolumn *colptr=0; + + *nvarcols = 0; + if (*status > 0) + return(*status); + + if ((fptr->Fptr)->hdutype != BINARY_TBL) + { + ffpmsg("Var-length column search can only be performed on Binary tables (fffvcl)"); + return(*status = NOT_BTABLE); + } + + if ((fptr->Fptr)->tableptr) + { + colptr = (fptr->Fptr)->tableptr; + tfields = (fptr->Fptr)->tfield; + for (icol=0; icoltdatatype < 0) + { + if (colnums) colnums[*nvarcols] = icol + 1; + *nvarcols += 1; + } + } + } + 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/vendor/cfitsio/edithdu.c b/vendor/cfitsio/edithdu.c new file mode 100644 index 000000000..835b4b223 --- /dev/null +++ b/vendor/cfitsio/edithdu.c @@ -0,0 +1,924 @@ +/* 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 +#include +#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) > 0) /* 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 ffcpht(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 the table structure from an existing table HDU, but only + copy a limited row range. All header keywords from the input + table are copied directly, but NAXSI2 and PCOUNT are set to their + correct values. +*/ +{ + if (*status > 0) + return(*status); + + /* Copy the header only */ + ffcphd(infptr, outfptr, status); + /* Note that we now have a copied header that describes the table, + and that is the current header, but the original number of table + rows and heap area sizes are still there. */ + + /* Zero out the size-related keywords */ + if (! *status ) { + ffukyj(outfptr,"NAXIS2",0,0,status); /* NAXIS2 = 0 */ + ffukyj(outfptr,"PCOUNT",0,0,status); /* PCOUNT = 0 */ + /* Update the internal structure variables within CFITSIO now + that we have a valid table header */ + ffrdef(outfptr,status); + } + + /* OK now that we have a pristine HDU, copy the requested rows */ + if (! *status && nrows > 0) { + ffcprw(infptr, outfptr, firstrow, nrows, status); + } + + 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 + { + snprintf(errmsg, FLEN_ERRMSG, + "Illegal value for BITPIX keyword: %d", bitpix); + ffpmsg(errmsg); + return(*status = BAD_BITPIX); /* illegal bitpix value */ + } + if (naxis < 0 || naxis > 999) + { + snprintf(errmsg, FLEN_ERRMSG, + "Illegal value for NAXIS keyword: %d", naxis); + ffpmsg(errmsg); + return(*status = BAD_NAXIS); + } + + for (ii = 0; ii < naxis; ii++) + { + if (naxes[ii] < 0) + { + snprintf(errmsg, FLEN_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[FLEN_ERRMSG], 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) + { + snprintf(errmsg, FLEN_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) + 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[FLEN_ERRMSG], 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) + { + snprintf(errmsg, FLEN_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) + 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/vendor/cfitsio/eval_defs.h b/vendor/cfitsio/eval_defs.h new file mode 100644 index 000000000..95dff54b5 --- /dev/null +++ b/vendor/cfitsio/eval_defs.h @@ -0,0 +1,205 @@ +#include +#include +#include +#include +#if defined(__sgi) || defined(__hpux) +#include +#endif +#ifdef sparc +#include +#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" + +typedef struct ParseData_struct ParseData; +typedef void* yyscan_t; +#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)(ParseData *, struct Node *this); + int nSubNodes; + int SubNodes[MAXSUBS]; + int type; + lval value; + } Node; + +struct ParseData_struct { + fitsfile *def_fptr; + int (*getData)( ParseData *, char *dataName, void *dataValue ); + int (*loadData)( ParseData *, 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; + long nElements; + int nAxis; + long nAxes[MAXDIMS]; + iteratorCol *colData; + DataInfo *varData; + PixelFilter *pixFilter; + + long firstDataRow; + long nDataRows; + long totalRows; + long nPrevDataRows; + + int datatype; + int hdutype; + + int status; +}; + +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, + setnull_fct, + gtiover_fct, + gtifind_fct, + elemnum_fct, + axiselem_fct, + array_fct + } funcOp; + + +typedef struct parseInfo_struct parseInfo; + +struct ParseStatusVariables { /* These variables were 'static' in fits_parse_workfn() */ + void *Data, *Null; + int datasize; + long lastRow, repeat, resDataSize; + LONGLONG jnull; + parseInfo *userInfo; + long zeros[4]; +}; + +struct parseInfo_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 */ + ParseData *parseData; /* Pointer to parser configuration */ + struct ParseStatusVariables parseVariables; +}; + +#ifdef __cplusplus +extern "C" { +#endif + +/* Not sure why this is needed but it is */ +#define YYSTYPE FITS_PARSER_YYSTYPE +/* How ParseData is accessed from the lexer, i.e. by yyextra */ +#define YY_EXTRA_TYPE ParseData * + + int fits_parser_yyparse(yyscan_t yyscaner, ParseData *lParse); + int fits_parser_yylex(FITS_PARSER_YYSTYPE *, yyscan_t yyscanner); + void fits_parser_yyrestart(FILE*, yyscan_t yyscanner); + int fits_parser_yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); + int fits_parser_yylex_destroy (yyscan_t scanner); + + void Evaluate_Parser( ParseData *lParse, long firstRow, long nRows ); + int fits_parser_allocateCol( ParseData *lParse, int nCol, int *status ); + int fits_parser_set_temporary_col(ParseData *lParse, parseInfo *Info, + long int nrows, void *nulval, int *status); + +#ifdef __cplusplus + } +#endif diff --git a/vendor/cfitsio/eval_f.c b/vendor/cfitsio/eval_f.c new file mode 100644 index 000000000..d9e163ed8 --- /dev/null +++ b/vendor/cfitsio/eval_f.c @@ -0,0 +1,2954 @@ +/************************************************************************/ +/* */ +/* 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 +#include +#include "eval_defs.h" +#include "region.h" + + +/* Internal routines needed to allow the evaluator to operate on FITS data */ + +static void Setup_DataArrays( ParseData *lParse, int nCols, iteratorCol *cols, + long fRow, long nRows ); +static int find_column( ParseData *lParse, char *colName, void *itslval ); +static int find_keywd ( ParseData *lParse, char *key, void *itslval ); +static int load_column( ParseData *lParse, 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; + ParseData lParse; + + if( *status ) return( *status ); + memset(&Info, 0, sizeof(Info)); + + if( ffiprs( fptr, 0, expr, MAXDIMS, &Info.datatype, &nelem, &naxis, + naxes, &lParse, status ) ) { + ffcprs(&lParse); + return( *status ); + } + if( nelem<0 ) { + constant = 1; + nelem = -nelem; + } else + constant = 0; + + if( Info.datatype!=TLOGICAL || nelem!=1 ) { + ffcprs(&lParse); + ffpmsg("Expression does not evaluate to a logical scalar."); + return( *status = PARSE_BAD_TYPE ); + } + + if( constant ) { /* No need to call parser... have result from ffiprs */ + result = lParse.Nodes[lParse.resultNode].value.data.log; + *n_good_rows = nrows; + for( elem=0; elem1 ? firstrow : 1); + Info.dataPtr = row_status; + Info.nullPtr = NULL; + Info.maxRows = nrows; + Info.parseData = &lParse; + + if( ffiter( lParse.nCols, lParse.colData, firstrow-1, 0, + fits_parser_workfn, (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; elemHDUposition != (infptr->Fptr)->curhdu ) + ffmahd( infptr, (infptr->HDUposition) + 1, NULL, status ); + if( *status ) { + ffcprs(&lParse); + 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(&lParse); + 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(&lParse); + 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(&lParse); + 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; + Info.parseData = &lParse; + if( !Info.dataPtr ) { + ffpmsg("Unable to allocate memory for row selection"); + ffcprs(&lParse); + 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 = lParse.Nodes[lParse.resultNode].value.data.log; + for( ntodo = 0; ntodo 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(&lParse); + + ffcmph(outfptr, status); /* compress heap, deleting any orphaned data */ + 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]; + ParseData lParse; + + if( *status ) return( *status ); + + memset(&Info, 0, sizeof(Info)); + + if( ffiprs( fptr, 0, expr, MAXDIMS, &Info.datatype, &nelem1, &naxis, + naxes, &lParse, status ) ) { + ffcprs(&lParse); + return( *status ); + } + if( nelem1<0 ) nelem1 = - nelem1; + + if( nelements1 ? firstrow : 1); + + if( datatype ) Info.datatype = datatype; + + Info.dataPtr = array; + Info.nullPtr = nulval; + Info.maxRows = nelements / nelem1; + Info.parseData = &lParse; + + if( ffiter( lParse.nCols, lParse.colData, firstrow-1, 0, + fits_parser_workfn, (void*)&Info, status ) == -1 ) + *status=0; /* -1 indicates exitted without error before end... OK */ + + *anynul = Info.anyNull; + ffcprs(&lParse); + 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]; + ParseData lParse; + + if( *status ) return( *status ); + + memset(&Info, 0, sizeof(Info)); + + if( ffiprs( infptr, 0, expr, MAXDIMS, &Info.datatype, &nelem, &naxis, + naxes, &lParse, status ) ) { + + ffcprs(&lParse); + return( *status ); + } + if( nelem<0 ) { + constant = 1; + nelem = -nelem; + } else + constant = 0; + + Info.parseData = &lParse; + /* 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(&lParse); + ffpmsg( "Cannot put tabular result into keyword (ffcalc)" ); + return( *status = PARSE_BAD_TYPE ); + } + parName++; /* Advance past '#' */ + if ( (fits_strcasecmp(parName,"HISTORY") == 0 || fits_strcasecmp(parName,"COMMENT") == 0) && + Info.datatype != TSTRING ) { + ffcprs(&lParse); + ffpmsg( "HISTORY and COMMENT values must be strings (ffcalc)" ); + return( *status = PARSE_BAD_TYPE ); + } + + } 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(&lParse); + 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( lParse.hdutype==BINARY_TBL ) { + snprintf(tform,15,"%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(&lParse); + ffpmsg("Cannot create LOGICAL column in ASCII table"); + return( *status = NOT_BTABLE ); + case TLONG: strcpy(tform,"I11"); break; + case TDOUBLE: strcpy(tform,"D23.15"); break; + case TSTRING: + case TBIT: snprintf(tform,16,"A%ld",nelem); break; + } + } + parInfo = tform; + } else if( !(isdigit((int) *parInfo)) && lParse.hdutype==BINARY_TBL ) { + if( Info.datatype==TBIT && *parInfo=='B' ) + nelem = (nelem+7)/8; + snprintf(tform,16,"%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( lParse.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 ) { + if (sizeof(long) == 8 && sizeof(int) == 4) + nullVal = INT_MIN; + else + 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( lParse.hdutype==ASCII_TBL ) { + ffpkys( outfptr, nullKwd, "NULL", "Null value string", status ); + fits_set_atblnull( outfptr, colNo, "NULL", status ); + newNullKwd = 1; + } + } + + } + + } else if( *status ) { + ffcprs(&lParse); + 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(&lParse); + 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 = lParse.nCols; + if( fits_parser_allocateCol( &lParse, col_cnt, status ) ) { + ffcprs(&lParse); + return( *status ); + } + + fits_iter_set_by_num( lParse.colData+col_cnt, outfptr, + colNo, 0, OutputCol ); + lParse.nCols++; + + for( i=0; i= 10) && (nRngs == 1) && + (start[0] == 1) && (end[0] == totaln)) + nPerLp = 0; + else + nPerLp = Info.maxRows; + + if( ffiter( lParse.nCols, lParse.colData, start[i]-1, + nPerLp, fits_parser_workfn, (void*)&Info, status ) == -1 ) + *status = 0; + else if( *status ) { + ffcprs(&lParse); + return( *status ); + } + if( Info.anyNull ) anyNull = 1; + } + + if( newNullKwd && !anyNull ) { + ffdkey( outfptr, nullKwd, status ); + } + + } else { + + /* Put constant result into keyword */ + + result = lParse.Nodes + lParse.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: + if (fits_strcasecmp(parName,"HISTORY") == 0) { + ffphis( outfptr, result->value.data.str, status); + } else if (fits_strcasecmp(parName,"COMMENT") == 0) { + ffpcom( outfptr, result->value.data.str, status); + } else { + ffukys( outfptr, parName, result->value.data.str, parInfo, status ); + } + break; + } + } + + ffcprs(&lParse); + 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. */ +/*--------------------------------------------------------------------------*/ +{ + ParseData lParse; + + ffiprs( fptr, 0, expr, maxdim, datatype, nelem, naxis, naxes, &lParse, status ); + ffcprs(&lParse); + 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 */ + ParseData *lParse, /* O - parser status */ + 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]; + yyscan_t yylex_scanner; /* Used internally by FLEX lexer */ + PixelFilter *pixFilter = 0; + + if( *status ) return( *status ); + + /* make sure all internal structures for this HDU are current */ + if ( ffrdef(fptr, status) ) return(*status); + + /* Initialize the Parser structure */ + + /* Unfortunately we need to preserve the pixFilter value since it + is pre-set when ffiprs() is called */ + pixFilter = lParse->pixFilter; + memset(lParse, 0, sizeof(*lParse)); + lParse->pixFilter = pixFilter; + + lParse->def_fptr = fptr; + lParse->compressed = compressed; + lParse->nCols = 0; + lParse->colData = NULL; + lParse->varData = NULL; + lParse->getData = find_column; + lParse->loadData = load_column; + lParse->Nodes = NULL; + lParse->nNodesAlloc= 0; + lParse->nNodes = 0; + lParse->hdutype = 0; + lParse->status = 0; + + fits_get_hdu_type(fptr, &(lParse->hdutype), status ); + + if (lParse->hdutype == IMAGE_HDU) { + + fits_get_img_param(fptr, 9, &bitpix, &xaxis, xaxes, status); + if (*status) { + ffpmsg("ffiprs: unable to get image dimensions"); + return( *status ); + } + lParse->totalRows = xaxis > 0 ? 1 : 0; + for (i = 0; i < xaxis; ++i) + lParse->totalRows *= xaxes[i]; + if (DEBUG_PIXFILTER) + printf("naxis=%d, lParse->totalRows=%ld\n", xaxis, lParse->totalRows); + } + else if( ffgkyj(fptr, "NAXIS2", &lParse->totalRows, 0, &tstatus) ) + { + /* this might be a 1D or null image with no NAXIS2 keyword */ + lParse->totalRows = 0; + } + + + /* Copy expression into parser... read from file if necessary */ + + + if( expr[0]=='@' ) { + if( ffimport_file( expr+1, &lParse->expr, status ) ) return( *status ); + lexpr = strlen(lParse->expr); + } else { + lexpr = strlen(expr); + lParse->expr = (char*)malloc( (2+lexpr)*sizeof(char)); + strcpy(lParse->expr,expr); + } + strcat(lParse->expr + lexpr,"\n"); + lParse->index = 0; + lParse->is_eobuf = 0; + + /* Parse the expression, building the Nodes and determing */ + /* which columns are needed and what data type is returned */ + + fits_parser_yylex_init_extra(lParse, &yylex_scanner); + fits_parser_yyrestart(NULL, yylex_scanner); + *status = fits_parser_yyparse(yylex_scanner, lParse); + fits_parser_yylex_destroy(yylex_scanner); + + if( *status ) return( *status = PARSE_SYNTAX_ERR ); + + /* Check results */ + *status = lParse->status; + if( *status ) return(*status); + + if( !lParse->nNodes ) { + ffpmsg("Blank expression"); + return( *status = PARSE_SYNTAX_ERR ); + } + if( !lParse->nCols ) { + lParse->colData = (iteratorCol *) malloc(sizeof(iteratorCol)); + if (lParse->colData == 0) { + ffpmsg("memory allocation failed (ffiprs)"); + return( *status = MEMORY_ALLOCATION ); + } + /* This allows iterator to know value of */ + /* fptr when no columns are referenced */ + memset(lParse->colData, 0, sizeof(iteratorCol)); + lParse->colData[0].fptr = fptr; + } + + result = lParse->Nodes + lParse->resultNode; + + *naxis = lParse->nAxis = result->value.naxis; + *nelem = lParse->nElements = result->value.nelem; + for( i=0; i<*naxis && inAxes[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 = lParse->status = PARSE_BAD_TYPE; + break; + } + lParse->datatype = *datatype; + FREE(lParse->expr); + + if( result->operation==CONST_OP ) *nelem = - *nelem; + return(*status); +} + +/*--------------------------------------------------------------------------*/ +void ffcprs( ParseData *lParse ) +/* */ +/* Clear the parser, making it ready to accept a new expression. */ +/*--------------------------------------------------------------------------*/ +{ + int col, node, i; + + if( lParse->nCols > 0 ) { + FREE( lParse->colData ); + for( col=0; colnCols; col++ ) { + if( lParse->varData[col].undef == NULL ) continue; + if( lParse->varData[col].type == BITSTR ) + FREE( ((char**)lParse->varData[col].data)[0] ); + free( lParse->varData[col].undef ); + } + FREE( lParse->varData ); + lParse->nCols = 0; + } else if ( lParse->colData ) { + /* Special case if colData needed to be created with no columns */ + FREE( lParse->colData ); + } + + if( lParse->nNodes > 0 ) { + node = lParse->nNodes; + while( node-- ) { + if( lParse->Nodes[node].operation==gtifilt_fct ) { + i = lParse->Nodes[node].SubNodes[0]; + if (lParse->Nodes[ i ].value.data.ptr) + FREE( lParse->Nodes[ i ].value.data.ptr ); + } + else if( lParse->Nodes[node].operation==regfilt_fct ) { + i = lParse->Nodes[node].SubNodes[0]; + fits_free_region( (SAORegion *)lParse->Nodes[ i ].value.data.ptr ); + } + } + lParse->nNodes = 0; + } + if( lParse->Nodes ) free( lParse->Nodes ); + lParse->Nodes = NULL; + + lParse->hdutype = ANY_HDU; + lParse->pixFilter = 0; + lParse->nDataRows = lParse->nPrevDataRows = 0; +} + +/*---------------------------------------------------------------------------*/ +int fits_parser_workfn( 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; + ParseData *lParse = ((parseInfo*)userPtr)->parseData; + struct ParseStatusVariables *pv = &( ((parseInfo*)userPtr)->parseVariables ); + void *Data0 = 0; + + /* declare variables static to preserve their values between calls */ + long zeros[4] = {0,0,0,0}; + + if (DEBUG_PIXFILTER) + printf("fits_parser_workfn(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) + { + (pv->userInfo) = (parseInfo*)userPtr; + (pv->userInfo)->anyNull = 0; + + /* Unfortunately there are two copies of the iterator columns, + one inside the parser and one outside maintained by the + higher level. (This could happen if the histogramming + routines are binning multiple columns, and so there are + multiple parsers being managed at one time.) Upon the first + call we make sure they match */ + for (jj = 0; jjcolData[jj].repeat = colData[jj].repeat; + } + + if( (pv->userInfo)->maxRows>0 ) + (pv->userInfo)->maxRows = minvalue(totalrows,(pv->userInfo)->maxRows); + else if( (pv->userInfo)->maxRows<0 ) + (pv->userInfo)->maxRows = totalrows; + else + (pv->userInfo)->maxRows = nrows; + + (pv->lastRow) = firstrow + (pv->userInfo)->maxRows - 1; + + /* dataPtr == NULL indicates an iterator-derived column, which + means that the first value will be a null value and the remaining + values will be the where the outputs are placed */ + if( (pv->userInfo)->dataPtr==NULL ) { + + if( outcol->iotype == InputCol ) { + ffpmsg("Output column for parser results not found!"); + return( PARSE_NO_OUTPUT ); + } + /* Data gets set later */ + (pv->Null) = outcol->array; + (pv->userInfo)->datatype = outcol->datatype; + + /* Check for a TNULL/BLANK keyword for output column/image */ + + status = 0; + (pv->jnull) = 0; + if (lParse->hdutype == IMAGE_HDU) { + if (lParse->pixFilter->blank) + (pv->jnull) = (LONGLONG) lParse->pixFilter->blank; + } + else { + if (outcol->iotype != TemporaryCol) { + ffgknjj( outcol->fptr, "TNULL", outcol->colnum, + 1, &(pv->jnull), (int*)&jj, &status ); + } + + if( status==BAD_INTKEY || outcol->iotype == TemporaryCol) { + /* Probably ASCII table with text TNULL keyword */ + switch( (pv->userInfo)->datatype ) { + case TSHORT: (pv->jnull) = (LONGLONG) SHRT_MIN; break; + case TINT: (pv->jnull) = (LONGLONG) INT_MIN; break; + case TLONG: (pv->jnull) = (LONGLONG) LONG_MIN; break; + } + } + } + (pv->repeat) = outcol->repeat; +/* + if (DEBUG_PIXFILTER) + printf("fits_parser_workfn: using null value %ld\n", (pv->jnull)); +*/ + } else { + + /* This clause applies if the user is passing user-allocated + data arrays, which is where the data will be placed. This + means they should also be passing null values */ + (pv->Data) = (pv->userInfo)->dataPtr; + (pv->Null) = ((pv->userInfo)->nullPtr ? (pv->userInfo)->nullPtr : zeros); + (pv->repeat) = lParse->Nodes[lParse->resultNode].value.nelem; + + } + + /* Determine the size of each element of the returned result */ + + switch( (pv->userInfo)->datatype ) { + case TBIT: /* Fall through to TBYTE */ + case TLOGICAL: /* Fall through to TBYTE */ + case TBYTE: (pv->datasize) = sizeof(char); break; + case TSHORT: (pv->datasize) = sizeof(short); break; + case TINT: (pv->datasize) = sizeof(int); break; + case TLONG: (pv->datasize) = sizeof(long); break; + case TLONGLONG: (pv->datasize) = sizeof(LONGLONG); break; + case TFLOAT: (pv->datasize) = sizeof(float); break; + case TDOUBLE: (pv->datasize) = sizeof(double); break; + case TSTRING: (pv->datasize) = sizeof(char*); break; + } + + /* Determine the size of each element of the calculated result */ + /* (only matters for numeric/logical data) */ + + switch( lParse->Nodes[lParse->resultNode].type ) { + case BOOLEAN: (pv->resDataSize) = sizeof(char); break; + case LONG: (pv->resDataSize) = sizeof(long); break; + case DOUBLE: (pv->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("fits_parser_workfn: using null value %ld\n", (pv->jnull)); +*/ + + if( (pv->userInfo)->dataPtr == NULL ) { + /* First, reset Data pointer to start of output array, plus 1 + because the 0th element is the null value (cute undocumented + feature of the iterator!) */ + (pv->Data) = (char*) outcol->array + (pv->datasize); + + /* A TemporaryCol with null value specified explicitly */ + if (outcol->iotype == TemporaryCol && (pv->userInfo)->nullPtr) { + + pv->Null = (pv->userInfo)->nullPtr; + + } else { + + /* ... or an OutputCol or TemporaryCol with no explicit null */ + switch( (pv->userInfo)->datatype ) { + case TLOGICAL: *(char *)(pv->Null) = 'U'; break; + case TBYTE: *(char *)(pv->Null) = (char )(pv->jnull); break; + case TSHORT: *(short *)(pv->Null) = (short)(pv->jnull); break; + case TINT: *(int *)(pv->Null) = (int )(pv->jnull); break; + case TLONG: *(long *)(pv->Null) = (long )(pv->jnull); break; + case TLONGLONG: *(LONGLONG *)(pv->Null) = (LONGLONG )(pv->jnull); break; + case TFLOAT: *(float *)(pv->Null) = FLOATNULLVALUE; break; + case TDOUBLE: *(double*)(pv->Null) = DOUBLENULLVALUE; break; + case TSTRING: (*(char **)(pv->Null))[0] = '\1'; + (*(char **)(pv->Null))[1] = '\0'; break; + } + } + } + + /* Alter nrows in case calling routine didn't want to do all rows */ + + Data0 = pv->Data; /* Record starting point */ + nrows = minvalue(nrows,(pv->lastRow)-firstrow+1); + + Setup_DataArrays( lParse, 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 10000 rows per iteration, so this is really only relevant for */ + /* hk-compressed files which must be decompressed in memory and sent */ + /* whole to fits_parser_workfn in a single iteration. */ + + remain = nrows; + while( remain ) { + ntodo = minvalue(remain,10000); + Evaluate_Parser ( lParse, firstrow, ntodo ); + if( lParse->status ) break; + + firstrow += ntodo; + remain -= ntodo; + + /* Copy results into data array */ + + result = lParse->Nodes + lParse->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; kkrepeat); jj++ ) + ffcvtn( lParse->datatype, + &(result->value.data), + &undef, result->value.nelem /* 1 */, + (pv->userInfo)->datatype, (pv->Null), + (char*)(pv->Data) + (kk*(pv->repeat)+jj)*(pv->datasize), + &anyNullThisTime, &lParse->status ); + } else { + if ( (pv->repeat) == result->value.nelem ) { + ffcvtn( lParse->datatype, + result->value.data.ptr, + result->value.undef, + result->value.nelem*ntodo, + (pv->userInfo)->datatype, (pv->Null), (pv->Data), + &anyNullThisTime, &lParse->status ); + } else if( result->value.nelem == 1 ) { + for( kk=0; kkrepeat); jj++ ) { + ffcvtn( lParse->datatype, + (char*)result->value.data.ptr + kk*(pv->resDataSize), + (char*)result->value.undef + kk, + 1, (pv->userInfo)->datatype, (pv->Null), + (char*)(pv->Data) + (kk*(pv->repeat)+jj)*(pv->datasize), + &anyNullThisTime, &lParse->status ); + } + } else { + int nCopy; + nCopy = minvalue( (pv->repeat), result->value.nelem ); + for( kk=0; kkdatatype, + (char*)result->value.data.ptr + + kk*result->value.nelem*(pv->resDataSize), + (char*)result->value.undef + + kk*result->value.nelem, + nCopy, (pv->userInfo)->datatype, (pv->Null), + (char*)(pv->Data) + (kk*(pv->repeat))*(pv->datasize), + &anyNullThisTime, &lParse->status ); + if( nCopy < (pv->repeat) ) { + memset( (char*)(pv->Data) + (kk*(pv->repeat)+nCopy)*(pv->datasize), + 0, ((pv->repeat)-nCopy)*(pv->datasize)); + } + } + + } + if( result->operation>0 ) { + FREE( result->value.data.ptr ); + } + } + if( lParse->status==OVERFLOW_ERR ) { + lParse->status = NUM_OVERFLOW; + ffpmsg("Numerical overflow while converting expression to necessary datatype"); + } + break; + + case BITSTR: + switch( (pv->userInfo)->datatype ) { + case TBYTE: + idx = -1; + for( kk=0; kkvalue.nelem; jj++ ) { + if( jj%8 == 0 ) + ((char*)(pv->Data))[++idx] = 0; + if( constant ) { + if( result->value.data.str[jj]=='1' ) + ((char*)(pv->Data))[idx] |= 128>>(jj%8); + } else { + if( result->value.data.strptr[kk][jj]=='1' ) + ((char*)(pv->Data))[idx] |= 128>>(jj%8); + } + } + } + break; + case TBIT: + case TLOGICAL: + if( constant ) { + for( kk=0; kkvalue.nelem; jj++ ) { + ((char*)(pv->Data))[ jj+kk*result->value.nelem ] = + ( result->value.data.str[jj]=='1' ); + } + } else { + for( kk=0; kkvalue.nelem; jj++ ) { + ((char*)(pv->Data))[ jj+kk*result->value.nelem ] = + ( result->value.data.strptr[kk][jj]=='1' ); + } + } + break; + case TSTRING: + if( constant ) { + for( jj=0; jjData))[jj], result->value.data.str ); + } + } else { + for( jj=0; jjData))[jj], result->value.data.strptr[jj] ); + } + } + break; + default: + ffpmsg("Cannot convert bit expression to desired type."); + lParse->status = PARSE_BAD_TYPE; + break; + } + if( result->operation>0 ) { + FREE( result->value.data.strptr[0] ); + FREE( result->value.data.strptr ); + } + break; + + case STRING: + if( (pv->userInfo)->datatype==TSTRING ) { + if( constant ) { + for( jj=0; jjData))[jj], result->value.data.str ); + } else { + for( jj=0; jjvalue.undef[jj] ) { + anyNullThisTime = 1; + strcpy( ((char**)(pv->Data))[jj], + *(char **)(pv->Null) ); + } else { + strcpy( ((char**)(pv->Data))[jj], + result->value.data.strptr[jj] ); + } + } + } else { + ffpmsg("Cannot convert string expression to desired type."); + lParse->status = PARSE_BAD_TYPE; + } + if( result->operation>0 ) { + FREE( result->value.data.strptr[0] ); + FREE( result->value.data.strptr ); + } + break; + } + + if( lParse->status ) break; + + /* Increment Data to point to where the next block should go */ + + if( result->type==BITSTR && (pv->userInfo)->datatype==TBYTE ) + (pv->Data) = (char*)(pv->Data) + + (pv->datasize) * ( (result->value.nelem+7)/8 ) * ntodo; + else if( result->type==STRING ) + (pv->Data) = (char*)(pv->Data) + (pv->datasize) * ntodo; + else + (pv->Data) = (char*)(pv->Data) + (pv->datasize) * ntodo * (pv->repeat); + } + + /* If a TemporaryCol output is used, we want to inform the caller + what the null value is expected to be */ + if (pv->Null != outcol->array && + (Data0) == (char*) outcol->array + (pv->datasize)) { + if( (pv->userInfo)->datatype == TSTRING ) + memcpy( outcol->array, *(char **)(pv->Null), 2 ); + else + memcpy( outcol->array, (pv->Null), (pv->datasize) ); + } + + /* If no NULLs encountered during this pass, set Null value to */ + /* zero to make the writing of the output column data faster */ + + if( anyNullThisTime ) + (pv->userInfo)->anyNull = 1; + else if( pv->Null == outcol->array ) { + if( (pv->userInfo)->datatype == TSTRING ) + memcpy( *(char **)(pv->Null), zeros, 2 ); + else + memcpy( (pv->Null), zeros, (pv->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 (lParse->hdutype != IMAGE_HDU && firstrow - 1 == (pv->lastRow)) { + if (!lParse->status && (pv->userInfo)->maxRowsstatus); /* return successful status */ +} + +static void Setup_DataArrays( ParseData *lParse, 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]; + int do_realloc = 0; + + lParse->firstDataRow = fRow; + lParse->nDataRows = nRows; + /* Only perform reallocations if the number of rows changed */ + if (lParse->nPrevDataRows != nRows) do_realloc = 1; + + /* Resize and fill in UNDEF arrays for each column */ + + for( i=0; ivarData + i; + + if( icol->iotype == OutputCol || icol->iotype == TemporaryCol ) 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 (do_realloc) { + if( bitStrs ) FREE( bitStrs[0] ); + free( bitStrs ); + bitStrs = (char**)malloc( nRows*sizeof(char*) ); + if( bitStrs==NULL ) { + varData->data = varData->undef = NULL; + lParse->status = MEMORY_ALLOCATION; + break; + } + bitStrs[0] = (char*)malloc( len*sizeof(char) ); + if( bitStrs[0]==NULL ) { + free( bitStrs ); + varData->data = varData->undef = NULL; + lParse->status = MEMORY_ALLOCATION; + break; + } + } + + for( row=0; rowarray)[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 (do_realloc) { + if (varData->undef) + free( varData->undef ); + varData->undef = (char*)malloc( nRows*sizeof(char) ); + if( varData->undef==NULL ) { + lParse->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 (do_realloc) { + if (varData->undef) + free( varData->undef ); + varData->undef = (char*)malloc( len*sizeof(char) ); + if( varData->undef==NULL ) { + lParse->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 (do_realloc) { + if (varData->undef) + free( varData->undef ); + varData->undef = (char*)malloc( len*sizeof(char) ); + if( varData->undef==NULL ) { + lParse->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 (do_realloc) { + if (varData->undef) + free( varData->undef ); + varData->undef = (char*)malloc( len*sizeof(char) ); + if( varData->undef==NULL ) { + lParse->status = MEMORY_ALLOCATION; + break; + } + } + while( len-- ) { + varData->undef[len] = + ( rarray[0]!=0.0 && rarray[0]==rarray[len+1]); + } + varData->data = rarray + 1; + break; + + default: + snprintf(msg, 80, "SetupDataArrays, unhandled type %d\n", + varData->type); + ffpmsg(msg); + } + + if( lParse->status ) { /* Deallocate NULL arrays of previous columns */ + while( i-- ) { + varData = lParse->varData + i; + if( varData->type==BITSTR ) + FREE( ((char**)varData->data)[0] ); + FREE( varData->undef ); + varData->undef = NULL; + } + lParse->nPrevDataRows = 0; + return; + } + } + + lParse->nPrevDataRows = nRows; +} + +/*--------------------------------------------------------------------------*/ +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 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 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;inCols; + + if( fits_parser_allocateCol( lParse, col_cnt, status ) ) return *status; + + /* Set important variables for TemporaryCol where calculated results end up */ + fits_iter_set_by_num( &(lParse->colData[col_cnt]), 0, 0, TDOUBLE, TemporaryCol); + lParse->colData[col_cnt].repeat = lParse->nElements; + Info->dataPtr = NULL; + Info->nullPtr = nulval; + Info->maxRows = nrows; + Info->parseData = lParse; + lParse->nCols ++; + + return 0; +} + +/*---------------------------------------------------------------------------*/ +int fits_uncompress_hkdata( ParseData *lParse, + 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=lParse->nCols; + while( parNo-- ) found[parNo] = 0; + + if( ffgkyj( fptr, "NAXIS2", &naxis2, NULL, status ) ) return( *status ); + + for( row=1; row<=naxis2; row++ ) { + if( ffgcvd( fptr, lParse->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 = lParse->nCols; + while( parNo-- ) { + switch( lParse->colData[parNo].datatype ) { + case TLONG: + ((long*)lParse->colData[parNo].array)[currelem] = + ((long*)lParse->colData[parNo].array)[currelem-1]; + break; + case TDOUBLE: + ((double*)lParse->colData[parNo].array)[currelem] = + ((double*)lParse->colData[parNo].array)[currelem-1]; + break; + case TSTRING: + strcpy( ((char **)lParse->colData[parNo].array)[currelem], + ((char **)lParse->colData[parNo].array)[currelem-1] ); + break; + } + } + } + + if( ffgcvs( fptr, lParse->parCol, row, 1L, 1L, "", + sPtr, &anynul, status ) ) return( *status ); + parNo = lParse->nCols; + while( parNo-- ) + if( !fits_strcasecmp( parName, lParse->varData[parNo].name ) ) break; + + if( parNo>=0 ) { + found[parNo] = 1; /* Flag this parameter as found */ + switch( lParse->colData[parNo].datatype ) { + case TLONG: + ffgcvj( fptr, lParse->valCol, row, 1L, 1L, + ((long*)lParse->colData[parNo].array)[0], + ((long*)lParse->colData[parNo].array)+currelem, + &anynul, status ); + break; + case TDOUBLE: + ffgcvd( fptr, lParse->valCol, row, 1L, 1L, + ((double*)lParse->colData[parNo].array)[0], + ((double*)lParse->colData[parNo].array)+currelem, + &anynul, status ); + break; + case TSTRING: + ffgcvs( fptr, lParse->valCol, row, 1L, 1L, + ((char**)lParse->colData[parNo].array)[0], + ((char**)lParse->colData[parNo].array)+currelem, + &anynul, status ); + break; + } + if( *status ) return( *status ); + } + } + + if( currelemnCols; + while( parNo-- ) + if( !found[parNo] ) { + snprintf( parName, 256, "Parameter not found: %-30s", + lParse->varData[parNo].name ); + ffpmsg( parName ); + *status = PARSE_SYNTAX_ERR; + } + return( *status ); +} + +typedef struct { + long *prownum; + ParseData *lParse; +} ffffrw_workdata; + +/*---------------------------------------------------------------------------*/ +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; + ParseData lParse; + + if( *status ) return( *status ); + + if( ffiprs( fptr, 0, expr, MAXDIMS, &dtype, &nelem, &naxis, + naxes, &lParse, status ) ) { + ffcprs(&lParse); + return( *status ); + } + if( nelem<0 ) { + constant = 1; + nelem = -nelem; + } else + constant = 0; + + if( dtype!=TLOGICAL || nelem!=1 ) { + ffcprs(&lParse); + ffpmsg("Expression does not evaluate to a logical scalar."); + return( *status = PARSE_BAD_TYPE ); + } + + *rownum = 0; + if( constant ) { /* No need to call parser... have result from ffiprs */ + result = lParse.Nodes[lParse.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 { + ffffrw_workdata workData; + workData.prownum = rownum; + workData.lParse = &lParse; + if( ffiter( lParse.nCols, lParse.colData, 0, 0, + ffffrw_work, (void*)&workData, status ) == -1 ) + *status = 0; /* -1 indicates exitted without error before end... OK */ + } + + ffcprs(&lParse); + 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; + ffffrw_workdata *workData = userPtr; + ParseData *lParse = workData->lParse; + + Evaluate_Parser( lParse, firstrow, nrows ); + + if( !lParse->status ) { + + result = lParse->Nodes + lParse->resultNode; + if( result->operation==CONST_OP ) { + + if( result->value.data.log ) { + *(workData->prownum) = firstrow; + return( -1 ); + } + + } else { + + for( idx=0; idxvalue.data.logptr[idx] && !result->value.undef[idx] ) { + *(workData->prownum) = firstrow + idx;; + return( -1 ); + } + } + } + + return( lParse->status ); +} + + +static int set_image_col_types (ParseData *lParse, + 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: + snprintf(temp, 80,"set_image_col_types: unrecognized image bitpix [%d]\n", + bitpix); + ffpmsg(temp); + return lParse->status = PARSE_BAD_TYPE; + } + return 0; +} + + +/************************************************************************* + + Functions used by the evaluator to access FITS data + (find_column, find_keywd, fits_parser_allocateCol, load_column) + + *************************************************************************/ + +static int find_column( ParseData *lParse, char *colName, void *itslval ) +{ + FITS_PARSER_YYSTYPE *thelval = (FITS_PARSER_YYSTYPE*)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( lParse, colName + 1, itslval ) ); + + fptr = lParse->def_fptr; + + status = 0; + col_cnt = lParse->nCols; + +if (lParse->hdutype == IMAGE_HDU) { + int i; + if (!lParse->pixFilter) { + lParse->status = COL_NOT_FOUND; + ffpmsg("find_column: IMAGE_HDU but no PixelFilter"); + return pERROR; + } + + colnum = -1; + for (i = 0; i < lParse->pixFilter->count; ++i) { + if (!fits_strcasecmp(colName, lParse->pixFilter->tag[i])) + colnum = i; + } + if (colnum < 0) { + snprintf(temp, 80, "find_column: PixelFilter tag %s not found", colName); + ffpmsg(temp); + lParse->status = COL_NOT_FOUND; + return pERROR; + } + + if( fits_parser_allocateCol( lParse, col_cnt, &lParse->status ) ) return pERROR; + + varInfo = lParse->varData + col_cnt; + colIter = lParse->colData + col_cnt; + + fptr = lParse->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(lParse, fptr, colName, typecode, varInfo, colIter)) + return pERROR; + colIter->fptr = fptr; + colIter->iotype = InputCol; +} +else { /* HDU holds a table */ + if( lParse->compressed ) + colnum = lParse->valCol; + else + if( fits_get_colnum( fptr, CASEINSEN, colName, &colnum, &status ) ) { + if( status == COL_NOT_FOUND ) { + type = find_keywd( lParse, colName, itslval ); + if( type != pERROR ) ffcmsg(); + return( type ); + } + lParse->status = status; + return pERROR; + } + + if( fits_get_coltype( fptr, colnum, &typecode, + &repeat, &width, &status ) ) { + lParse->status = status; + return pERROR; + } + + if( fits_parser_allocateCol( lParse, col_cnt, &lParse->status ) ) return pERROR; + + varInfo = lParse->varData + col_cnt; + colIter = lParse->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 (lParse->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. + */ + snprintf(temp,80,"TZERO%d",colnum); + istatus = 0; + if(fits_read_key(fptr,TDOUBLE,temp,&tzero,NULL,&istatus)) { + tzero = 0.0; + } + snprintf(temp,80,"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 ) { + snprintf(temp, 80, "column %d is wider than maximum %d characters", + colnum, MAX_STRLEN-1); + ffpmsg(temp); + lParse->status = PARSE_LRG_VECTOR; + return pERROR; + } + if( lParse->hdutype == ASCII_TBL ) repeat = width; + break; + default: + if (typecode < 0) { + snprintf(temp, 80,"variable-length array columns are not supported. typecode = %d", typecode); + ffpmsg(temp); + } + lParse->status = PARSE_BAD_TYPE; + return pERROR; + } + varInfo->nelem = repeat; + colIter->repeat = 0; /* ffiter() will fill in this value */ + if( repeat>1 && typecode!=TSTRING ) { + if( fits_read_tdim( fptr, colnum, MAXDIMS, + &varInfo->naxis, + &varInfo->naxes[0], &status ) + ) { + lParse->status = status; + return pERROR; + } + } else { + varInfo->naxis = 1; + varInfo->naxes[0] = 1; + } +} + lParse->nCols++; + thelval->lng = col_cnt; + + return( type ); +} + +static int find_keywd(ParseData *lParse, char *keyname, void *itslval ) +{ + FITS_PARSER_YYSTYPE *thelval = (FITS_PARSER_YYSTYPE*)itslval; + int status, type; + char keyvalue[FLEN_VALUE], dtype; + fitsfile *fptr; + double rval; + int bval; + long ival; + + status = 0; + fptr = lParse->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 */ + snprintf(keyvalue,FLEN_VALUE, "ffgkey could not find keyword: %s",keyname); + ffpmsg(keyvalue); + } + lParse->status = status; + return( pERROR ); + } + + if( fits_get_keytype( keyvalue, &dtype, &status ) ) { + lParse->status = status; + return( pERROR ); + } + + /* Read appropriate value type and set to CONST_OP */ + 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 ) { + lParse->status=status; + return pERROR; + } + + return( type ); +} + +/* Allocates parser iterator column storage for 25 columns *more* than + nCols */ +int fits_parser_allocateCol( ParseData *lParse, int nCol, int *status ) +{ + if( (nCol%25)==0 ) { + lParse->colData = (iteratorCol*) fits_recalloc( lParse->colData, + nCol, nCol+25, + sizeof(iteratorCol) ); + lParse->varData = (DataInfo *) fits_recalloc( lParse->varData, + nCol, nCol+25, + sizeof(DataInfo) ); + + memset( (lParse->colData + nCol), 0x00, sizeof(iteratorCol)*25 ); + memset( (lParse->varData + nCol), 0x00, sizeof(DataInfo)*25 ); + + if( lParse->colData == NULL + || lParse->varData == NULL ) { + if( lParse->colData ) free(lParse->colData); + if( lParse->varData ) free(lParse->varData); + lParse->colData = NULL; + lParse->varData = NULL; + return( *status = MEMORY_ALLOCATION ); + } + } + lParse->varData[nCol].data = NULL; + lParse->varData[nCol].undef = NULL; + return 0; +} + +static int load_column( ParseData *lParse, int varNum, long fRow, long nRows, + void *data, char *undef ) +{ + iteratorCol *var; + long nelem,nbytes,row,len,idx; + char **bitStrs, msg[80]; + unsigned char *bytes; + int status = 0, anynul; + + var = lParse->colData+varNum; + if (lParse->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; rowfptr, 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: + snprintf(msg,80,"load_column: unexpected datatype %d", var->datatype); + ffpmsg(msg); + } + } + if( status ) { + lParse->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? */ + ParseData lParse; + + DEBUG_PIXFILTER = getenv("DEBUG_PIXFILTER") ? 1 : 0; + + memset(&Info, 0, sizeof(Info)); + + if (*status) + return (*status); + + 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; + lParse.pixFilter = filter; + + if (ffiprs(infptr, 0, filter->expression, MAXDIMS, + &Info.datatype, &nelem, &naxis, naxes, &lParse, 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)) { + snprintf(msg, 256,"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)) { + snprintf(msg,256, "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: + snprintf(msg, 256,"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) { + if (sizeof(long) == 8 && sizeof(int) == 4) + nullVal = INT_MIN; + else + 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 = lParse.nCols; + if (fits_parser_allocateCol(&lParse, col_cnt, status)) + goto CLEANUP; + lParse.nCols++; + + colIter = &lParse.colData[col_cnt]; + colIter->fptr = filter->ofptr; + colIter->iotype = OutputCol; + varInfo = &lParse.varData[col_cnt]; + set_image_col_types(&lParse, colIter->fptr, "CREATED", bitpix, varInfo, colIter); + + Info.maxRows = -1; + Info.parseData = &lParse; + + if (ffiter(lParse.nCols, lParse.colData, 0, + 0, fits_parser_workfn, &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 = lParse.Nodes + lParse.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: + snprintf(msg, 256,"pixel_filter: unexpected constant result type [%d]\n", + Info.datatype); + ffpmsg(msg); + } + } + +CLEANUP: + ffcprs(&lParse); + return (*status); +} diff --git a/vendor/cfitsio/eval_l.c b/vendor/cfitsio/eval_l.c new file mode 100644 index 000000000..d662e2be7 --- /dev/null +++ b/vendor/cfitsio/eval_l.c @@ -0,0 +1,2962 @@ +#line 1 "eval_l.c" + +#line 3 "eval_l.c" + +#define YY_INT_ALIGNED short int + +/* A lexical scanner generated by flex */ + +#define FLEX_SCANNER +#define YY_FLEX_MAJOR_VERSION 2 +#define YY_FLEX_MINOR_VERSION 6 +#define YY_FLEX_SUBMINOR_VERSION 4 +#if YY_FLEX_SUBMINOR_VERSION > 0 +#define FLEX_BETA +#endif + +#ifdef yy_create_buffer +#define fits_parser_yy_create_buffer_ALREADY_DEFINED +#else +#define yy_create_buffer fits_parser_yy_create_buffer +#endif + +#ifdef yy_delete_buffer +#define fits_parser_yy_delete_buffer_ALREADY_DEFINED +#else +#define yy_delete_buffer fits_parser_yy_delete_buffer +#endif + +#ifdef yy_scan_buffer +#define fits_parser_yy_scan_buffer_ALREADY_DEFINED +#else +#define yy_scan_buffer fits_parser_yy_scan_buffer +#endif + +#ifdef yy_scan_string +#define fits_parser_yy_scan_string_ALREADY_DEFINED +#else +#define yy_scan_string fits_parser_yy_scan_string +#endif + +#ifdef yy_scan_bytes +#define fits_parser_yy_scan_bytes_ALREADY_DEFINED +#else +#define yy_scan_bytes fits_parser_yy_scan_bytes +#endif + +#ifdef yy_init_buffer +#define fits_parser_yy_init_buffer_ALREADY_DEFINED +#else +#define yy_init_buffer fits_parser_yy_init_buffer +#endif + +#ifdef yy_flush_buffer +#define fits_parser_yy_flush_buffer_ALREADY_DEFINED +#else +#define yy_flush_buffer fits_parser_yy_flush_buffer +#endif + +#ifdef yy_load_buffer_state +#define fits_parser_yy_load_buffer_state_ALREADY_DEFINED +#else +#define yy_load_buffer_state fits_parser_yy_load_buffer_state +#endif + +#ifdef yy_switch_to_buffer +#define fits_parser_yy_switch_to_buffer_ALREADY_DEFINED +#else +#define yy_switch_to_buffer fits_parser_yy_switch_to_buffer +#endif + +#ifdef yypush_buffer_state +#define fits_parser_yypush_buffer_state_ALREADY_DEFINED +#else +#define yypush_buffer_state fits_parser_yypush_buffer_state +#endif + +#ifdef yypop_buffer_state +#define fits_parser_yypop_buffer_state_ALREADY_DEFINED +#else +#define yypop_buffer_state fits_parser_yypop_buffer_state +#endif + +#ifdef yyensure_buffer_stack +#define fits_parser_yyensure_buffer_stack_ALREADY_DEFINED +#else +#define yyensure_buffer_stack fits_parser_yyensure_buffer_stack +#endif + +#ifdef yylex +#define fits_parser_yylex_ALREADY_DEFINED +#else +#define yylex fits_parser_yylex +#endif + +#ifdef yyrestart +#define fits_parser_yyrestart_ALREADY_DEFINED +#else +#define yyrestart fits_parser_yyrestart +#endif + +#ifdef yylex_init +#define fits_parser_yylex_init_ALREADY_DEFINED +#else +#define yylex_init fits_parser_yylex_init +#endif + +#ifdef yylex_init_extra +#define fits_parser_yylex_init_extra_ALREADY_DEFINED +#else +#define yylex_init_extra fits_parser_yylex_init_extra +#endif + +#ifdef yylex_destroy +#define fits_parser_yylex_destroy_ALREADY_DEFINED +#else +#define yylex_destroy fits_parser_yylex_destroy +#endif + +#ifdef yyget_debug +#define fits_parser_yyget_debug_ALREADY_DEFINED +#else +#define yyget_debug fits_parser_yyget_debug +#endif + +#ifdef yyset_debug +#define fits_parser_yyset_debug_ALREADY_DEFINED +#else +#define yyset_debug fits_parser_yyset_debug +#endif + +#ifdef yyget_extra +#define fits_parser_yyget_extra_ALREADY_DEFINED +#else +#define yyget_extra fits_parser_yyget_extra +#endif + +#ifdef yyset_extra +#define fits_parser_yyset_extra_ALREADY_DEFINED +#else +#define yyset_extra fits_parser_yyset_extra +#endif + +#ifdef yyget_in +#define fits_parser_yyget_in_ALREADY_DEFINED +#else +#define yyget_in fits_parser_yyget_in +#endif + +#ifdef yyset_in +#define fits_parser_yyset_in_ALREADY_DEFINED +#else +#define yyset_in fits_parser_yyset_in +#endif + +#ifdef yyget_out +#define fits_parser_yyget_out_ALREADY_DEFINED +#else +#define yyget_out fits_parser_yyget_out +#endif + +#ifdef yyset_out +#define fits_parser_yyset_out_ALREADY_DEFINED +#else +#define yyset_out fits_parser_yyset_out +#endif + +#ifdef yyget_leng +#define fits_parser_yyget_leng_ALREADY_DEFINED +#else +#define yyget_leng fits_parser_yyget_leng +#endif + +#ifdef yyget_text +#define fits_parser_yyget_text_ALREADY_DEFINED +#else +#define yyget_text fits_parser_yyget_text +#endif + +#ifdef yyget_lineno +#define fits_parser_yyget_lineno_ALREADY_DEFINED +#else +#define yyget_lineno fits_parser_yyget_lineno +#endif + +#ifdef yyset_lineno +#define fits_parser_yyset_lineno_ALREADY_DEFINED +#else +#define yyset_lineno fits_parser_yyset_lineno +#endif + +#ifdef yyget_column +#define fits_parser_yyget_column_ALREADY_DEFINED +#else +#define yyget_column fits_parser_yyget_column +#endif + +#ifdef yyset_column +#define fits_parser_yyset_column_ALREADY_DEFINED +#else +#define yyset_column fits_parser_yyset_column +#endif + +#ifdef yywrap +#define fits_parser_yywrap_ALREADY_DEFINED +#else +#define yywrap fits_parser_yywrap +#endif + +#ifdef yyget_lval +#define fits_parser_yyget_lval_ALREADY_DEFINED +#else +#define yyget_lval fits_parser_yyget_lval +#endif + +#ifdef yyset_lval +#define fits_parser_yyset_lval_ALREADY_DEFINED +#else +#define yyset_lval fits_parser_yyset_lval +#endif + +#ifdef yyalloc +#define fits_parser_yyalloc_ALREADY_DEFINED +#else +#define yyalloc fits_parser_yyalloc +#endif + +#ifdef yyrealloc +#define fits_parser_yyrealloc_ALREADY_DEFINED +#else +#define yyrealloc fits_parser_yyrealloc +#endif + +#ifdef yyfree +#define fits_parser_yyfree_ALREADY_DEFINED +#else +#define yyfree fits_parser_yyfree +#endif + +/* First, we deal with platform-specific or compiler-specific issues. */ + +/* begin standard C headers. */ +#include +#include +#include +#include + +/* end standard C headers. */ + +/* flex integer type definitions */ + +#ifndef FLEXINT_H +#define FLEXINT_H + +/* C99 systems have . Non-C99 systems may or may not. */ + +#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L + +/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, + * if you want the limit (max/min) macros for int types. + */ +#ifndef __STDC_LIMIT_MACROS +#define __STDC_LIMIT_MACROS 1 +#endif + +#include +typedef int8_t flex_int8_t; +typedef uint8_t flex_uint8_t; +typedef int16_t flex_int16_t; +typedef uint16_t flex_uint16_t; +typedef int32_t flex_int32_t; +typedef uint32_t flex_uint32_t; +#else +typedef signed char flex_int8_t; +typedef short int flex_int16_t; +typedef int flex_int32_t; +typedef unsigned char flex_uint8_t; +typedef unsigned short int flex_uint16_t; +typedef unsigned int flex_uint32_t; + +/* Limits of integral types. */ +#ifndef INT8_MIN +#define INT8_MIN (-128) +#endif +#ifndef INT16_MIN +#define INT16_MIN (-32767-1) +#endif +#ifndef INT32_MIN +#define INT32_MIN (-2147483647-1) +#endif +#ifndef INT8_MAX +#define INT8_MAX (127) +#endif +#ifndef INT16_MAX +#define INT16_MAX (32767) +#endif +#ifndef INT32_MAX +#define INT32_MAX (2147483647) +#endif +#ifndef UINT8_MAX +#define UINT8_MAX (255U) +#endif +#ifndef UINT16_MAX +#define UINT16_MAX (65535U) +#endif +#ifndef UINT32_MAX +#define UINT32_MAX (4294967295U) +#endif + +#ifndef SIZE_MAX +#define SIZE_MAX (~(size_t)0) +#endif + +#endif /* ! C99 */ + +#endif /* ! FLEXINT_H */ + +/* begin standard C++ headers. */ + +/* TODO: this is always defined, so inline it */ +#define yyconst const + +#if defined(__GNUC__) && __GNUC__ >= 3 +#define yynoreturn __attribute__((__noreturn__)) +#else +#define yynoreturn +#endif + +/* Returned upon end-of-file. */ +#define YY_NULL 0 + +/* Promotes a possibly negative, possibly signed char to an + * integer in range [0..255] for use as an array index. + */ +#define YY_SC_TO_UI(c) ((YY_CHAR) (c)) + +/* An opaque pointer. */ +#ifndef YY_TYPEDEF_YY_SCANNER_T +#define YY_TYPEDEF_YY_SCANNER_T +typedef void* yyscan_t; +#endif + +/* For convenience, these vars (plus the bison vars far below) + are macros in the reentrant scanner. */ +#define yyin yyg->yyin_r +#define yyout yyg->yyout_r +#define yyextra yyg->yyextra_r +#define yyleng yyg->yyleng_r +#define yytext yyg->yytext_r +#define yylineno (YY_CURRENT_BUFFER_LVALUE->yy_bs_lineno) +#define yycolumn (YY_CURRENT_BUFFER_LVALUE->yy_bs_column) +#define yy_flex_debug yyg->yy_flex_debug_r + +/* 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 yyg->yy_start = 1 + 2 * +/* Translate the current start state into a value that can be later handed + * to BEGIN to return to the state. The YYSTATE alias is for lex + * compatibility. + */ +#define YY_START ((yyg->yy_start - 1) / 2) +#define YYSTATE YY_START +/* Action number for EOF rule of a given start state. */ +#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) +/* Special action meaning "start processing a new file". */ +#define YY_NEW_FILE yyrestart( yyin , yyscanner ) +#define YY_END_OF_BUFFER_CHAR 0 + +/* Size of default input buffer. */ +#ifndef YY_BUF_SIZE +#ifdef __ia64__ +/* On IA-64, the buffer size is 16k, not 8k. + * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. + * Ditto for the __ia64__ case accordingly. + */ +#define YY_BUF_SIZE 32768 +#else +#define YY_BUF_SIZE 16384 +#endif /* __ia64__ */ +#endif + +/* The state buf must be large enough to hold one state per character in the main buffer. + */ +#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) + +#ifndef YY_TYPEDEF_YY_BUFFER_STATE +#define YY_TYPEDEF_YY_BUFFER_STATE +typedef struct yy_buffer_state *YY_BUFFER_STATE; +#endif + +#ifndef YY_TYPEDEF_YY_SIZE_T +#define YY_TYPEDEF_YY_SIZE_T +typedef size_t yy_size_t; +#endif + +#define EOB_ACT_CONTINUE_SCAN 0 +#define EOB_ACT_END_OF_FILE 1 +#define EOB_ACT_LAST_MATCH 2 + + #define YY_LESS_LINENO(n) + #define YY_LINENO_REWIND_TO(ptr) + +/* Return all but the first "n" matched characters back to the input stream. */ +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up yytext. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + *yy_cp = yyg->yy_hold_char; \ + YY_RESTORE_YY_MORE_OFFSET \ + yyg->yy_c_buf_p = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ + YY_DO_BEFORE_ACTION; /* set up yytext again */ \ + } \ + while ( 0 ) +#define unput(c) yyunput( c, yyg->yytext_ptr , yyscanner ) + +#ifndef YY_STRUCT_YY_BUFFER_STATE +#define YY_STRUCT_YY_BUFFER_STATE +struct yy_buffer_state + { + FILE *yy_input_file; + + char *yy_ch_buf; /* input buffer */ + char *yy_buf_pos; /* current position in input buffer */ + + /* Size of input buffer in bytes, not including room for EOB + * characters. + */ + int yy_buf_size; + + /* Number of characters read into yy_ch_buf, not including EOB + * characters. + */ + int yy_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 yy_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 yy_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 yy_at_bol; + + int yy_bs_lineno; /**< The line count. */ + int yy_bs_column; /**< The column count. */ + + /* Whether to try to fill the input buffer when we reach the + * end of it. + */ + int yy_fill_buffer; + + int yy_buffer_status; + +#define YY_BUFFER_NEW 0 +#define YY_BUFFER_NORMAL 1 + /* When an EOF's been seen but there's still some text to process + * then we mark the buffer as YY_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 yyrestart()), so that the user can continue scanning by + * just pointing yyin at a new input file. + */ +#define YY_BUFFER_EOF_PENDING 2 + + }; +#endif /* !YY_STRUCT_YY_BUFFER_STATE */ + +/* 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". + * + * Returns the top of the stack, or NULL. + */ +#define YY_CURRENT_BUFFER ( yyg->yy_buffer_stack \ + ? yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] \ + : NULL) +/* Same as previous macro, but useful when we know that the buffer stack is not + * NULL or when we need an lvalue. For internal use only. + */ +#define YY_CURRENT_BUFFER_LVALUE yyg->yy_buffer_stack[yyg->yy_buffer_stack_top] + +void yyrestart ( FILE *input_file , yyscan_t yyscanner ); +void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); +YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size , yyscan_t yyscanner ); +void yy_delete_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); +void yy_flush_buffer ( YY_BUFFER_STATE b , yyscan_t yyscanner ); +void yypush_buffer_state ( YY_BUFFER_STATE new_buffer , yyscan_t yyscanner ); +void yypop_buffer_state ( yyscan_t yyscanner ); + +static void yyensure_buffer_stack ( yyscan_t yyscanner ); +static void yy_load_buffer_state ( yyscan_t yyscanner ); +static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file , yyscan_t yyscanner ); +#define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER , yyscanner) + +YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size , yyscan_t yyscanner ); +YY_BUFFER_STATE yy_scan_string ( const char *yy_str , yyscan_t yyscanner ); +YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len , yyscan_t yyscanner ); + +void *yyalloc ( yy_size_t , yyscan_t yyscanner ); +void *yyrealloc ( void *, yy_size_t , yyscan_t yyscanner ); +void yyfree ( void * , yyscan_t yyscanner ); + +#define yy_new_buffer yy_create_buffer +#define yy_set_interactive(is_interactive) \ + { \ + if ( ! YY_CURRENT_BUFFER ){ \ + yyensure_buffer_stack (yyscanner); \ + YY_CURRENT_BUFFER_LVALUE = \ + yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ + } +#define yy_set_bol(at_bol) \ + { \ + if ( ! YY_CURRENT_BUFFER ){\ + yyensure_buffer_stack (yyscanner); \ + YY_CURRENT_BUFFER_LVALUE = \ + yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ + } +#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) + +/* Begin user sect3 */ +typedef flex_uint8_t YY_CHAR; + +typedef int yy_state_type; + +#define yytext_ptr yytext_r + +static yy_state_type yy_get_previous_state ( yyscan_t yyscanner ); +static yy_state_type yy_try_NUL_trans ( yy_state_type current_state , yyscan_t yyscanner); +static int yy_get_next_buffer ( yyscan_t yyscanner ); +static void yynoreturn yy_fatal_error ( const char* msg , yyscan_t yyscanner ); + +/* Done after the current pattern has been matched and before the + * corresponding action - sets up yytext. + */ +#define YY_DO_BEFORE_ACTION \ + yyg->yytext_ptr = yy_bp; \ + yyleng = (int) (yy_cp - yy_bp); \ + yyg->yy_hold_char = *yy_cp; \ + *yy_cp = '\0'; \ + yyg->yy_c_buf_p = yy_cp; +#define YY_NUM_RULES 30 +#define YY_END_OF_BUFFER 31 +/* This struct is not used in this scanner, + but its presence is necessary. */ +struct yy_trans_info + { + flex_int32_t yy_verify; + flex_int32_t yy_nxt; + }; +static const flex_int16_t yy_accept[174] = + { 0, + 0, 0, 31, 29, 1, 28, 18, 29, 29, 29, + 29, 29, 29, 29, 10, 8, 8, 24, 29, 23, + 13, 13, 13, 13, 9, 13, 13, 13, 13, 13, + 17, 13, 13, 13, 13, 13, 13, 13, 29, 1, + 22, 0, 12, 0, 11, 0, 13, 20, 0, 0, + 0, 0, 0, 0, 0, 17, 0, 10, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 10, 8, 0, 0, 0, 0, 26, 21, + 25, 13, 13, 13, 2, 13, 13, 13, 4, 13, + 13, 13, 13, 3, 13, 27, 13, 13, 13, 13, + + 13, 13, 13, 13, 13, 19, 0, 11, 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, 0, 0, 10, 5, 6, 7, + 14, 13, 23, 24, 13, 13, 13, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, + 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, + 16, 0, 0 + } ; + +static const YY_CHAR yy_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, 16, 17, + 17, 17, 17, 17, 17, 18, 18, 1, 1, 19, + 20, 21, 1, 1, 22, 23, 24, 25, 26, 27, + 28, 29, 30, 31, 31, 32, 31, 33, 34, 31, + 35, 36, 31, 37, 38, 31, 31, 39, 31, 31, + 1, 1, 40, 41, 42, 1, 43, 44, 24, 45, + + 46, 47, 48, 29, 49, 31, 31, 50, 31, 51, + 52, 31, 53, 54, 31, 55, 56, 31, 31, 57, + 31, 31, 1, 58, 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 const YY_CHAR yy_meta[59] = + { 0, + 1, 1, 2, 1, 1, 1, 3, 1, 1, 1, + 1, 1, 1, 1, 4, 4, 4, 4, 1, 1, + 1, 4, 4, 4, 4, 4, 4, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 1, + 1, 5, 4, 4, 4, 4, 4, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 1 + } ; + +static const flex_int16_t yy_base[182] = + { 0, + 0, 0, 412, 413, 409, 413, 390, 404, 401, 400, + 398, 396, 34, 392, 70, 114, 16, 383, 46, 382, + 29, 84, 359, 28, 358, 52, 157, 64, 91, 128, + 358, 0, 40, 27, 69, 92, 100, 171, 340, 395, + 413, 391, 413, 388, 387, 386, 413, 413, 383, 357, + 358, 356, 336, 337, 335, 413, 139, 190, 352, 349, + 71, 111, 135, 347, 348, 330, 327, 59, 64, 116, + 325, 323, 175, 0, 59, 120, 326, 0, 413, 413, + 413, 153, 184, 0, 202, 209, 210, 219, 351, 220, + 228, 229, 211, 230, 240, 413, 221, 246, 254, 263, + + 264, 265, 266, 239, 275, 413, 346, 342, 310, 313, + 309, 289, 292, 288, 275, 317, 327, 326, 325, 324, + 323, 322, 298, 320, 297, 287, 317, 315, 314, 312, + 311, 310, 249, 289, 243, 294, 298, 134, 246, 0, + 413, 285, 413, 413, 288, 308, 309, 261, 261, 256, + 221, 215, 246, 241, 223, 218, 213, 208, 197, 413, + 166, 160, 413, 128, 122, 150, 154, 105, 101, 96, + 413, 84, 413, 351, 354, 359, 364, 366, 368, 373, + 89 + } ; + +static const flex_int16_t yy_def[182] = + { 0, + 173, 1, 173, 173, 173, 173, 173, 174, 175, 176, + 173, 177, 173, 173, 173, 173, 16, 173, 173, 173, + 178, 178, 178, 178, 178, 178, 178, 178, 178, 178, + 173, 179, 178, 178, 178, 178, 178, 178, 173, 173, + 173, 174, 173, 180, 175, 176, 173, 173, 177, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 17, 173, 173, 173, 181, 173, 173, + 173, 178, 178, 179, 178, 178, 178, 178, 27, 178, + 178, 178, 178, 178, 178, 173, 178, 178, 178, 178, + + 178, 178, 178, 178, 178, 173, 180, 180, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 181, + 173, 178, 173, 173, 178, 178, 178, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 0, 173, 173, 173, 173, 173, 173, 173, + 173 + } ; + +static const flex_int16_t yy_nxt[472] = + { 0, + 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, + 4, 14, 4, 15, 16, 17, 17, 17, 18, 19, + 20, 21, 22, 23, 23, 24, 25, 26, 27, 23, + 23, 28, 29, 30, 23, 23, 25, 23, 23, 4, + 31, 32, 33, 22, 23, 34, 25, 35, 23, 36, + 37, 38, 23, 23, 25, 23, 23, 39, 50, 173, + 51, 83, 86, 52, 79, 80, 81, 173, 84, 84, + 84, 136, 173, 137, 137, 137, 137, 87, 53, 98, + 54, 84, 55, 57, 58, 58, 58, 58, 88, 90, + 97, 59, 140, 84, 171, 60, 118, 61, 85, 85, + + 91, 62, 63, 64, 128, 84, 171, 119, 65, 130, + 84, 171, 66, 129, 99, 67, 92, 68, 131, 69, + 70, 71, 85, 100, 93, 84, 72, 73, 74, 74, + 74, 74, 84, 84, 138, 138, 120, 101, 75, 75, + 85, 84, 94, 94, 94, 103, 102, 121, 138, 138, + 172, 104, 57, 115, 115, 115, 115, 76, 75, 75, + 122, 132, 141, 95, 171, 77, 94, 133, 123, 84, + 78, 89, 89, 89, 89, 170, 169, 168, 89, 89, + 89, 89, 89, 89, 94, 94, 94, 94, 57, 58, + 58, 58, 58, 141, 84, 89, 167, 166, 84, 89, + + 89, 89, 89, 89, 58, 58, 58, 58, 142, 94, + 96, 141, 84, 89, 75, 75, 85, 85, 141, 141, + 141, 160, 80, 81, 105, 84, 48, 94, 141, 141, + 141, 96, 143, 79, 75, 75, 160, 141, 141, 141, + 85, 144, 41, 84, 94, 94, 94, 145, 141, 141, + 84, 84, 84, 106, 48, 141, 163, 165, 85, 80, + 84, 84, 84, 141, 164, 146, 163, 81, 94, 84, + 84, 84, 141, 141, 141, 141, 143, 79, 144, 41, + 84, 84, 162, 161, 141, 139, 94, 84, 106, 115, + 115, 115, 115, 147, 141, 84, 159, 141, 48, 75, + + 75, 160, 106, 158, 84, 84, 84, 84, 137, 137, + 137, 137, 137, 137, 137, 137, 84, 141, 141, 75, + 75, 48, 160, 41, 144, 79, 84, 143, 81, 84, + 80, 157, 156, 106, 155, 41, 144, 79, 143, 81, + 80, 154, 153, 152, 151, 150, 149, 148, 108, 84, + 84, 42, 108, 42, 42, 42, 45, 45, 45, 46, + 141, 46, 46, 46, 49, 139, 49, 49, 49, 82, + 82, 84, 84, 107, 135, 107, 107, 107, 134, 127, + 126, 125, 124, 117, 116, 114, 113, 112, 111, 110, + 109, 43, 47, 173, 108, 43, 40, 106, 96, 84, + + 84, 81, 79, 56, 43, 48, 47, 44, 43, 41, + 40, 173, 3, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173 + } ; + +static const flex_int16_t yy_chk[472] = + { 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, 1, 1, 1, 13, 17, + 13, 21, 24, 13, 19, 19, 19, 17, 34, 24, + 21, 75, 17, 75, 75, 75, 75, 26, 13, 34, + 13, 33, 13, 15, 15, 15, 15, 15, 26, 28, + 33, 15, 181, 26, 172, 15, 61, 15, 22, 22, + + 28, 15, 15, 15, 68, 28, 170, 61, 15, 69, + 35, 169, 15, 68, 35, 15, 29, 15, 69, 15, + 15, 15, 22, 35, 29, 22, 15, 16, 16, 16, + 16, 16, 29, 36, 76, 76, 62, 36, 16, 16, + 22, 37, 30, 30, 30, 37, 36, 62, 138, 138, + 168, 37, 57, 57, 57, 57, 57, 16, 16, 16, + 63, 70, 82, 30, 167, 16, 30, 70, 63, 30, + 16, 27, 27, 27, 27, 166, 165, 164, 27, 27, + 27, 27, 27, 27, 30, 38, 38, 38, 73, 73, + 73, 73, 73, 83, 82, 27, 162, 161, 27, 27, + + 27, 27, 27, 27, 58, 58, 58, 58, 83, 38, + 159, 85, 38, 27, 58, 58, 85, 85, 86, 87, + 93, 158, 86, 87, 38, 83, 157, 38, 88, 90, + 97, 156, 88, 90, 58, 58, 155, 91, 92, 94, + 85, 91, 92, 85, 94, 94, 94, 93, 104, 95, + 86, 87, 93, 95, 154, 98, 153, 152, 85, 98, + 88, 90, 97, 99, 151, 97, 150, 99, 94, 91, + 92, 94, 100, 101, 102, 103, 100, 101, 102, 103, + 104, 95, 149, 148, 105, 139, 94, 98, 105, 115, + 115, 115, 115, 104, 142, 99, 135, 145, 142, 115, + + 115, 145, 134, 133, 100, 101, 102, 103, 136, 136, + 136, 136, 137, 137, 137, 137, 105, 146, 147, 115, + 115, 146, 147, 132, 131, 130, 142, 129, 128, 145, + 127, 126, 125, 124, 123, 122, 121, 120, 119, 118, + 117, 116, 114, 113, 112, 111, 110, 109, 108, 146, + 147, 174, 107, 174, 174, 174, 175, 175, 175, 176, + 89, 176, 176, 176, 177, 77, 177, 177, 177, 178, + 178, 179, 179, 180, 72, 180, 180, 180, 71, 67, + 66, 65, 64, 60, 59, 55, 54, 53, 52, 51, + 50, 49, 46, 45, 44, 42, 40, 39, 31, 25, + + 23, 20, 18, 14, 12, 11, 10, 9, 8, 7, + 5, 3, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173, 173, 173, 173, 173, 173, 173, 173, 173, 173, + 173 + } ; + +/* 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 yymore() yymore_used_but_not_detected +#define YY_MORE_ADJ 0 +#define YY_RESTORE_YY_MORE_OFFSET +#line 1 "eval.l" +/************************************************************************/ +/* */ +/* CFITSIO Lexical Parser */ +/* */ +/* This specifies a thread-safe reentrant version of lex functions */ +/* This specifies CFITSIO-unique names for lexer functions */ +/* This facilitates calling between the Bison parser and this lexer */ +#line 14 "eval.l" +/* 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 +#include +#include +#ifdef sparc +#include +#else +#include +#endif +#include "eval_defs.h" +#include "eval_tab.h" + +/* This is a shorthand accessor to get at the "extra" data inside the + lexer, which in our case is the lParse (ParseData) structure */ +#define yylParse (yyextra) + +/***** Internal functions *****/ + + int fits_parser_yyGetVariable( ParseData *lParse, char *varName, FITS_PARSER_YYSTYPE *varVal ); + +static int find_variable( ParseData *lParse, char *varName ); +static int expr_read( ParseData *lParse, char *buf, int nbytes ); + +/***** Definitions *****/ + +#define YY_NO_UNPUT /* Don't include YYUNPUT function */ +#define YY_NEVER_INTERACTIVE 1 + +#define MAXCHR 256 +#define MAXBIT 128 + +#define OCT_0 "000" +#define OCT_1 "001" +#define OCT_2 "010" +#define OCT_3 "011" +#define OCT_4 "100" +#define OCT_5 "101" +#define OCT_6 "110" +#define OCT_7 "111" +#define OCT_X "xxx" + +#define HEX_0 "0000" +#define HEX_1 "0001" +#define HEX_2 "0010" +#define HEX_3 "0011" +#define HEX_4 "0100" +#define HEX_5 "0101" +#define HEX_6 "0110" +#define HEX_7 "0111" +#define HEX_8 "1000" +#define HEX_9 "1001" +#define HEX_A "1010" +#define HEX_B "1011" +#define HEX_C "1100" +#define HEX_D "1101" +#define HEX_E "1110" +#define HEX_F "1111" +#define HEX_X "xxxx" + +/* + MJT - 13 June 1996 + read from buffer instead of stdin + (as per old ftools.skel) +*/ +#undef YY_INPUT +#define YY_INPUT(buf,result,max_size) \ + if ( (result = expr_read( yylParse, (char *) buf, max_size )) < 0 ) \ + YY_FATAL_ERROR( "read() in flex scanner failed" ); + +#line 925 "eval_l.c" +#line 926 "eval_l.c" + +#define INITIAL 0 + +#ifndef YY_NO_UNISTD_H +/* Special case for "unistd.h", since it is non-ANSI. We include it way + * down here because we want the user's section 1 to have been scanned first. + * The user has a chance to override it with an option. + */ +#include +#endif + +#ifndef YY_EXTRA_TYPE +#define YY_EXTRA_TYPE void * +#endif + +/* Holds the entire state of the reentrant scanner. */ +struct yyguts_t + { + + /* User-defined. Not touched by flex. */ + YY_EXTRA_TYPE yyextra_r; + + /* The rest are the same as the globals declared in the non-reentrant scanner. */ + FILE *yyin_r, *yyout_r; + size_t yy_buffer_stack_top; /**< index of top of stack. */ + size_t yy_buffer_stack_max; /**< capacity of stack. */ + YY_BUFFER_STATE * yy_buffer_stack; /**< Stack as an array. */ + char yy_hold_char; + int yy_n_chars; + int yyleng_r; + char *yy_c_buf_p; + int yy_init; + int yy_start; + int yy_did_buffer_switch_on_eof; + int yy_start_stack_ptr; + int yy_start_stack_depth; + int *yy_start_stack; + yy_state_type yy_last_accepting_state; + char* yy_last_accepting_cpos; + + int yylineno_r; + int yy_flex_debug_r; + + char *yytext_r; + int yy_more_flag; + int yy_more_len; + + YYSTYPE * yylval_r; + + }; /* end struct yyguts_t */ + +static int yy_init_globals ( yyscan_t yyscanner ); + + /* This must go here because YYSTYPE and YYLTYPE are included + * from bison output in section 1.*/ + # define yylval yyg->yylval_r + +int yylex_init (yyscan_t* scanner); + +int yylex_init_extra ( YY_EXTRA_TYPE user_defined, yyscan_t* scanner); + +/* Accessor methods to globals. + These are made visible to non-reentrant scanners for convenience. */ + +int yylex_destroy ( yyscan_t yyscanner ); + +int yyget_debug ( yyscan_t yyscanner ); + +void yyset_debug ( int debug_flag , yyscan_t yyscanner ); + +YY_EXTRA_TYPE yyget_extra ( yyscan_t yyscanner ); + +void yyset_extra ( YY_EXTRA_TYPE user_defined , yyscan_t yyscanner ); + +FILE *yyget_in ( yyscan_t yyscanner ); + +void yyset_in ( FILE * _in_str , yyscan_t yyscanner ); + +FILE *yyget_out ( yyscan_t yyscanner ); + +void yyset_out ( FILE * _out_str , yyscan_t yyscanner ); + + int yyget_leng ( yyscan_t yyscanner ); + +char *yyget_text ( yyscan_t yyscanner ); + +int yyget_lineno ( yyscan_t yyscanner ); + +void yyset_lineno ( int _line_number , yyscan_t yyscanner ); + +int yyget_column ( yyscan_t yyscanner ); + +void yyset_column ( int _column_no , yyscan_t yyscanner ); + +YYSTYPE * yyget_lval ( yyscan_t yyscanner ); + +void yyset_lval ( YYSTYPE * yylval_param , yyscan_t yyscanner ); + +/* Macros after this point can all be overridden by user definitions in + * section 1. + */ + +#ifndef YY_SKIP_YYWRAP +#ifdef __cplusplus +extern "C" int yywrap ( yyscan_t yyscanner ); +#else +extern int yywrap ( yyscan_t yyscanner ); +#endif +#endif + +#ifndef YY_NO_UNPUT + + static void yyunput ( int c, char *buf_ptr , yyscan_t yyscanner); + +#endif + +#ifndef yytext_ptr +static void yy_flex_strncpy ( char *, const char *, int , yyscan_t yyscanner); +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen ( const char * , yyscan_t yyscanner); +#endif + +#ifndef YY_NO_INPUT +#ifdef __cplusplus +static int yyinput ( yyscan_t yyscanner ); +#else +static int input ( yyscan_t yyscanner ); +#endif + +#endif + +/* Amount of stuff to slurp up with each read. */ +#ifndef YY_READ_BUF_SIZE +#ifdef __ia64__ +/* On IA-64, the buffer size is 16k, not 8k */ +#define YY_READ_BUF_SIZE 16384 +#else +#define YY_READ_BUF_SIZE 8192 +#endif /* __ia64__ */ +#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 do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0) +#endif + +/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, + * is returned in "result". + */ +#ifndef YY_INPUT +#define YY_INPUT(buf,result,max_size) \ + if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ + { \ + int c = '*'; \ + int n; \ + for ( n = 0; n < max_size && \ + (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ + buf[n] = (char) c; \ + if ( c == '\n' ) \ + buf[n++] = (char) c; \ + if ( c == EOF && ferror( yyin ) ) \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + result = n; \ + } \ + else \ + { \ + errno=0; \ + while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \ + { \ + if( errno != EINTR) \ + { \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + break; \ + } \ + errno=0; \ + clearerr(yyin); \ + } \ + }\ +\ + +#endif + +/* No semi-colon after return; correct usage is to write "yyterminate();" - + * we don't want an extra ';' after the "return" because that will cause + * some compilers to complain about unreachable statements. + */ +#ifndef yyterminate +#define yyterminate() return YY_NULL +#endif + +/* Number of entries by which start-condition stack grows. */ +#ifndef YY_START_STACK_INCR +#define YY_START_STACK_INCR 25 +#endif + +/* Report a fatal error. */ +#ifndef YY_FATAL_ERROR +#define YY_FATAL_ERROR(msg) yy_fatal_error( msg , yyscanner) +#endif + +/* end tables serialization structures and prototypes */ + +/* Default declaration of generated scanner - a define so the user can + * easily add parameters. + */ +#ifndef YY_DECL +#define YY_DECL_IS_OURS 1 + +extern int yylex \ + (YYSTYPE * yylval_param , yyscan_t yyscanner); + +#define YY_DECL int yylex \ + (YYSTYPE * yylval_param , yyscan_t yyscanner) +#endif /* !YY_DECL */ + +/* Code executed at the beginning of each rule, after yytext and yyleng + * have been set up. + */ +#ifndef YY_USER_ACTION +#define YY_USER_ACTION +#endif + +/* Code executed at the end of each rule. */ +#ifndef YY_BREAK +#define YY_BREAK /*LINTED*/break; +#endif + +#define YY_RULE_SETUP \ + YY_USER_ACTION + +/** The main scanner function which does all the work. + */ +YY_DECL +{ + yy_state_type yy_current_state; + char *yy_cp, *yy_bp; + int yy_act; + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + yylval = yylval_param; + + if ( !yyg->yy_init ) + { + yyg->yy_init = 1; + +#ifdef YY_USER_INIT + YY_USER_INIT; +#endif + + if ( ! yyg->yy_start ) + yyg->yy_start = 1; /* first start state */ + + if ( ! yyin ) + yyin = stdin; + + if ( ! yyout ) + yyout = stdout; + + if ( ! YY_CURRENT_BUFFER ) { + yyensure_buffer_stack (yyscanner); + YY_CURRENT_BUFFER_LVALUE = + yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); + } + + yy_load_buffer_state( yyscanner ); + } + + { +#line 158 "eval.l" + + +#line 1203 "eval_l.c" + + while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */ + { + yy_cp = yyg->yy_c_buf_p; + + /* Support of yytext. */ + *yy_cp = yyg->yy_hold_char; + + /* yy_bp points to the position in yy_ch_buf of the start of + * the current run. + */ + yy_bp = yy_cp; + + yy_current_state = yyg->yy_start; +yy_match: + do + { + YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ; + if ( yy_accept[yy_current_state] ) + { + yyg->yy_last_accepting_state = yy_current_state; + yyg->yy_last_accepting_cpos = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 174 ) + yy_c = yy_meta[yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; + ++yy_cp; + } + while ( yy_base[yy_current_state] != 413 ); + +yy_find_action: + yy_act = yy_accept[yy_current_state]; + if ( yy_act == 0 ) + { /* have to back up */ + yy_cp = yyg->yy_last_accepting_cpos; + yy_current_state = yyg->yy_last_accepting_state; + yy_act = yy_accept[yy_current_state]; + } + + YY_DO_BEFORE_ACTION; + +do_action: /* This label is used only to access EOF actions. */ + + switch ( yy_act ) + { /* beginning of action switch */ + case 0: /* must back up */ + /* undo the effects of YY_DO_BEFORE_ACTION */ + *yy_cp = yyg->yy_hold_char; + yy_cp = yyg->yy_last_accepting_cpos; + yy_current_state = yyg->yy_last_accepting_state; + goto yy_find_action; + +case 1: +YY_RULE_SETUP +#line 160 "eval.l" +; + YY_BREAK +case 2: +YY_RULE_SETUP +#line 161 "eval.l" +{ + int len; + len = strlen(yytext); + while (yytext[len] == ' ') + len--; + len = len - 1; + strncpy(yylval->str,&yytext[1],len); + yylval->str[len] = '\0'; + return( BITSTR ); + } + YY_BREAK +case 3: +YY_RULE_SETUP +#line 171 "eval.l" +{ + int len; + char tmpstring[256]; + char bitstring[256]; + len = strlen(yytext); + if (len >= 256) { + char errMsg[100]; + yylParse->status = PARSE_SYNTAX_ERR; + strcpy (errMsg,"Bit string exceeds maximum length: '"); + strncat(errMsg, &(yytext[0]), 20); + strcat (errMsg,"...'"); + ffpmsg (errMsg); + len = 0; + } else { + while (yytext[len] == ' ') + len--; + len = len - 1; + strncpy(tmpstring,&yytext[1],len); + } + tmpstring[len] = '\0'; + bitstring[0] = '\0'; + len = 0; + while ( tmpstring[len] != '\0') + { + switch ( tmpstring[len] ) + { + case '0': + strcat(bitstring,OCT_0); + break; + case '1': + strcat(bitstring,OCT_1); + break; + case '2': + strcat(bitstring,OCT_2); + break; + case '3': + strcat(bitstring,OCT_3); + break; + case '4': + strcat(bitstring,OCT_4); + break; + case '5': + strcat(bitstring,OCT_5); + break; + case '6': + strcat(bitstring,OCT_6); + break; + case '7': + strcat(bitstring,OCT_7); + break; + case 'x': + case 'X': + strcat(bitstring,OCT_X); + break; + } + len++; + } + strcpy( yylval->str, bitstring ); + return( BITSTR ); + } + YY_BREAK +case 4: +YY_RULE_SETUP +#line 231 "eval.l" +{ + int len; + char tmpstring[256]; + char bitstring[256]; + len = strlen(yytext); + if (len >= 256) { + char errMsg[100]; + yylParse->status = PARSE_SYNTAX_ERR; + strcpy (errMsg,"Hex string exceeds maximum length: '"); + strncat(errMsg, &(yytext[0]), 20); + strcat (errMsg,"...'"); + ffpmsg (errMsg); + len = 0; + } else { + while (yytext[len] == ' ') + len--; + len = len - 1; + strncpy(tmpstring,&yytext[1],len); + } + tmpstring[len] = '\0'; + bitstring[0] = '\0'; + len = 0; + while ( tmpstring[len] != '\0') + { + switch ( tmpstring[len] ) + { + case '0': + strcat(bitstring,HEX_0); + break; + case '1': + strcat(bitstring,HEX_1); + break; + case '2': + strcat(bitstring,HEX_2); + break; + case '3': + strcat(bitstring,HEX_3); + break; + case '4': + strcat(bitstring,HEX_4); + break; + case '5': + strcat(bitstring,HEX_5); + break; + case '6': + strcat(bitstring,HEX_6); + break; + case '7': + strcat(bitstring,HEX_7); + break; + case '8': + strcat(bitstring,HEX_8); + break; + case '9': + strcat(bitstring,HEX_9); + break; + case 'a': + case 'A': + strcat(bitstring,HEX_A); + break; + case 'b': + case 'B': + strcat(bitstring,HEX_B); + break; + case 'c': + case 'C': + strcat(bitstring,HEX_C); + break; + case 'd': + case 'D': + strcat(bitstring,HEX_D); + break; + case 'e': + case 'E': + strcat(bitstring,HEX_E); + break; + case 'f': + case 'F': + strcat(bitstring,HEX_F); + break; + case 'x': + case 'X': + strcat(bitstring,HEX_X); + break; + } + len++; + } + + strcpy( yylval->str, bitstring ); + return( BITSTR ); + } + YY_BREAK +case 5: +YY_RULE_SETUP +#line 322 "eval.l" +{ + long int constval = 0; + char *p; + for (p = &(yytext[2]); *p; p++) { + constval = (constval << 1) | (*p == '1'); + } + yylval->lng = constval; + return( LONG ); + } + YY_BREAK +case 6: +YY_RULE_SETUP +#line 331 "eval.l" +{ + long int constval = 0; + char *p; + for (p = &(yytext[2]); *p; p++) { + constval = (constval << 3) | (*p - '0'); + } + yylval->lng = constval; + return( LONG ); + } + YY_BREAK +case 7: +YY_RULE_SETUP +#line 340 "eval.l" +{ + long int constval = 0; + char *p; + for (p = &(yytext[2]); *p; p++) { + int v = (isdigit(*p) ? (*p - '0') : (*p - 'a' + 10)); + constval = (constval << 4) | v; + } + yylval->lng = constval; + return( LONG ); + } + YY_BREAK +case 8: +YY_RULE_SETUP +#line 352 "eval.l" +{ + yylval->lng = atol(yytext); + return( LONG ); + } + YY_BREAK +case 9: +YY_RULE_SETUP +#line 356 "eval.l" +{ + if ((yytext[0] == 't') || (yytext[0] == 'T')) + yylval->log = 1; + else + yylval->log = 0; + return( BOOLEAN ); + } + YY_BREAK +case 10: +YY_RULE_SETUP +#line 363 "eval.l" +{ + yylval->dbl = atof(yytext); + return( DOUBLE ); + } + YY_BREAK +case 11: +YY_RULE_SETUP +#line 367 "eval.l" +{ + if( !fits_strcasecmp(yytext,"#PI") ) { + yylval->dbl = (double)(4) * atan((double)(1)); + return( DOUBLE ); + } else if( !fits_strcasecmp(yytext,"#E") ) { + yylval->dbl = exp((double)(1)); + return( DOUBLE ); + } else if( !fits_strcasecmp(yytext,"#DEG") ) { + yylval->dbl = ((double)4)*atan((double)1)/((double)180); + return( DOUBLE ); + } else if( !fits_strcasecmp(yytext,"#ROW") ) { + return( ROWREF ); + } else if( !fits_strcasecmp(yytext,"#NULL") ) { + return( NULLREF ); + } else if( !fits_strcasecmp(yytext,"#SNULL") ) { + return( SNULLREF ); + } else { + int len; + int result; + if (yytext[1] == '$') { + len = strlen(yytext) - 3; + yylval->str[0] = '#'; + strncpy(yylval->str+1,&yytext[2],len); + yylval->str[len+1] = '\0'; + yytext = yylval->str; + } + result = (*yylParse->getData)(yylParse, yytext, (yylval)); + return result; + } + } + YY_BREAK +case 12: +YY_RULE_SETUP +#line 397 "eval.l" +{ + int len; + len = strlen(yytext) - 2; + if (len >= MAX_STRLEN) { + char errMsg[100]; + yylParse->status = PARSE_SYNTAX_ERR; + strcpy (errMsg,"String exceeds maximum length: '"); + strncat(errMsg, &(yytext[1]), 20); + strcat (errMsg,"...'"); + ffpmsg (errMsg); + len = 0; + } else { + strncpy(yylval->str,&yytext[1],len); + } + yylval->str[len] = '\0'; + return( STRING ); + } + YY_BREAK +case 13: +YY_RULE_SETUP +#line 414 "eval.l" +{ + int len,type; + + if (yytext[0] == '$') { + len = strlen(yytext) - 2; + strncpy(yylval->str,&yytext[1],len); + yylval->str[len] = '\0'; + yytext = yylval->str; + } + type = fits_parser_yyGetVariable(yylParse, yytext, (yylval)); + return( type ); + } + YY_BREAK +case 14: +YY_RULE_SETUP +#line 426 "eval.l" +{ + char *fname; + int len=0; + fname = &(yylval->str[0]); + while( (fname[len]=toupper(yytext[len])) ) len++; + + if( FSTRCMP(fname,"BOX(")==0 + || FSTRCMP(fname,"CIRCLE(")==0 + || FSTRCMP(fname,"ELLIPSE(")==0 + || FSTRCMP(fname,"NEAR(")==0 + || FSTRCMP(fname,"ISNULL(")==0 + ) + /* Return type is always boolean */ + return( BFUNCTION ); + + else if( FSTRCMP(fname,"GTIFILTER(")==0 ) + return( GTIFILTER ); + + else if( FSTRCMP(fname,"GTIOVERLAP(")==0 ) + return( GTIOVERLAP ); + + else if( FSTRCMP(fname,"GTIFIND(")==0 ) + return( GTIFIND ); + + else if( FSTRCMP(fname,"REGFILTER(")==0 ) + return( REGFILTER ); + + else if( FSTRCMP(fname,"STRSTR(")==0 ) + return( IFUNCTION ); /* Returns integer */ + + else + return( FUNCTION ); + } + YY_BREAK +case 15: +YY_RULE_SETUP +#line 459 "eval.l" +{ return( INTCAST ); } + YY_BREAK +case 16: +YY_RULE_SETUP +#line 460 "eval.l" +{ return( FLTCAST ); } + YY_BREAK +case 17: +YY_RULE_SETUP +#line 461 "eval.l" +{ return( POWER ); } + YY_BREAK +case 18: +YY_RULE_SETUP +#line 462 "eval.l" +{ return( NOT ); } + YY_BREAK +case 19: +YY_RULE_SETUP +#line 463 "eval.l" +{ return( OR ); } + YY_BREAK +case 20: +YY_RULE_SETUP +#line 464 "eval.l" +{ return( AND ); } + YY_BREAK +case 21: +YY_RULE_SETUP +#line 465 "eval.l" +{ return( EQ ); } + YY_BREAK +case 22: +YY_RULE_SETUP +#line 466 "eval.l" +{ return( NE ); } + YY_BREAK +case 23: +YY_RULE_SETUP +#line 467 "eval.l" +{ return( GT ); } + YY_BREAK +case 24: +YY_RULE_SETUP +#line 468 "eval.l" +{ return( LT ); } + YY_BREAK +case 25: +YY_RULE_SETUP +#line 469 "eval.l" +{ return( GTE ); } + YY_BREAK +case 26: +YY_RULE_SETUP +#line 470 "eval.l" +{ return( LTE ); } + YY_BREAK +case 27: +YY_RULE_SETUP +#line 471 "eval.l" +{ return( XOR ); } + YY_BREAK +case 28: +/* rule 28 can match eol */ +YY_RULE_SETUP +#line 472 "eval.l" +{ return( '\n' ); } + YY_BREAK +case 29: +YY_RULE_SETUP +#line 473 "eval.l" +{ return( yytext[0] ); } + YY_BREAK +case 30: +YY_RULE_SETUP +#line 474 "eval.l" +ECHO; + YY_BREAK +#line 1694 "eval_l.c" +case YY_STATE_EOF(INITIAL): + yyterminate(); + + case YY_END_OF_BUFFER: + { + /* Amount of text matched not including the EOB char. */ + int yy_amount_of_matched_text = (int) (yy_cp - yyg->yytext_ptr) - 1; + + /* Undo the effects of YY_DO_BEFORE_ACTION. */ + *yy_cp = yyg->yy_hold_char; + YY_RESTORE_YY_MORE_OFFSET + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) + { + /* We're scanning a new file or input source. It's + * possible that this happened because the user + * just pointed yyin at a new source and called + * yylex(). If so, then we have to assure + * consistency between YY_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. + */ + yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; + } + + /* Note that here we test for yy_c_buf_p "<=" to the position + * of the first EOB in the buffer, since yy_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 ( yyg->yy_c_buf_p <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) + { /* This was really a NUL. */ + yy_state_type yy_next_state; + + yyg->yy_c_buf_p = yyg->yytext_ptr + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( yyscanner ); + + /* Okay, we're now positioned to make the NUL + * transition. We couldn't have + * yy_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). + */ + + yy_next_state = yy_try_NUL_trans( yy_current_state , yyscanner); + + yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; + + if ( yy_next_state ) + { + /* Consume the NUL. */ + yy_cp = ++yyg->yy_c_buf_p; + yy_current_state = yy_next_state; + goto yy_match; + } + + else + { + yy_cp = yyg->yy_c_buf_p; + goto yy_find_action; + } + } + + else switch ( yy_get_next_buffer( yyscanner ) ) + { + case EOB_ACT_END_OF_FILE: + { + yyg->yy_did_buffer_switch_on_eof = 0; + + if ( yywrap( yyscanner ) ) + { + /* Note: because we've taken care in + * yy_get_next_buffer() to have set up + * yytext, we can now set up + * yy_c_buf_p so that if some total + * hoser (like flex itself) wants to + * call the scanner after we return the + * YY_NULL, it'll still work - another + * YY_NULL will get returned. + */ + yyg->yy_c_buf_p = yyg->yytext_ptr + YY_MORE_ADJ; + + yy_act = YY_STATE_EOF(YY_START); + goto do_action; + } + + else + { + if ( ! yyg->yy_did_buffer_switch_on_eof ) + YY_NEW_FILE; + } + break; + } + + case EOB_ACT_CONTINUE_SCAN: + yyg->yy_c_buf_p = + yyg->yytext_ptr + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( yyscanner ); + + yy_cp = yyg->yy_c_buf_p; + yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; + goto yy_match; + + case EOB_ACT_LAST_MATCH: + yyg->yy_c_buf_p = + &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars]; + + yy_current_state = yy_get_previous_state( yyscanner ); + + yy_cp = yyg->yy_c_buf_p; + yy_bp = yyg->yytext_ptr + YY_MORE_ADJ; + goto yy_find_action; + } + break; + } + + default: + YY_FATAL_ERROR( + "fatal flex scanner internal error--no action found" ); + } /* end of action switch */ + } /* end of scanning one token */ + } /* end of user's declarations */ +} /* end of yylex */ + +/* yy_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 yy_get_next_buffer (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; + char *source = yyg->yytext_ptr; + int number_to_move, i; + int ret_val; + + if ( yyg->yy_c_buf_p > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] ) + YY_FATAL_ERROR( + "fatal flex scanner internal error--end of buffer missed" ); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) + { /* Don't try to fill the buffer, so this is an EOF. */ + if ( yyg->yy_c_buf_p - yyg->yytext_ptr - YY_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) (yyg->yy_c_buf_p - yyg->yytext_ptr - 1); + + for ( i = 0; i < number_to_move; ++i ) + *(dest++) = *(source++); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) + /* don't do the read, it's not guaranteed to return an EOF, + * just force an EOF + */ + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars = 0; + + else + { + int num_to_read = + YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; + + while ( num_to_read <= 0 ) + { /* Not enough room in the buffer - grow it. */ + + /* just a shorter name for the current buffer */ + YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; + + int yy_c_buf_p_offset = + (int) (yyg->yy_c_buf_p - b->yy_ch_buf); + + if ( b->yy_is_our_buffer ) + { + int new_size = b->yy_buf_size * 2; + + if ( new_size <= 0 ) + b->yy_buf_size += b->yy_buf_size / 8; + else + b->yy_buf_size *= 2; + + b->yy_ch_buf = (char *) + /* Include room in for 2 EOB chars. */ + yyrealloc( (void *) b->yy_ch_buf, + (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); + } + else + /* Can't grow it, we don't own it. */ + b->yy_ch_buf = NULL; + + if ( ! b->yy_ch_buf ) + YY_FATAL_ERROR( + "fatal error - scanner input buffer overflow" ); + + yyg->yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset]; + + num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - + number_to_move - 1; + + } + + if ( num_to_read > YY_READ_BUF_SIZE ) + num_to_read = YY_READ_BUF_SIZE; + + /* Read in more data. */ + YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), + yyg->yy_n_chars, num_to_read ); + + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; + } + + if ( yyg->yy_n_chars == 0 ) + { + if ( number_to_move == YY_MORE_ADJ ) + { + ret_val = EOB_ACT_END_OF_FILE; + yyrestart( yyin , yyscanner); + } + + else + { + ret_val = EOB_ACT_LAST_MATCH; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = + YY_BUFFER_EOF_PENDING; + } + } + + else + ret_val = EOB_ACT_CONTINUE_SCAN; + + if ((yyg->yy_n_chars + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { + /* Extend the array by 50%, plus the number we really need. */ + int new_size = yyg->yy_n_chars + number_to_move + (yyg->yy_n_chars >> 1); + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc( + (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size , yyscanner ); + if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); + /* "- 2" to take care of EOB's */ + YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2); + } + + yyg->yy_n_chars += number_to_move; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] = YY_END_OF_BUFFER_CHAR; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR; + + yyg->yytext_ptr = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; + + return ret_val; +} + +/* yy_get_previous_state - get the state just before the EOB char was reached */ + + static yy_state_type yy_get_previous_state (yyscan_t yyscanner) +{ + yy_state_type yy_current_state; + char *yy_cp; + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + yy_current_state = yyg->yy_start; + + for ( yy_cp = yyg->yytext_ptr + YY_MORE_ADJ; yy_cp < yyg->yy_c_buf_p; ++yy_cp ) + { + YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); + if ( yy_accept[yy_current_state] ) + { + yyg->yy_last_accepting_state = yy_current_state; + yyg->yy_last_accepting_cpos = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 174 ) + yy_c = yy_meta[yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; + } + + return yy_current_state; +} + +/* yy_try_NUL_trans - try to make a transition on the NUL character + * + * synopsis + * next_state = yy_try_NUL_trans( current_state ); + */ + static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state , yyscan_t yyscanner) +{ + int yy_is_jam; + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; /* This var may be unused depending upon options. */ + char *yy_cp = yyg->yy_c_buf_p; + + YY_CHAR yy_c = 1; + if ( yy_accept[yy_current_state] ) + { + yyg->yy_last_accepting_state = yy_current_state; + yyg->yy_last_accepting_cpos = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 174 ) + yy_c = yy_meta[yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; + yy_is_jam = (yy_current_state == 173); + + (void)yyg; + return yy_is_jam ? 0 : yy_current_state; +} + +#ifndef YY_NO_UNPUT + + static void yyunput (int c, char * yy_bp , yyscan_t yyscanner) +{ + char *yy_cp; + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + yy_cp = yyg->yy_c_buf_p; + + /* undo effects of setting up yytext */ + *yy_cp = yyg->yy_hold_char; + + if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) + { /* need to shift things up to make room */ + /* +2 for EOB chars. */ + int number_to_move = yyg->yy_n_chars + 2; + char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[ + YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2]; + char *source = + &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]; + + while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) + *--dest = *--source; + + yy_cp += (int) (dest - source); + yy_bp += (int) (dest - source); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = + yyg->yy_n_chars = (int) YY_CURRENT_BUFFER_LVALUE->yy_buf_size; + + if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) + YY_FATAL_ERROR( "flex scanner push-back overflow" ); + } + + *--yy_cp = (char) c; + + yyg->yytext_ptr = yy_bp; + yyg->yy_hold_char = *yy_cp; + yyg->yy_c_buf_p = yy_cp; +} + +#endif + +#ifndef YY_NO_INPUT +#ifdef __cplusplus + static int yyinput (yyscan_t yyscanner) +#else + static int input (yyscan_t yyscanner) +#endif + +{ + int c; + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + *yyg->yy_c_buf_p = yyg->yy_hold_char; + + if ( *yyg->yy_c_buf_p == YY_END_OF_BUFFER_CHAR ) + { + /* yy_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 ( yyg->yy_c_buf_p < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[yyg->yy_n_chars] ) + /* This was really a NUL. */ + *yyg->yy_c_buf_p = '\0'; + + else + { /* need more input */ + int offset = (int) (yyg->yy_c_buf_p - yyg->yytext_ptr); + ++yyg->yy_c_buf_p; + + switch ( yy_get_next_buffer( yyscanner ) ) + { + case EOB_ACT_LAST_MATCH: + /* This happens because yy_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. */ + yyrestart( yyin , yyscanner); + + /*FALLTHROUGH*/ + + case EOB_ACT_END_OF_FILE: + { + if ( yywrap( yyscanner ) ) + return 0; + + if ( ! yyg->yy_did_buffer_switch_on_eof ) + YY_NEW_FILE; +#ifdef __cplusplus + return yyinput(yyscanner); +#else + return input(yyscanner); +#endif + } + + case EOB_ACT_CONTINUE_SCAN: + yyg->yy_c_buf_p = yyg->yytext_ptr + offset; + break; + } + } + } + + c = *(unsigned char *) yyg->yy_c_buf_p; /* cast for 8-bit char's */ + *yyg->yy_c_buf_p = '\0'; /* preserve yytext */ + yyg->yy_hold_char = *++yyg->yy_c_buf_p; + + return c; +} +#endif /* ifndef YY_NO_INPUT */ + +/** Immediately switch to a different input stream. + * @param input_file A readable stream. + * @param yyscanner The scanner object. + * @note This function does not reset the start condition to @c INITIAL . + */ + void yyrestart (FILE * input_file , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + if ( ! YY_CURRENT_BUFFER ){ + yyensure_buffer_stack (yyscanner); + YY_CURRENT_BUFFER_LVALUE = + yy_create_buffer( yyin, YY_BUF_SIZE , yyscanner); + } + + yy_init_buffer( YY_CURRENT_BUFFER, input_file , yyscanner); + yy_load_buffer_state( yyscanner ); +} + +/** Switch to a different input buffer. + * @param new_buffer The new input buffer. + * @param yyscanner The scanner object. + */ + void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + /* TODO. We should be able to replace this entire function body + * with + * yypop_buffer_state(); + * yypush_buffer_state(new_buffer); + */ + yyensure_buffer_stack (yyscanner); + if ( YY_CURRENT_BUFFER == new_buffer ) + return; + + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *yyg->yy_c_buf_p = yyg->yy_hold_char; + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; + } + + YY_CURRENT_BUFFER_LVALUE = new_buffer; + yy_load_buffer_state( yyscanner ); + + /* We don't actually know whether we did this switch during + * EOF (yywrap()) processing, but the only time this flag + * is looked at is after yywrap() is called, so it's safe + * to go ahead and always set it. + */ + yyg->yy_did_buffer_switch_on_eof = 1; +} + +static void yy_load_buffer_state (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + yyg->yy_n_chars = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + yyg->yytext_ptr = yyg->yy_c_buf_p = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; + yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; + yyg->yy_hold_char = *yyg->yy_c_buf_p; +} + +/** Allocate and initialize an input buffer state. + * @param file A readable stream. + * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. + * @param yyscanner The scanner object. + * @return the allocated buffer state. + */ + YY_BUFFER_STATE yy_create_buffer (FILE * file, int size , yyscan_t yyscanner) +{ + YY_BUFFER_STATE b; + + b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); + + b->yy_buf_size = size; + + /* yy_ch_buf has to be 2 characters longer than the size given because + * we need to put in 2 end-of-buffer characters. + */ + b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) , yyscanner ); + if ( ! b->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); + + b->yy_is_our_buffer = 1; + + yy_init_buffer( b, file , yyscanner); + + return b; +} + +/** Destroy the buffer. + * @param b a buffer created with yy_create_buffer() + * @param yyscanner The scanner object. + */ + void yy_delete_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + if ( ! b ) + return; + + if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ + YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; + + if ( b->yy_is_our_buffer ) + yyfree( (void *) b->yy_ch_buf , yyscanner ); + + yyfree( (void *) b , yyscanner ); +} + +/* Initializes or reinitializes a buffer. + * This function is sometimes called more than once on the same buffer, + * such as during a yyrestart() or at EOF. + */ + static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file , yyscan_t yyscanner) + +{ + int oerrno = errno; + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + yy_flush_buffer( b , yyscanner); + + b->yy_input_file = file; + b->yy_fill_buffer = 1; + + /* If b is the current buffer, then yy_init_buffer was _probably_ + * called from yyrestart() or through yy_get_next_buffer. + * In that case, we don't want to reset the lineno or column. + */ + if (b != YY_CURRENT_BUFFER){ + b->yy_bs_lineno = 1; + b->yy_bs_column = 0; + } + + b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; + + errno = oerrno; +} + +/** Discard all buffered characters. On the next scan, YY_INPUT will be called. + * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. + * @param yyscanner The scanner object. + */ + void yy_flush_buffer (YY_BUFFER_STATE b , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + if ( ! b ) + return; + + b->yy_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->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; + b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; + + b->yy_buf_pos = &b->yy_ch_buf[0]; + + b->yy_at_bol = 1; + b->yy_buffer_status = YY_BUFFER_NEW; + + if ( b == YY_CURRENT_BUFFER ) + yy_load_buffer_state( yyscanner ); +} + +/** Pushes the new state onto the stack. The new state becomes + * the current state. This function will allocate the stack + * if necessary. + * @param new_buffer The new state. + * @param yyscanner The scanner object. + */ +void yypush_buffer_state (YY_BUFFER_STATE new_buffer , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + if (new_buffer == NULL) + return; + + yyensure_buffer_stack(yyscanner); + + /* This block is copied from yy_switch_to_buffer. */ + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *yyg->yy_c_buf_p = yyg->yy_hold_char; + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = yyg->yy_c_buf_p; + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = yyg->yy_n_chars; + } + + /* Only push if top exists. Otherwise, replace top. */ + if (YY_CURRENT_BUFFER) + yyg->yy_buffer_stack_top++; + YY_CURRENT_BUFFER_LVALUE = new_buffer; + + /* copied from yy_switch_to_buffer. */ + yy_load_buffer_state( yyscanner ); + yyg->yy_did_buffer_switch_on_eof = 1; +} + +/** Removes and deletes the top of the stack, if present. + * The next element becomes the new top. + * @param yyscanner The scanner object. + */ +void yypop_buffer_state (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + if (!YY_CURRENT_BUFFER) + return; + + yy_delete_buffer(YY_CURRENT_BUFFER , yyscanner); + YY_CURRENT_BUFFER_LVALUE = NULL; + if (yyg->yy_buffer_stack_top > 0) + --yyg->yy_buffer_stack_top; + + if (YY_CURRENT_BUFFER) { + yy_load_buffer_state( yyscanner ); + yyg->yy_did_buffer_switch_on_eof = 1; + } +} + +/* Allocates the stack if it does not exist. + * Guarantees space for at least one push. + */ +static void yyensure_buffer_stack (yyscan_t yyscanner) +{ + yy_size_t num_to_alloc; + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + if (!yyg->yy_buffer_stack) { + + /* First allocation is just for 2 elements, since we don't know if this + * scanner will even need a stack. We use 2 instead of 1 to avoid an + * immediate realloc on the next call. + */ + num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */ + yyg->yy_buffer_stack = (struct yy_buffer_state**)yyalloc + (num_to_alloc * sizeof(struct yy_buffer_state*) + , yyscanner); + if ( ! yyg->yy_buffer_stack ) + YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); + + memset(yyg->yy_buffer_stack, 0, num_to_alloc * sizeof(struct yy_buffer_state*)); + + yyg->yy_buffer_stack_max = num_to_alloc; + yyg->yy_buffer_stack_top = 0; + return; + } + + if (yyg->yy_buffer_stack_top >= (yyg->yy_buffer_stack_max) - 1){ + + /* Increase the buffer to prepare for a possible push. */ + yy_size_t grow_size = 8 /* arbitrary grow size */; + + num_to_alloc = yyg->yy_buffer_stack_max + grow_size; + yyg->yy_buffer_stack = (struct yy_buffer_state**)yyrealloc + (yyg->yy_buffer_stack, + num_to_alloc * sizeof(struct yy_buffer_state*) + , yyscanner); + if ( ! yyg->yy_buffer_stack ) + YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); + + /* zero only the new slots.*/ + memset(yyg->yy_buffer_stack + yyg->yy_buffer_stack_max, 0, grow_size * sizeof(struct yy_buffer_state*)); + yyg->yy_buffer_stack_max = num_to_alloc; + } +} + +/** Setup the input buffer state to scan directly from a user-specified character buffer. + * @param base the character buffer + * @param size the size in bytes of the character buffer + * @param yyscanner The scanner object. + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size , yyscan_t yyscanner) +{ + YY_BUFFER_STATE b; + + if ( size < 2 || + base[size-2] != YY_END_OF_BUFFER_CHAR || + base[size-1] != YY_END_OF_BUFFER_CHAR ) + /* They forgot to leave room for the EOB's. */ + return NULL; + + b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) , yyscanner ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" ); + + b->yy_buf_size = (int) (size - 2); /* "- 2" to take care of EOB's */ + b->yy_buf_pos = b->yy_ch_buf = base; + b->yy_is_our_buffer = 0; + b->yy_input_file = NULL; + b->yy_n_chars = b->yy_buf_size; + b->yy_is_interactive = 0; + b->yy_at_bol = 1; + b->yy_fill_buffer = 0; + b->yy_buffer_status = YY_BUFFER_NEW; + + yy_switch_to_buffer( b , yyscanner ); + + return b; +} + +/** Setup the input buffer state to scan a string. The next call to yylex() will + * scan from a @e copy of @a str. + * @param yystr a NUL-terminated string to scan + * @param yyscanner The scanner object. + * @return the newly allocated buffer state object. + * @note If you want to scan bytes that may contain NUL values, then use + * yy_scan_bytes() instead. + */ +YY_BUFFER_STATE yy_scan_string (const char * yystr , yyscan_t yyscanner) +{ + + return yy_scan_bytes( yystr, (int) strlen(yystr) , yyscanner); +} + +/** Setup the input buffer state to scan the given bytes. The next call to yylex() will + * scan from a @e copy of @a bytes. + * @param yybytes the byte buffer to scan + * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. + * @param yyscanner The scanner object. + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len , yyscan_t yyscanner) +{ + YY_BUFFER_STATE b; + char *buf; + yy_size_t n; + int i; + + /* Get memory for full buffer, including space for trailing EOB's. */ + n = (yy_size_t) (_yybytes_len + 2); + buf = (char *) yyalloc( n , yyscanner ); + if ( ! buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" ); + + for ( i = 0; i < _yybytes_len; ++i ) + buf[i] = yybytes[i]; + + buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; + + b = yy_scan_buffer( buf, n , yyscanner); + if ( ! b ) + YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" ); + + /* It's okay to grow etc. this buffer, and we should throw it + * away when we're done. + */ + b->yy_is_our_buffer = 1; + + return b; +} + +#ifndef YY_EXIT_FAILURE +#define YY_EXIT_FAILURE 2 +#endif + +static void yynoreturn yy_fatal_error (const char* msg , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + (void)yyg; + fprintf( stderr, "%s\n", msg ); + exit( YY_EXIT_FAILURE ); +} + +/* Redefine yyless() so it works in section 3 code. */ + +#undef yyless +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up yytext. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + yytext[yyleng] = yyg->yy_hold_char; \ + yyg->yy_c_buf_p = yytext + yyless_macro_arg; \ + yyg->yy_hold_char = *yyg->yy_c_buf_p; \ + *yyg->yy_c_buf_p = '\0'; \ + yyleng = yyless_macro_arg; \ + } \ + while ( 0 ) + +/* Accessor methods (get/set functions) to struct members. */ + +/** Get the user-defined data for this scanner. + * @param yyscanner The scanner object. + */ +YY_EXTRA_TYPE yyget_extra (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + return yyextra; +} + +/** Get the current line number. + * @param yyscanner The scanner object. + */ +int yyget_lineno (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + if (! YY_CURRENT_BUFFER) + return 0; + + return yylineno; +} + +/** Get the current column number. + * @param yyscanner The scanner object. + */ +int yyget_column (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + if (! YY_CURRENT_BUFFER) + return 0; + + return yycolumn; +} + +/** Get the input stream. + * @param yyscanner The scanner object. + */ +FILE *yyget_in (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + return yyin; +} + +/** Get the output stream. + * @param yyscanner The scanner object. + */ +FILE *yyget_out (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + return yyout; +} + +/** Get the length of the current token. + * @param yyscanner The scanner object. + */ +int yyget_leng (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + return yyleng; +} + +/** Get the current token. + * @param yyscanner The scanner object. + */ + +char *yyget_text (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + return yytext; +} + +/** Set the user-defined data. This data is never touched by the scanner. + * @param user_defined The data to be associated with this scanner. + * @param yyscanner The scanner object. + */ +void yyset_extra (YY_EXTRA_TYPE user_defined , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + yyextra = user_defined ; +} + +/** Set the current line number. + * @param _line_number line number + * @param yyscanner The scanner object. + */ +void yyset_lineno (int _line_number , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + /* lineno is only valid if an input buffer exists. */ + if (! YY_CURRENT_BUFFER ) + YY_FATAL_ERROR( "yyset_lineno called with no buffer" ); + + yylineno = _line_number; +} + +/** Set the current column. + * @param _column_no column number + * @param yyscanner The scanner object. + */ +void yyset_column (int _column_no , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + /* column is only valid if an input buffer exists. */ + if (! YY_CURRENT_BUFFER ) + YY_FATAL_ERROR( "yyset_column called with no buffer" ); + + yycolumn = _column_no; +} + +/** Set the input stream. This does not discard the current + * input buffer. + * @param _in_str A readable stream. + * @param yyscanner The scanner object. + * @see yy_switch_to_buffer + */ +void yyset_in (FILE * _in_str , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + yyin = _in_str ; +} + +void yyset_out (FILE * _out_str , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + yyout = _out_str ; +} + +int yyget_debug (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + return yy_flex_debug; +} + +void yyset_debug (int _bdebug , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + yy_flex_debug = _bdebug ; +} + +/* Accessor methods for yylval and yylloc */ + +YYSTYPE * yyget_lval (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + return yylval; +} + +void yyset_lval (YYSTYPE * yylval_param , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + yylval = yylval_param; +} + +/* User-visible API */ + +/* yylex_init is special because it creates the scanner itself, so it is + * the ONLY reentrant function that doesn't take the scanner as the last argument. + * That's why we explicitly handle the declaration, instead of using our macros. + */ +int yylex_init(yyscan_t* ptr_yy_globals) +{ + if (ptr_yy_globals == NULL){ + errno = EINVAL; + return 1; + } + + *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), NULL ); + + if (*ptr_yy_globals == NULL){ + errno = ENOMEM; + return 1; + } + + /* By setting to 0xAA, we expose bugs in yy_init_globals. Leave at 0x00 for releases. */ + memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); + + return yy_init_globals ( *ptr_yy_globals ); +} + +/* yylex_init_extra has the same functionality as yylex_init, but follows the + * convention of taking the scanner as the last argument. Note however, that + * this is a *pointer* to a scanner, as it will be allocated by this call (and + * is the reason, too, why this function also must handle its own declaration). + * The user defined value in the first argument will be available to yyalloc in + * the yyextra field. + */ +int yylex_init_extra( YY_EXTRA_TYPE yy_user_defined, yyscan_t* ptr_yy_globals ) +{ + struct yyguts_t dummy_yyguts; + + yyset_extra (yy_user_defined, &dummy_yyguts); + + if (ptr_yy_globals == NULL){ + errno = EINVAL; + return 1; + } + + *ptr_yy_globals = (yyscan_t) yyalloc ( sizeof( struct yyguts_t ), &dummy_yyguts ); + + if (*ptr_yy_globals == NULL){ + errno = ENOMEM; + return 1; + } + + /* By setting to 0xAA, we expose bugs in + yy_init_globals. Leave at 0x00 for releases. */ + memset(*ptr_yy_globals,0x00,sizeof(struct yyguts_t)); + + yyset_extra (yy_user_defined, *ptr_yy_globals); + + return yy_init_globals ( *ptr_yy_globals ); +} + +static int yy_init_globals (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + /* Initialization is the same as for the non-reentrant scanner. + * This function is called from yylex_destroy(), so don't allocate here. + */ + + yyg->yy_buffer_stack = NULL; + yyg->yy_buffer_stack_top = 0; + yyg->yy_buffer_stack_max = 0; + yyg->yy_c_buf_p = NULL; + yyg->yy_init = 0; + yyg->yy_start = 0; + + yyg->yy_start_stack_ptr = 0; + yyg->yy_start_stack_depth = 0; + yyg->yy_start_stack = NULL; + +/* Defined in main.c */ +#ifdef YY_STDINIT + yyin = stdin; + yyout = stdout; +#else + yyin = NULL; + yyout = NULL; +#endif + + /* For future reference: Set errno on error, since we are called by + * yylex_init() + */ + return 0; +} + +/* yylex_destroy is for both reentrant and non-reentrant scanners. */ +int yylex_destroy (yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + + /* Pop the buffer stack, destroying each element. */ + while(YY_CURRENT_BUFFER){ + yy_delete_buffer( YY_CURRENT_BUFFER , yyscanner ); + YY_CURRENT_BUFFER_LVALUE = NULL; + yypop_buffer_state(yyscanner); + } + + /* Destroy the stack itself. */ + yyfree(yyg->yy_buffer_stack , yyscanner); + yyg->yy_buffer_stack = NULL; + + /* Destroy the start condition stack. */ + yyfree( yyg->yy_start_stack , yyscanner ); + yyg->yy_start_stack = NULL; + + /* Reset the globals. This is important in a non-reentrant scanner so the next time + * yylex() is called, initialization will occur. */ + yy_init_globals( yyscanner); + + /* Destroy the main struct (reentrant only). */ + yyfree ( yyscanner , yyscanner ); + yyscanner = NULL; + return 0; +} + +/* + * Internal utility routines. + */ + +#ifndef yytext_ptr +static void yy_flex_strncpy (char* s1, const char * s2, int n , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + (void)yyg; + + int i; + for ( i = 0; i < n; ++i ) + s1[i] = s2[i]; +} +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen (const char * s , yyscan_t yyscanner) +{ + int n; + for ( n = 0; s[n]; ++n ) + ; + + return n; +} +#endif + +void *yyalloc (yy_size_t size , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + (void)yyg; + return malloc(size); +} + +void *yyrealloc (void * ptr, yy_size_t size , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + (void)yyg; + + /* 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 realloc(ptr, size); +} + +void yyfree (void * ptr , yyscan_t yyscanner) +{ + struct yyguts_t * yyg = (struct yyguts_t*)yyscanner; + (void)yyg; + free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ +} + +#define YYTABLES_NAME "yytables" + +#line 474 "eval.l" + + +int yywrap(yyscan_t scanner) +{ + /* MJT -- 13 June 1996 + Supplied for compatibility with + pre-2.5.1 versions of flex which + do not recognize %option noyywrap + */ + return(1); +} + +/* + expr_read is lifted from old ftools.skel. + Now we can use any version of flex with + no .skel file necessary! MJT - 13 June 1996 + + keep a memory of how many bytes have been + read previously, so that an unlimited-sized + buffer can be supported. PDW - 28 Feb 1998 +*/ + +static int expr_read(ParseData *lParse, char *buf, int nbytes) +{ + int n; + + n = 0; + if( !lParse->is_eobuf ) { + do { + buf[n++] = lParse->expr[lParse->index++]; + } while ((nexpr[lParse->index] != '\0')); + if( lParse->expr[lParse->index] == '\0' ) lParse->is_eobuf = 1; + } + buf[n] = '\0'; + return(n); +} + +int fits_parser_yyGetVariable( ParseData *lParse, char *varName, FITS_PARSER_YYSTYPE *thelval ) +{ + int varNum, type; + char errMsg[MAXVARNAME+25]; + + varNum = find_variable( lParse, varName ); + if( varNum<0 ) { + if( lParse->getData ) { + type = (*lParse->getData)( lParse, varName, thelval ); + } else { + type = pERROR; + lParse->status = PARSE_SYNTAX_ERR; + strcpy (errMsg,"Unable to find data: "); + strncat(errMsg, varName, MAXVARNAME); + ffpmsg (errMsg); + } + } else { + /* Convert variable type into expression type */ + switch( lParse->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; + lParse->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(ParseData *lParse, char *varName) +{ + int i; + + if( lParse->nCols ) + for( i=0; inCols; i++ ) { + if( ! fits_strncasecmp(lParse->varData[i].name,varName,MAXVARNAME) ) { + return( i ); + } + } + return( -1 ); +} + diff --git a/vendor/cfitsio/eval_tab.h b/vendor/cfitsio/eval_tab.h new file mode 100644 index 000000000..9d6b545eb --- /dev/null +++ b/vendor/cfitsio/eval_tab.h @@ -0,0 +1,130 @@ +/* A Bison parser, made by GNU Bison 3.8. */ + +/* Bison interface for Yacc-like parsers in C + + Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 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 3 of the License, 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, see . */ + +/* As a special exception, you may create a larger work that contains + part or all of the Bison parser skeleton and distribute that work + under terms of your choice, so long as that work isn't itself a + parser generator using the skeleton or a modified version thereof + as a parser skeleton. Alternatively, if you modify or redistribute + the parser skeleton itself, you may (at your option) remove this + special exception, which will cause the skeleton and the resulting + Bison output files to be licensed under the GNU General Public + License without this special exception. + + This special exception was added by the Free Software Foundation in + version 2.2 of Bison. */ + +/* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, + especially those whose name start with YY_ or yy_. They are + private implementation details that can be changed or removed. */ + +#ifndef YY_FITS_PARSER_YY_EVAL_TAB_H_INCLUDED +# define YY_FITS_PARSER_YY_EVAL_TAB_H_INCLUDED +/* Debug traces. */ +#ifndef FITS_PARSER_YYDEBUG +# if defined YYDEBUG +#if YYDEBUG +# define FITS_PARSER_YYDEBUG 1 +# else +# define FITS_PARSER_YYDEBUG 0 +# endif +# else /* ! defined YYDEBUG */ +# define FITS_PARSER_YYDEBUG 0 +# endif /* ! defined YYDEBUG */ +#endif /* ! defined FITS_PARSER_YYDEBUG */ +#if FITS_PARSER_YYDEBUG +extern int fits_parser_yydebug; +#endif + +/* Token kinds. */ +#ifndef FITS_PARSER_YYTOKENTYPE +# define FITS_PARSER_YYTOKENTYPE + enum fits_parser_yytokentype + { + FITS_PARSER_YYEMPTY = -2, + FITS_PARSER_YYEOF = 0, /* "end of file" */ + FITS_PARSER_YYerror = 256, /* error */ + FITS_PARSER_YYUNDEF = 257, /* "invalid token" */ + BOOLEAN = 258, /* BOOLEAN */ + LONG = 259, /* LONG */ + DOUBLE = 260, /* DOUBLE */ + STRING = 261, /* STRING */ + BITSTR = 262, /* BITSTR */ + FUNCTION = 263, /* FUNCTION */ + BFUNCTION = 264, /* BFUNCTION */ + IFUNCTION = 265, /* IFUNCTION */ + GTIFILTER = 266, /* GTIFILTER */ + GTIOVERLAP = 267, /* GTIOVERLAP */ + GTIFIND = 268, /* GTIFIND */ + REGFILTER = 269, /* REGFILTER */ + COLUMN = 270, /* COLUMN */ + BCOLUMN = 271, /* BCOLUMN */ + SCOLUMN = 272, /* SCOLUMN */ + BITCOL = 273, /* BITCOL */ + ROWREF = 274, /* ROWREF */ + NULLREF = 275, /* NULLREF */ + SNULLREF = 276, /* SNULLREF */ + OR = 277, /* OR */ + AND = 278, /* AND */ + EQ = 279, /* EQ */ + NE = 280, /* NE */ + GT = 281, /* GT */ + LT = 282, /* LT */ + LTE = 283, /* LTE */ + GTE = 284, /* GTE */ + XOR = 285, /* XOR */ + POWER = 286, /* POWER */ + NOT = 287, /* NOT */ + INTCAST = 288, /* INTCAST */ + FLTCAST = 289, /* FLTCAST */ + UMINUS = 290, /* UMINUS */ + ACCUM = 291, /* ACCUM */ + DIFF = 292 /* DIFF */ + }; + typedef enum fits_parser_yytokentype fits_parser_yytoken_kind_t; +#endif + +/* Value type. */ +#if ! defined FITS_PARSER_YYSTYPE && ! defined FITS_PARSER_YYSTYPE_IS_DECLARED +union FITS_PARSER_YYSTYPE +{ +#line 212 "eval.y" + + int Node; /* Index of Node */ + double dbl; /* real value */ + long lng; /* integer value */ + char log; /* logical value */ + char str[MAX_STRLEN]; /* string value */ + +#line 117 "eval_tab.h" + +}; +typedef union FITS_PARSER_YYSTYPE FITS_PARSER_YYSTYPE; +# define FITS_PARSER_YYSTYPE_IS_TRIVIAL 1 +# define FITS_PARSER_YYSTYPE_IS_DECLARED 1 +#endif + + + + +int fits_parser_yyparse (yyscan_t scanner, ParseData *lParse); + + +#endif /* !YY_FITS_PARSER_YY_EVAL_TAB_H_INCLUDED */ diff --git a/vendor/cfitsio/eval_y.c b/vendor/cfitsio/eval_y.c new file mode 100644 index 000000000..08f42029a --- /dev/null +++ b/vendor/cfitsio/eval_y.c @@ -0,0 +1,8607 @@ +/* A Bison parser, made by GNU Bison 3.8. */ + +/* Bison implementation for Yacc-like parsers in C + + Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2021 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 3 of the License, 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, see . */ + +/* As a special exception, you may create a larger work that contains + part or all of the Bison parser skeleton and distribute that work + under terms of your choice, so long as that work isn't itself a + parser generator using the skeleton or a modified version thereof + as a parser skeleton. Alternatively, if you modify or redistribute + the parser skeleton itself, you may (at your option) remove this + special exception, which will cause the skeleton and the resulting + Bison output files to be licensed under the GNU General Public + License without this special exception. + + This special exception was added by the Free Software Foundation in + version 2.2 of Bison. */ + +/* C LALR(1) parser skeleton written by Richard Stallman, by + simplifying the original so-called "semantic" parser. */ + +/* DO NOT RELY ON FEATURES THAT ARE NOT DOCUMENTED in the manual, + especially those whose name start with YY_ or yy_. They are + private implementation details that can be changed or removed. */ + +/* All symbols defined below should begin with yy or YY, to avoid + infringing on user name space. This should be done even for local + variables, as they might otherwise be expanded by user macros. + There are some unavoidable exceptions within include files to + define necessary library symbols; they are noted "INFRINGES ON + USER NAME SPACE" below. */ + +/* Identify Bison output, and Bison version. */ +#define YYBISON 30800 + +/* Bison version string. */ +#define YYBISON_VERSION "3.8" + +/* Skeleton name. */ +#define YYSKELETON_NAME "yacc.c" + +/* Pure parsers. */ +#define YYPURE 2 + +/* Push parsers. */ +#define YYPUSH 0 + +/* Pull parsers. */ +#define YYPULL 1 + +/* Substitute the type names. */ +#define YYSTYPE FITS_PARSER_YYSTYPE +/* Substitute the variable and function names. */ +#define yyparse fits_parser_yyparse +#define yylex fits_parser_yylex +#define yyerror fits_parser_yyerror +#define yydebug fits_parser_yydebug +#define yynerrs fits_parser_yynerrs + +/* First part of user prologue. */ +#line 16 "eval.y" + +/* 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*/ +/* Craig B Markwardt Dec 2019 Add bit/hex/oct literal strings and */ +/* bitwise operatiosn between integers */ +/* Craig B Markwardt Mar 2021 Add SETNULL() function */ +/* */ +/************************************************************************/ + +#define APPROX 1.0e-7 +#include "eval_defs.h" +#include "region.h" +#include + +#include + +#ifndef alloca +#define alloca malloc +#endif + +/* Random number generators for various distributions */ +#include "simplerng.h" + + /* Shrink the initial stack depth to keep local data <32K (mac limit) */ + /* yacc will allocate more space if needed, though. */ +#define YYINITDEPTH 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 YYNEWBACKUP(token, value) \ + do \ + if (yychar == YYEMPTY ) \ + { yychar = (token); \ + memcpy( &yylval, &(value), sizeof(value) ); \ + yychar1 = YYTRANSLATE (yychar); \ + while (yylen--) YYPOPSTACK; \ + yystate = *yyssp; \ + goto yybackup; \ + } \ + else \ + { yyerror ("syntax error: cannot back up"); YYERROR; } \ + while (0) + +/***************************************************************/ +/* Useful macros for accessing/testing Nodes */ +/***************************************************************/ + +#define TEST(a) if( (a)<0 ) YYERROR +#define SIZE(a) lParse->Nodes[ a ].value.nelem +#define TYPE(a) lParse->Nodes[ a ].type +#define OPER(a) lParse->Nodes[ a ].operation +#define PROMOTE(a,b) if( TYPE(a) > TYPE(b) ) \ + b = New_Unary( lParse, TYPE(a), 0, b ); \ + else if( TYPE(a) < TYPE(b) ) \ + a = New_Unary( lParse, TYPE(b), 0, a ); + +/***** Internal functions *****/ + +#ifdef __cplusplus +extern "C" { +#endif + +static int Alloc_Node ( ParseData * ); +static void Free_Last_Node( ParseData * ); +static void Evaluate_Node ( ParseData *, int thisNode ); + +static int New_Const ( ParseData *, int returnType, void *value, long len ); +static int New_Column( ParseData *, int ColNum ); +static int New_Offset( ParseData *, int ColNum, int offset ); +static int New_Unary ( ParseData *, int returnType, int Op, int Node1 ); +static int New_BinOp ( ParseData *, int returnType, int Node1, int Op, int Node2 ); +static int New_Func ( ParseData *, int returnType, funcOp Op, int nNodes, + int Node1, int Node2, int Node3, int Node4, + int Node5, int Node6, int Node7 ); +static int New_FuncSize( ParseData *, 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 ( ParseData *, int Var, int nDim, + int Dim1, int Dim2, int Dim3, int Dim4, int Dim5 ); +static int New_GTI ( ParseData *, funcOp Op, char *fname, int Node1, int Node2, char *start, char *stop ); +static int New_REG ( ParseData *, char *fname, int NodeX, int NodeY, char *colNames ); +static int New_Vector( ParseData *, int subNode ); +static int Close_Vec ( ParseData *, int vecNode ); +static int New_Array( ParseData *, int valueNode, int dimNode ); +static int Locate_Col( ParseData *, Node *this ); +static int Test_Dims ( ParseData *, int Node1, int Node2 ); +static void Copy_Dims ( ParseData *, int Node1, int Node2 ); + +static void Allocate_Ptrs( ParseData *, Node *this ); +static void Do_Unary ( ParseData *, Node *this ); +static void Do_Offset ( ParseData *, Node *this ); +static void Do_BinOp_bit ( ParseData *, Node *this ); +static void Do_BinOp_str ( ParseData *, Node *this ); +static void Do_BinOp_log ( ParseData *, Node *this ); +static void Do_BinOp_lng ( ParseData *, Node *this ); +static void Do_BinOp_dbl ( ParseData *, Node *this ); +static void Do_Func ( ParseData *, Node *this ); +static void Do_Deref ( ParseData *, Node *this ); +static void Do_GTI ( ParseData *, Node *this ); +static void Do_GTI_Over ( ParseData *, Node *this ); +static void Do_REG ( ParseData *, Node *this ); +static void Do_Vector ( ParseData *, Node *this ); +static void Do_Array ( ParseData *, Node *this ); + +static long Search_GTI ( double evtTime, long nGTI, double *start, + double *stop, int ordered, long *nextGTI ); +static double GTI_Over(double evtStart, double evtStop, + long nGTI, double *start, double *stop, + long *gtiout); + +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(ParseData *lParse, char *dest_str, int dest_len, + char *src_str, int src_len, int pos); + +static void yyerror(yyscan_t scanner, ParseData *lParse, char *s); + +#ifdef __cplusplus + } +#endif + + +#line 273 "eval_y.c" + +# ifndef YY_CAST +# ifdef __cplusplus +# define YY_CAST(Type, Val) static_cast (Val) +# define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast (Val) +# else +# define YY_CAST(Type, Val) ((Type) (Val)) +# define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val)) +# endif +# endif +# ifndef YY_NULLPTR +# if defined __cplusplus +# if 201103L <= __cplusplus +# define YY_NULLPTR nullptr +# else +# define YY_NULLPTR 0 +# endif +# else +# define YY_NULLPTR ((void*)0) +# endif +# endif + +#include "eval_tab.h" +/* Symbol kind. */ +enum yysymbol_kind_t +{ + YYSYMBOL_YYEMPTY = -2, + YYSYMBOL_YYEOF = 0, /* "end of file" */ + YYSYMBOL_YYerror = 1, /* error */ + YYSYMBOL_YYUNDEF = 2, /* "invalid token" */ + YYSYMBOL_BOOLEAN = 3, /* BOOLEAN */ + YYSYMBOL_LONG = 4, /* LONG */ + YYSYMBOL_DOUBLE = 5, /* DOUBLE */ + YYSYMBOL_STRING = 6, /* STRING */ + YYSYMBOL_BITSTR = 7, /* BITSTR */ + YYSYMBOL_FUNCTION = 8, /* FUNCTION */ + YYSYMBOL_BFUNCTION = 9, /* BFUNCTION */ + YYSYMBOL_IFUNCTION = 10, /* IFUNCTION */ + YYSYMBOL_GTIFILTER = 11, /* GTIFILTER */ + YYSYMBOL_GTIOVERLAP = 12, /* GTIOVERLAP */ + YYSYMBOL_GTIFIND = 13, /* GTIFIND */ + YYSYMBOL_REGFILTER = 14, /* REGFILTER */ + YYSYMBOL_COLUMN = 15, /* COLUMN */ + YYSYMBOL_BCOLUMN = 16, /* BCOLUMN */ + YYSYMBOL_SCOLUMN = 17, /* SCOLUMN */ + YYSYMBOL_BITCOL = 18, /* BITCOL */ + YYSYMBOL_ROWREF = 19, /* ROWREF */ + YYSYMBOL_NULLREF = 20, /* NULLREF */ + YYSYMBOL_SNULLREF = 21, /* SNULLREF */ + YYSYMBOL_22_ = 22, /* ',' */ + YYSYMBOL_23_ = 23, /* '=' */ + YYSYMBOL_24_ = 24, /* ':' */ + YYSYMBOL_25_ = 25, /* '{' */ + YYSYMBOL_26_ = 26, /* '}' */ + YYSYMBOL_27_ = 27, /* '?' */ + YYSYMBOL_OR = 28, /* OR */ + YYSYMBOL_AND = 29, /* AND */ + YYSYMBOL_EQ = 30, /* EQ */ + YYSYMBOL_NE = 31, /* NE */ + YYSYMBOL_32_ = 32, /* '~' */ + YYSYMBOL_GT = 33, /* GT */ + YYSYMBOL_LT = 34, /* LT */ + YYSYMBOL_LTE = 35, /* LTE */ + YYSYMBOL_GTE = 36, /* GTE */ + YYSYMBOL_37_ = 37, /* '+' */ + YYSYMBOL_38_ = 38, /* '-' */ + YYSYMBOL_39_ = 39, /* '%' */ + YYSYMBOL_40_ = 40, /* '*' */ + YYSYMBOL_41_ = 41, /* '/' */ + YYSYMBOL_42_ = 42, /* '|' */ + YYSYMBOL_43_ = 43, /* '&' */ + YYSYMBOL_XOR = 44, /* XOR */ + YYSYMBOL_POWER = 45, /* POWER */ + YYSYMBOL_NOT = 46, /* NOT */ + YYSYMBOL_INTCAST = 47, /* INTCAST */ + YYSYMBOL_FLTCAST = 48, /* FLTCAST */ + YYSYMBOL_UMINUS = 49, /* UMINUS */ + YYSYMBOL_50_ = 50, /* '[' */ + YYSYMBOL_ACCUM = 51, /* ACCUM */ + YYSYMBOL_DIFF = 52, /* DIFF */ + YYSYMBOL_53_n_ = 53, /* '\n' */ + YYSYMBOL_54_ = 54, /* ']' */ + YYSYMBOL_55_ = 55, /* '(' */ + YYSYMBOL_56_ = 56, /* ')' */ + YYSYMBOL_YYACCEPT = 57, /* $accept */ + YYSYMBOL_lines = 58, /* lines */ + YYSYMBOL_line = 59, /* line */ + YYSYMBOL_bvector = 60, /* bvector */ + YYSYMBOL_vector = 61, /* vector */ + YYSYMBOL_expr = 62, /* expr */ + YYSYMBOL_bexpr = 63, /* bexpr */ + YYSYMBOL_bits = 64, /* bits */ + YYSYMBOL_sexpr = 65 /* sexpr */ +}; +typedef enum yysymbol_kind_t yysymbol_kind_t; + + + + +#ifdef short +# undef short +#endif + +/* On compilers that do not define __PTRDIFF_MAX__ etc., make sure + and (if available) are included + so that the code can choose integer types of a good width. */ + +#ifndef __PTRDIFF_MAX__ +# include /* INFRINGES ON USER NAME SPACE */ +# if defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ +# include /* INFRINGES ON USER NAME SPACE */ +# define YY_STDINT_H +# endif +#endif + +/* Narrow types that promote to a signed type and that can represent a + signed or unsigned integer of at least N bits. In tables they can + save space and decrease cache pressure. Promoting to a signed type + helps avoid bugs in integer arithmetic. */ + +#ifdef __INT_LEAST8_MAX__ +typedef __INT_LEAST8_TYPE__ yytype_int8; +#elif defined YY_STDINT_H +typedef int_least8_t yytype_int8; +#else +typedef signed char yytype_int8; +#endif + +#ifdef __INT_LEAST16_MAX__ +typedef __INT_LEAST16_TYPE__ yytype_int16; +#elif defined YY_STDINT_H +typedef int_least16_t yytype_int16; +#else +typedef short yytype_int16; +#endif + +/* Work around bug in HP-UX 11.23, which defines these macros + incorrectly for preprocessor constants. This workaround can likely + be removed in 2023, as HPE has promised support for HP-UX 11.23 + (aka HP-UX 11i v2) only through the end of 2022; see Table 2 of + . */ +#ifdef __hpux +# undef UINT_LEAST8_MAX +# undef UINT_LEAST16_MAX +# define UINT_LEAST8_MAX 255 +# define UINT_LEAST16_MAX 65535 +#endif + +#if defined __UINT_LEAST8_MAX__ && __UINT_LEAST8_MAX__ <= __INT_MAX__ +typedef __UINT_LEAST8_TYPE__ yytype_uint8; +#elif (!defined __UINT_LEAST8_MAX__ && defined YY_STDINT_H \ + && UINT_LEAST8_MAX <= INT_MAX) +typedef uint_least8_t yytype_uint8; +#elif !defined __UINT_LEAST8_MAX__ && UCHAR_MAX <= INT_MAX +typedef unsigned char yytype_uint8; +#else +typedef short yytype_uint8; +#endif + +#if defined __UINT_LEAST16_MAX__ && __UINT_LEAST16_MAX__ <= __INT_MAX__ +typedef __UINT_LEAST16_TYPE__ yytype_uint16; +#elif (!defined __UINT_LEAST16_MAX__ && defined YY_STDINT_H \ + && UINT_LEAST16_MAX <= INT_MAX) +typedef uint_least16_t yytype_uint16; +#elif !defined __UINT_LEAST16_MAX__ && USHRT_MAX <= INT_MAX +typedef unsigned short yytype_uint16; +#else +typedef int yytype_uint16; +#endif + +#ifndef YYPTRDIFF_T +# if defined __PTRDIFF_TYPE__ && defined __PTRDIFF_MAX__ +# define YYPTRDIFF_T __PTRDIFF_TYPE__ +# define YYPTRDIFF_MAXIMUM __PTRDIFF_MAX__ +# elif defined PTRDIFF_MAX +# ifndef ptrdiff_t +# include /* INFRINGES ON USER NAME SPACE */ +# endif +# define YYPTRDIFF_T ptrdiff_t +# define YYPTRDIFF_MAXIMUM PTRDIFF_MAX +# else +# define YYPTRDIFF_T long +# define YYPTRDIFF_MAXIMUM LONG_MAX +# endif +#endif + +#ifndef YYSIZE_T +# ifdef __SIZE_TYPE__ +# define YYSIZE_T __SIZE_TYPE__ +# elif defined size_t +# define YYSIZE_T size_t +# elif defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ +# include /* INFRINGES ON USER NAME SPACE */ +# define YYSIZE_T size_t +# else +# define YYSIZE_T unsigned +# endif +#endif + +#define YYSIZE_MAXIMUM \ + YY_CAST (YYPTRDIFF_T, \ + (YYPTRDIFF_MAXIMUM < YY_CAST (YYSIZE_T, -1) \ + ? YYPTRDIFF_MAXIMUM \ + : YY_CAST (YYSIZE_T, -1))) + +#define YYSIZEOF(X) YY_CAST (YYPTRDIFF_T, sizeof (X)) + + +/* Stored state numbers (used for stacks). */ +typedef yytype_int16 yy_state_t; + +/* State numbers in computations. */ +typedef int yy_state_fast_t; + +#ifndef YY_ +# if defined YYENABLE_NLS && YYENABLE_NLS +# if ENABLE_NLS +# include /* INFRINGES ON USER NAME SPACE */ +# define YY_(Msgid) dgettext ("bison-runtime", Msgid) +# endif +# endif +# ifndef YY_ +# define YY_(Msgid) Msgid +# endif +#endif + + +#ifndef YY_ATTRIBUTE_PURE +# if defined __GNUC__ && 2 < __GNUC__ + (96 <= __GNUC_MINOR__) +# define YY_ATTRIBUTE_PURE __attribute__ ((__pure__)) +# else +# define YY_ATTRIBUTE_PURE +# endif +#endif + +#ifndef YY_ATTRIBUTE_UNUSED +# if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__) +# define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) +# else +# define YY_ATTRIBUTE_UNUSED +# endif +#endif + +/* Suppress unused-variable warnings by "using" E. */ +#if ! defined lint || defined __GNUC__ +# define YY_USE(E) ((void) (E)) +#else +# define YY_USE(E) /* empty */ +#endif + +/* Suppress an incorrect diagnostic about yylval being uninitialized. */ +#if defined __GNUC__ && ! defined __ICC && 406 <= __GNUC__ * 100 + __GNUC_MINOR__ +# if __GNUC__ * 100 + __GNUC_MINOR__ < 407 +# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ + _Pragma ("GCC diagnostic push") \ + _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") +# else +# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ + _Pragma ("GCC diagnostic push") \ + _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") \ + _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") +# endif +# define YY_IGNORE_MAYBE_UNINITIALIZED_END \ + _Pragma ("GCC diagnostic pop") +#else +# define YY_INITIAL_VALUE(Value) Value +#endif +#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_END +#endif +#ifndef YY_INITIAL_VALUE +# define YY_INITIAL_VALUE(Value) /* Nothing. */ +#endif + +#if defined __cplusplus && defined __GNUC__ && ! defined __ICC && 6 <= __GNUC__ +# define YY_IGNORE_USELESS_CAST_BEGIN \ + _Pragma ("GCC diagnostic push") \ + _Pragma ("GCC diagnostic ignored \"-Wuseless-cast\"") +# define YY_IGNORE_USELESS_CAST_END \ + _Pragma ("GCC diagnostic pop") +#endif +#ifndef YY_IGNORE_USELESS_CAST_BEGIN +# define YY_IGNORE_USELESS_CAST_BEGIN +# define YY_IGNORE_USELESS_CAST_END +#endif + + +#define YY_ASSERT(E) ((void) (0 && (E))) + +#if !defined yyoverflow + +/* The parser invokes alloca or malloc; define the necessary symbols. */ + +# ifdef YYSTACK_USE_ALLOCA +# if YYSTACK_USE_ALLOCA +# ifdef __GNUC__ +# define YYSTACK_ALLOC __builtin_alloca +# elif defined __BUILTIN_VA_ARG_INCR +# include /* INFRINGES ON USER NAME SPACE */ +# elif defined _AIX +# define YYSTACK_ALLOC __alloca +# elif defined _MSC_VER +# include /* INFRINGES ON USER NAME SPACE */ +# define alloca _alloca +# else +# define YYSTACK_ALLOC alloca +# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS +# include /* INFRINGES ON USER NAME SPACE */ + /* Use EXIT_SUCCESS as a witness for stdlib.h. */ +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +# endif +# endif +# endif +# endif +# endif + +# ifdef YYSTACK_ALLOC + /* Pacify GCC's 'empty if-body' warning. */ +# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) +# ifndef YYSTACK_ALLOC_MAXIMUM + /* The OS might guarantee only one guard page at the bottom of the stack, + and a page size can be as small as 4096 bytes. So we cannot safely + invoke alloca (N) if N exceeds 4096. Use a slightly smaller number + to allow for a few compiler-allocated temporary stack slots. */ +# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ +# endif +# else +# define YYSTACK_ALLOC YYMALLOC +# define YYSTACK_FREE YYFREE +# ifndef YYSTACK_ALLOC_MAXIMUM +# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM +# endif +# if (defined __cplusplus && ! defined EXIT_SUCCESS \ + && ! ((defined YYMALLOC || defined malloc) \ + && (defined YYFREE || defined free))) +# include /* INFRINGES ON USER NAME SPACE */ +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +# endif +# endif +# ifndef YYMALLOC +# define YYMALLOC malloc +# if ! defined malloc && ! defined EXIT_SUCCESS +void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# ifndef YYFREE +# define YYFREE free +# if ! defined free && ! defined EXIT_SUCCESS +void free (void *); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# endif +#endif /* !defined yyoverflow */ + +#if (! defined yyoverflow \ + && (! defined __cplusplus \ + || (defined FITS_PARSER_YYSTYPE_IS_TRIVIAL && FITS_PARSER_YYSTYPE_IS_TRIVIAL))) + +/* A type that is properly aligned for any stack member. */ +union yyalloc +{ + yy_state_t yyss_alloc; + YYSTYPE yyvs_alloc; +}; + +/* The size of the maximum gap between one aligned stack and the next. */ +# define YYSTACK_GAP_MAXIMUM (YYSIZEOF (union yyalloc) - 1) + +/* The size of an array large to enough to hold all stacks, each with + N elements. */ +# define YYSTACK_BYTES(N) \ + ((N) * (YYSIZEOF (yy_state_t) + YYSIZEOF (YYSTYPE)) \ + + YYSTACK_GAP_MAXIMUM) + +# define YYCOPY_NEEDED 1 + +/* Relocate STACK from its old location to the new one. The + local variables YYSIZE and YYSTACKSIZE give the old and new number of + elements in the stack, and YYPTR gives the new location of the + stack. Advance YYPTR to a properly aligned location for the next + stack. */ +# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ + do \ + { \ + YYPTRDIFF_T yynewbytes; \ + YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ + Stack = &yyptr->Stack_alloc; \ + yynewbytes = yystacksize * YYSIZEOF (*Stack) + YYSTACK_GAP_MAXIMUM; \ + yyptr += yynewbytes / YYSIZEOF (*yyptr); \ + } \ + while (0) + +#endif + +#if defined YYCOPY_NEEDED && YYCOPY_NEEDED +/* Copy COUNT objects from SRC to DST. The source and destination do + not overlap. */ +# ifndef YYCOPY +# if defined __GNUC__ && 1 < __GNUC__ +# define YYCOPY(Dst, Src, Count) \ + __builtin_memcpy (Dst, Src, YY_CAST (YYSIZE_T, (Count)) * sizeof (*(Src))) +# else +# define YYCOPY(Dst, Src, Count) \ + do \ + { \ + YYPTRDIFF_T yyi; \ + for (yyi = 0; yyi < (Count); yyi++) \ + (Dst)[yyi] = (Src)[yyi]; \ + } \ + while (0) +# endif +# endif +#endif /* !YYCOPY_NEEDED */ + +/* YYFINAL -- State number of the termination state. */ +#define YYFINAL 2 +/* YYLAST -- Last index in YYTABLE. */ +#define YYLAST 1776 + +/* YYNTOKENS -- Number of terminals. */ +#define YYNTOKENS 57 +/* YYNNTS -- Number of nonterminals. */ +#define YYNNTS 9 +/* YYNRULES -- Number of rules. */ +#define YYNRULES 135 +/* YYNSTATES -- Number of states. */ +#define YYNSTATES 322 + +/* YYMAXUTOK -- Last valid token kind. */ +#define YYMAXUTOK 292 + + +/* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM + as returned by yylex, with out-of-bounds checking. */ +#define YYTRANSLATE(YYX) \ + (0 <= (YYX) && (YYX) <= YYMAXUTOK \ + ? YY_CAST (yysymbol_kind_t, yytranslate[YYX]) \ + : YYSYMBOL_YYUNDEF) + +/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM + as returned by yylex. */ +static const yytype_int8 yytranslate[] = +{ + 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 53, 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, 39, 43, 2, + 55, 56, 40, 37, 22, 38, 2, 41, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 24, 2, + 2, 23, 2, 27, 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, 50, 2, 54, 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, 25, 42, 26, 32, 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, 20, 21, 28, 29, 30, + 31, 33, 34, 35, 36, 44, 45, 46, 47, 48, + 49, 51, 52 +}; + +#if FITS_PARSER_YYDEBUG +/* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ +static const yytype_int16 yyrline[] = +{ + 0, 266, 266, 267, 270, 271, 277, 283, 289, 295, + 298, 300, 313, 315, 328, 339, 353, 357, 361, 365, + 367, 376, 379, 382, 391, 393, 395, 397, 399, 401, + 404, 408, 410, 412, 414, 423, 425, 427, 430, 433, + 436, 439, 442, 451, 460, 469, 472, 474, 476, 478, + 482, 486, 505, 524, 543, 554, 568, 617, 629, 660, + 774, 782, 885, 909, 911, 913, 915, 917, 919, 921, + 923, 925, 929, 931, 933, 942, 945, 948, 951, 954, + 957, 960, 963, 966, 969, 972, 975, 978, 981, 984, + 987, 990, 993, 996, 999, 1001, 1003, 1005, 1008, 1015, + 1032, 1045, 1058, 1069, 1085, 1109, 1137, 1174, 1178, 1182, + 1185, 1190, 1193, 1198, 1202, 1206, 1209, 1214, 1218, 1221, + 1225, 1227, 1229, 1231, 1233, 1235, 1237, 1241, 1244, 1246, + 1255, 1257, 1259, 1268, 1287, 1306 +}; +#endif + +/** Accessing symbol of state STATE. */ +#define YY_ACCESSING_SYMBOL(State) YY_CAST (yysymbol_kind_t, yystos[State]) + +#if FITS_PARSER_YYDEBUG || 0 +/* The user-facing name of the symbol whose (internal) number is + YYSYMBOL. No bounds checking. */ +static const char *yysymbol_name (yysymbol_kind_t yysymbol) YY_ATTRIBUTE_UNUSED; + +/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. + First, the terminals, then, starting at YYNTOKENS, nonterminals. */ +static const char *const yytname[] = +{ + "\"end of file\"", "error", "\"invalid token\"", "BOOLEAN", "LONG", + "DOUBLE", "STRING", "BITSTR", "FUNCTION", "BFUNCTION", "IFUNCTION", + "GTIFILTER", "GTIOVERLAP", "GTIFIND", "REGFILTER", "COLUMN", "BCOLUMN", + "SCOLUMN", "BITCOL", "ROWREF", "NULLREF", "SNULLREF", "','", "'='", + "':'", "'{'", "'}'", "'?'", "OR", "AND", "EQ", "NE", "'~'", "GT", "LT", + "LTE", "GTE", "'+'", "'-'", "'%'", "'*'", "'/'", "'|'", "'&'", "XOR", + "POWER", "NOT", "INTCAST", "FLTCAST", "UMINUS", "'['", "ACCUM", "DIFF", + "'\\n'", "']'", "'('", "')'", "$accept", "lines", "line", "bvector", + "vector", "expr", "bexpr", "bits", "sexpr", YY_NULLPTR +}; + +static const char * +yysymbol_name (yysymbol_kind_t yysymbol) +{ + return yytname[yysymbol]; +} +#endif + +#define YYPACT_NINF (-41) + +#define yypact_value_is_default(Yyn) \ + ((Yyn) == YYPACT_NINF) + +#define YYTABLE_NINF (-1) + +#define yytable_value_is_error(Yyn) \ + 0 + +/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing + STATE-NUM. */ +static const yytype_int16 yypact[] = +{ + -41, 316, -41, -40, -41, -41, -41, -41, -41, 369, + 423, 423, -5, 15, -4, 27, 36, 38, 40, 41, + -41, -41, -41, 423, 423, 423, 423, 423, 423, -41, + 423, -41, -7, 10, 1226, 81, 1646, 83, -41, -41, + 450, 116, 309, 12, 479, 185, 152, 222, 1593, 1673, + 1675, -19, -41, 13, -18, -41, 6, 423, 423, 423, + 423, 1593, 1673, 1684, 17, 17, 19, 24, 17, 19, + 17, 19, 710, 1253, 1611, 365, 423, -41, 423, -41, + 423, 423, 423, 423, 423, 423, 423, 423, 423, 423, + 423, 423, 423, 423, 423, 423, 423, 423, -41, 423, + 423, 423, 423, 423, 423, 423, -41, -2, -2, -2, + -2, -2, -2, -2, -2, -2, 423, -41, 423, 423, + 423, 423, 423, 423, 423, -41, 423, -41, 423, -41, + -41, 423, -41, 423, -41, -41, -41, 423, 423, -41, + 423, 423, -41, 423, -41, 1455, 1478, 1501, 1524, -41, + -41, -41, -41, 1593, 1673, 1593, 1673, 1547, 1712, 1712, + 1712, 1726, 1726, 1726, 1726, 368, 368, 368, 28, 19, + 28, 5, 5, 5, 5, 851, 1570, 425, 260, 128, + -20, 14, 14, 28, 876, -2, -2, -25, -25, -25, + -25, -25, -25, -36, 24, 24, 901, 140, 140, 39, + 39, 39, 39, -41, 508, 738, 1258, 1288, 1629, 1312, + 1638, 537, 1336, 566, 1360, -41, -41, -41, -41, 423, + 423, -41, 423, 423, 423, 423, -41, 24, 189, 423, + -41, 423, -41, -41, -41, 423, -41, 423, -41, 93, + -41, 423, 94, -41, 423, 1694, 926, 1694, 1673, 1694, + 1673, 1684, 951, 976, 1384, 766, 595, 79, 624, 80, + 653, 423, -41, 423, -41, 423, -41, 423, -41, 423, + -41, 100, 101, -41, 117, 118, -41, 1001, 1026, 1051, + 794, 1408, 72, 111, 85, 99, 423, -41, 423, -41, + 423, -41, -41, 423, -41, 129, -41, -41, 1076, 1101, + 1126, 682, 104, 423, -41, 423, -41, 423, -41, 423, + -41, -41, 1151, 1176, 1201, 1432, -41, -41, -41, 423, + 822, -41 +}; + +/* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. + Performed when YYTABLE does not specify something else to do. Zero + means the default is an error. */ +static const yytype_uint8 yydefact[] = +{ + 2, 0, 1, 0, 72, 31, 32, 127, 18, 0, + 0, 0, 0, 0, 0, 0, 33, 73, 128, 19, + 35, 36, 130, 0, 0, 0, 0, 0, 0, 4, + 0, 3, 0, 0, 0, 0, 0, 0, 9, 54, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 107, 0, 0, 113, 0, 0, 0, 0, + 0, 12, 10, 0, 46, 47, 125, 29, 68, 69, + 70, 71, 0, 0, 0, 0, 0, 17, 0, 16, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, + 0, 0, 0, 0, 0, 0, 6, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 8, 0, 0, + 0, 0, 0, 0, 0, 7, 0, 59, 0, 55, + 58, 0, 57, 0, 100, 101, 102, 0, 0, 108, + 0, 0, 114, 0, 117, 0, 0, 0, 0, 48, + 126, 30, 131, 15, 11, 13, 14, 0, 86, 87, + 85, 81, 82, 84, 83, 38, 39, 37, 40, 49, + 41, 43, 42, 44, 45, 0, 0, 0, 0, 95, + 94, 96, 97, 50, 0, 0, 0, 75, 76, 79, + 77, 78, 80, 23, 22, 21, 0, 88, 89, 90, + 92, 93, 91, 132, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 34, 74, 129, 20, 0, + 0, 63, 0, 0, 0, 0, 120, 29, 0, 0, + 24, 0, 61, 56, 103, 0, 134, 0, 60, 0, + 109, 0, 0, 115, 0, 98, 0, 51, 53, 52, + 99, 133, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 64, 0, 121, 0, 25, 0, 135, 0, + 104, 0, 0, 111, 0, 0, 118, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 65, 0, 122, + 0, 26, 62, 0, 110, 0, 116, 119, 0, 0, + 0, 0, 0, 0, 66, 0, 123, 0, 27, 0, + 105, 112, 0, 0, 0, 0, 67, 124, 28, 0, + 0, 106 +}; + +/* YYPGOTO[NTERM-NUM]. */ +static const yytype_int16 yypgoto[] = +{ + -41, -41, -41, -41, -41, -1, 170, 96, 30 +}; + +/* YYDEFGOTO[NTERM-NUM]. */ +static const yytype_int8 yydefgoto[] = +{ + 0, 1, 31, 32, 33, 48, 49, 46, 63 +}; + +/* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If + positive, shift that token. If negative, reduce the rule whose + number is the opposite. If YYTABLE_NINF, syntax error. */ +static const yytype_int16 yytable[] = +{ + 34, 51, 54, 138, 141, 8, 114, 115, 40, 44, + 102, 103, 113, 38, 116, 76, 19, 114, 115, 77, + 104, 53, 61, 64, 65, 116, 68, 70, 143, 72, + 105, 37, 78, 56, 131, 140, 79, 139, 142, 43, + 47, 50, 118, 119, 185, 120, 121, 122, 123, 124, + 96, 52, 55, 186, 104, 97, 145, 146, 147, 148, + 75, 57, 144, 58, 105, 59, 60, 97, 132, 105, + 93, 94, 95, 96, 116, 153, 124, 155, 97, 157, + 158, 159, 160, 161, 162, 163, 164, 165, 166, 167, + 168, 170, 171, 172, 173, 174, 175, 36, 176, 257, + 259, 271, 274, 183, 184, 42, 282, 283, 99, 100, + 101, 102, 103, 118, 119, 196, 120, 121, 122, 123, + 124, 104, 67, 284, 285, 204, 74, 205, 294, 178, + 207, 105, 209, 295, 106, 302, 125, 211, 128, 212, + 213, 296, 214, 99, 100, 101, 102, 103, 197, 198, + 199, 200, 201, 202, 203, 297, 104, 101, 102, 103, + 311, 208, 0, 0, 0, 0, 105, 210, 104, 0, + 0, 35, 129, 120, 121, 122, 123, 124, 105, 41, + 45, 0, 107, 108, 0, 109, 110, 111, 112, 113, + 0, 0, 0, 62, 114, 115, 66, 69, 71, 0, + 73, 0, 116, 187, 188, 189, 190, 191, 192, 193, + 194, 195, 99, 100, 101, 102, 103, 0, 245, 246, + 0, 247, 249, 0, 252, 104, 113, 0, 253, 0, + 254, 114, 115, 0, 255, 105, 256, 0, 0, 116, + 258, 135, 0, 260, 0, 151, 154, 0, 156, 0, + 0, 0, 118, 119, 251, 120, 121, 122, 123, 124, + 277, 169, 278, 0, 279, 0, 280, 0, 281, 177, + 179, 180, 181, 182, 0, 0, 0, 0, 136, 0, + 0, 227, 228, 0, 224, 298, 0, 299, 0, 300, + 118, 119, 301, 120, 121, 122, 123, 124, 206, 0, + 0, 0, 312, 0, 313, 0, 314, 0, 315, 0, + 0, 0, 0, 0, 0, 0, 2, 3, 320, 4, + 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 0, 107, + 108, 23, 109, 110, 111, 112, 113, 0, 0, 0, + 0, 114, 115, 24, 25, 0, 0, 0, 0, 116, + 0, 0, 26, 27, 28, 130, 0, 0, 0, 29, + 0, 30, 4, 5, 6, 7, 8, 9, 10, 11, + 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, + 22, 0, 248, 250, 23, 118, 119, 0, 120, 121, + 122, 123, 124, 0, 0, 0, 24, 25, 91, 92, + 93, 94, 95, 96, 0, 26, 27, 28, 97, 0, + 0, 152, 0, 0, 30, 39, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, + 18, 19, 20, 21, 22, 0, 0, 0, 23, 223, + 0, 0, 99, 100, 101, 102, 103, 0, 0, 0, + 24, 25, 0, 0, 0, 104, 0, 0, 0, 26, + 27, 28, 126, 80, 0, 105, 0, 0, 30, 0, + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, 96, 0, 0, 0, 0, + 97, 133, 80, 0, 0, 0, 127, 0, 0, 81, + 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, 95, 96, 0, 0, 0, 0, 97, + 231, 80, 0, 0, 0, 134, 0, 0, 81, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 0, 97, 239, + 80, 0, 0, 0, 232, 0, 0, 81, 82, 83, + 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, 95, 96, 0, 0, 0, 0, 97, 242, 80, + 0, 0, 0, 240, 0, 0, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 0, 97, 269, 80, 0, + 0, 0, 243, 0, 0, 81, 82, 83, 84, 85, + 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, + 96, 0, 0, 0, 0, 97, 272, 80, 0, 0, + 0, 270, 0, 0, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 0, 0, 0, 0, 97, 275, 80, 0, 0, 0, + 273, 0, 0, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, 96, 0, + 0, 0, 0, 97, 309, 80, 0, 0, 0, 276, + 0, 0, 81, 82, 83, 84, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 0, 97, 80, 0, 0, 0, 0, 310, 0, + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, 96, 0, 0, 0, 0, + 97, 80, 0, 0, 0, 0, 149, 0, 81, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 0, 97, 80, + 0, 0, 0, 0, 233, 0, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 0, 97, 80, 0, 0, + 0, 0, 268, 0, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 0, 0, 0, 0, 97, 80, 0, 0, 0, 0, + 292, 0, 81, 82, 83, 84, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 0, 97, 220, 80, 0, 0, 0, 321, 0, + 0, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 0, 225, 80, + 0, 97, 0, 0, 0, 221, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 229, 80, 0, 97, 0, 0, 0, + 226, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 0, 261, 80, + 0, 97, 0, 0, 0, 230, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 263, 80, 0, 97, 0, 0, 0, + 262, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 0, 265, 80, + 0, 97, 0, 0, 0, 264, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 286, 80, 0, 97, 0, 0, 0, + 266, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 0, 288, 80, + 0, 97, 0, 0, 0, 287, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 290, 80, 0, 97, 0, 0, 0, + 289, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 0, 303, 80, + 0, 97, 0, 0, 0, 291, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 305, 80, 0, 97, 0, 0, 0, + 304, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 0, 307, 80, + 0, 97, 0, 0, 0, 306, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 0, 80, 0, 97, 0, 0, 0, + 308, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 0, 0, 80, + 0, 97, 0, 0, 0, 316, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 0, 80, 0, 97, 0, 0, 0, + 317, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 0, 0, 80, + 0, 97, 0, 0, 0, 318, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 0, 97, 0, 0, 98, + 99, 100, 101, 102, 103, 99, 100, 101, 102, 103, + 0, 0, 0, 104, 0, 0, 0, 0, 104, 0, + 0, 0, 0, 105, 0, 0, 0, 0, 105, 150, + 235, 80, 0, 0, 234, 0, 0, 0, 81, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 96, 237, 80, 0, 0, 97, 0, + 0, 0, 81, 82, 83, 84, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, 95, 96, 241, 80, + 0, 0, 97, 0, 0, 0, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 244, 80, 0, 0, 97, 0, 0, 0, + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, 96, 267, 80, 0, 0, + 97, 0, 0, 0, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 293, 80, 0, 0, 97, 0, 0, 0, 81, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 96, 319, 80, 0, 0, 97, 0, + 0, 0, 81, 82, 83, 84, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, 95, 96, 80, 0, + 0, 215, 97, 0, 0, 81, 82, 83, 84, 85, + 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, + 96, 80, 0, 0, 216, 97, 0, 0, 81, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 96, 80, 0, 0, 217, 97, 0, + 0, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 80, 0, 0, + 218, 97, 0, 0, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 80, 219, 0, 0, 97, 0, 0, 81, 82, 83, + 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, 95, 96, 80, 222, 0, 0, 97, 0, 0, + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, 96, 80, 0, 0, 0, + 97, 0, 0, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, 96, 0, + 0, 107, 108, 97, 109, 110, 111, 112, 113, 0, + 0, 0, 0, 114, 115, 0, 0, 0, 0, 118, + 119, 116, 120, 121, 122, 123, 124, 151, 118, 119, + 0, 120, 121, 122, 123, 124, 107, 108, 0, 109, + 110, 111, 112, 113, 0, 236, 0, 0, 114, 115, + 0, 0, 0, 0, 238, 0, 116, 137, 0, 117, + 99, 100, 101, 102, 103, 118, 119, 0, 120, 121, + 122, 123, 124, 104, 118, 119, 0, 120, 121, 122, + 123, 124, 0, 105, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 0, 0, 0, 0, 97, 84, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 0, 97, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 0, 97 +}; + +static const yytype_int16 yycheck[] = +{ + 1, 6, 6, 22, 22, 7, 42, 43, 9, 10, + 30, 31, 37, 53, 50, 22, 18, 42, 43, 26, + 40, 6, 23, 24, 25, 50, 27, 28, 22, 30, + 50, 1, 22, 6, 22, 22, 26, 56, 56, 9, + 10, 11, 30, 31, 46, 33, 34, 35, 36, 37, + 45, 56, 56, 55, 40, 50, 57, 58, 59, 60, + 30, 25, 56, 25, 50, 25, 25, 50, 56, 50, + 42, 43, 44, 45, 50, 76, 37, 78, 50, 80, + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, 96, 97, 1, 99, 6, + 6, 22, 22, 104, 105, 9, 6, 6, 27, 28, + 29, 30, 31, 30, 31, 116, 33, 34, 35, 36, + 37, 40, 26, 6, 6, 126, 30, 128, 56, 99, + 131, 50, 133, 22, 53, 6, 53, 138, 22, 140, + 141, 56, 143, 27, 28, 29, 30, 31, 118, 119, + 120, 121, 122, 123, 124, 56, 40, 29, 30, 31, + 56, 131, -1, -1, -1, -1, 50, 137, 40, -1, + -1, 1, 56, 33, 34, 35, 36, 37, 50, 9, + 10, -1, 30, 31, -1, 33, 34, 35, 36, 37, + -1, -1, -1, 23, 42, 43, 26, 27, 28, -1, + 30, -1, 50, 107, 108, 109, 110, 111, 112, 113, + 114, 115, 27, 28, 29, 30, 31, -1, 219, 220, + -1, 222, 223, -1, 225, 40, 37, -1, 229, -1, + 231, 42, 43, -1, 235, 50, 237, -1, -1, 50, + 241, 56, -1, 244, -1, 56, 76, -1, 78, -1, + -1, -1, 30, 31, 224, 33, 34, 35, 36, 37, + 261, 91, 263, -1, 265, -1, 267, -1, 269, 99, + 100, 101, 102, 103, -1, -1, -1, -1, 56, -1, + -1, 185, 186, -1, 24, 286, -1, 288, -1, 290, + 30, 31, 293, 33, 34, 35, 36, 37, 128, -1, + -1, -1, 303, -1, 305, -1, 307, -1, 309, -1, + -1, -1, -1, -1, -1, -1, 0, 1, 319, 3, + 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, + 14, 15, 16, 17, 18, 19, 20, 21, -1, 30, + 31, 25, 33, 34, 35, 36, 37, -1, -1, -1, + -1, 42, 43, 37, 38, -1, -1, -1, -1, 50, + -1, -1, 46, 47, 48, 56, -1, -1, -1, 53, + -1, 55, 3, 4, 5, 6, 7, 8, 9, 10, + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, + 21, -1, 222, 223, 25, 30, 31, -1, 33, 34, + 35, 36, 37, -1, -1, -1, 37, 38, 40, 41, + 42, 43, 44, 45, -1, 46, 47, 48, 50, -1, + -1, 56, -1, -1, 55, 56, 3, 4, 5, 6, + 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, + 17, 18, 19, 20, 21, -1, -1, -1, 25, 24, + -1, -1, 27, 28, 29, 30, 31, -1, -1, -1, + 37, 38, -1, -1, -1, 40, -1, -1, -1, 46, + 47, 48, 22, 23, -1, 50, -1, -1, 55, -1, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, -1, -1, -1, -1, + 50, 22, 23, -1, -1, -1, 56, -1, -1, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, 42, 43, 44, 45, -1, -1, -1, -1, 50, + 22, 23, -1, -1, -1, 56, -1, -1, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, -1, -1, -1, -1, 50, 22, + 23, -1, -1, -1, 56, -1, -1, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, -1, -1, -1, -1, 50, 22, 23, + -1, -1, -1, 56, -1, -1, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, -1, -1, -1, 50, 22, 23, -1, + -1, -1, 56, -1, -1, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, -1, -1, -1, -1, 50, 22, 23, -1, -1, + -1, 56, -1, -1, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + -1, -1, -1, -1, 50, 22, 23, -1, -1, -1, + 56, -1, -1, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, + -1, -1, -1, 50, 22, 23, -1, -1, -1, 56, + -1, -1, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, + -1, -1, 50, 23, -1, -1, -1, -1, 56, -1, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, -1, -1, -1, -1, + 50, 23, -1, -1, -1, -1, 56, -1, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, -1, -1, -1, -1, 50, 23, + -1, -1, -1, -1, 56, -1, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, -1, -1, -1, 50, 23, -1, -1, + -1, -1, 56, -1, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + -1, -1, -1, -1, 50, 23, -1, -1, -1, -1, + 56, -1, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, + -1, -1, 50, 22, 23, -1, -1, -1, 56, -1, + -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, 22, 23, + -1, 50, -1, -1, -1, 54, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, 22, 23, -1, 50, -1, -1, -1, + 54, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, 22, 23, + -1, 50, -1, -1, -1, 54, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, 22, 23, -1, 50, -1, -1, -1, + 54, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, 22, 23, + -1, 50, -1, -1, -1, 54, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, 22, 23, -1, 50, -1, -1, -1, + 54, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, 22, 23, + -1, 50, -1, -1, -1, 54, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, 22, 23, -1, 50, -1, -1, -1, + 54, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, 22, 23, + -1, 50, -1, -1, -1, 54, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, 22, 23, -1, 50, -1, -1, -1, + 54, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, 22, 23, + -1, 50, -1, -1, -1, 54, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, -1, 23, -1, 50, -1, -1, -1, + 54, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, -1, 23, + -1, 50, -1, -1, -1, 54, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, -1, 23, -1, 50, -1, -1, -1, + 54, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, -1, 23, + -1, 50, -1, -1, -1, 54, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, -1, -1, -1, 50, -1, -1, 53, + 27, 28, 29, 30, 31, 27, 28, 29, 30, 31, + -1, -1, -1, 40, -1, -1, -1, -1, 40, -1, + -1, -1, -1, 50, -1, -1, -1, -1, 50, 56, + 22, 23, -1, -1, 56, -1, -1, -1, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 22, 23, -1, -1, 50, -1, + -1, -1, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 22, 23, + -1, -1, 50, -1, -1, -1, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 22, 23, -1, -1, 50, -1, -1, -1, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 22, 23, -1, -1, + 50, -1, -1, -1, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 22, 23, -1, -1, 50, -1, -1, -1, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 22, 23, -1, -1, 50, -1, + -1, -1, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 23, -1, + -1, 26, 50, -1, -1, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 23, -1, -1, 26, 50, -1, -1, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 23, -1, -1, 26, 50, -1, + -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, 23, -1, -1, + 26, 50, -1, -1, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 23, 24, -1, -1, 50, -1, -1, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, 23, 24, -1, -1, 50, -1, -1, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 23, -1, -1, -1, + 50, -1, -1, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, + -1, 30, 31, 50, 33, 34, 35, 36, 37, -1, + -1, -1, -1, 42, 43, -1, -1, -1, -1, 30, + 31, 50, 33, 34, 35, 36, 37, 56, 30, 31, + -1, 33, 34, 35, 36, 37, 30, 31, -1, 33, + 34, 35, 36, 37, -1, 56, -1, -1, 42, 43, + -1, -1, -1, -1, 56, -1, 50, 22, -1, 53, + 27, 28, 29, 30, 31, 30, 31, -1, 33, 34, + 35, 36, 37, 40, 30, 31, -1, 33, 34, 35, + 36, 37, -1, 50, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + -1, -1, -1, -1, 50, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, + -1, -1, 50, 37, 38, 39, 40, 41, 42, 43, + 44, 45, -1, -1, -1, -1, 50 +}; + +/* YYSTOS[STATE-NUM] -- The symbol kind of the accessing symbol of + state STATE-NUM. */ +static const yytype_int8 yystos[] = +{ + 0, 58, 0, 1, 3, 4, 5, 6, 7, 8, + 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, + 19, 20, 21, 25, 37, 38, 46, 47, 48, 53, + 55, 59, 60, 61, 62, 63, 64, 65, 53, 56, + 62, 63, 64, 65, 62, 63, 64, 65, 62, 63, + 65, 6, 56, 6, 6, 56, 6, 25, 25, 25, + 25, 62, 63, 65, 62, 62, 63, 64, 62, 63, + 62, 63, 62, 63, 64, 65, 22, 26, 22, 26, + 23, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, 50, 53, 27, + 28, 29, 30, 31, 40, 50, 53, 30, 31, 33, + 34, 35, 36, 37, 42, 43, 50, 53, 30, 31, + 33, 34, 35, 36, 37, 53, 22, 56, 22, 56, + 56, 22, 56, 22, 56, 56, 56, 22, 22, 56, + 22, 22, 56, 22, 56, 62, 62, 62, 62, 56, + 56, 56, 56, 62, 63, 62, 63, 62, 62, 62, + 62, 62, 62, 62, 62, 62, 62, 62, 62, 63, + 62, 62, 62, 62, 62, 62, 62, 63, 65, 63, + 63, 63, 63, 62, 62, 46, 55, 64, 64, 64, + 64, 64, 64, 64, 64, 64, 62, 65, 65, 65, + 65, 65, 65, 65, 62, 62, 63, 62, 65, 62, + 65, 62, 62, 62, 62, 26, 26, 26, 26, 24, + 22, 54, 24, 24, 24, 22, 54, 64, 64, 22, + 54, 22, 56, 56, 56, 22, 56, 22, 56, 22, + 56, 22, 22, 56, 22, 62, 62, 62, 63, 62, + 63, 65, 62, 62, 62, 62, 62, 6, 62, 6, + 62, 22, 54, 22, 54, 22, 54, 22, 56, 22, + 56, 22, 22, 56, 22, 22, 56, 62, 62, 62, + 62, 62, 6, 6, 6, 6, 22, 54, 22, 54, + 22, 54, 56, 22, 56, 22, 56, 56, 62, 62, + 62, 62, 6, 22, 54, 22, 54, 22, 54, 22, + 56, 56, 62, 62, 62, 62, 54, 54, 54, 22, + 62, 56 +}; + +/* YYR1[RULE-NUM] -- Symbol kind of the left-hand side of rule RULE-NUM. */ +static const yytype_int8 yyr1[] = +{ + 0, 57, 58, 58, 59, 59, 59, 59, 59, 59, + 60, 60, 61, 61, 61, 61, 62, 63, 64, 64, + 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, + 64, 62, 62, 62, 62, 62, 62, 62, 62, 62, + 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, + 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, + 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, + 62, 62, 63, 63, 63, 63, 63, 63, 63, 63, + 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, + 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, + 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, + 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, + 63, 63, 63, 63, 63, 63, 63, 65, 65, 65, + 65, 65, 65, 65, 65, 65 +}; + +/* YYR2[RULE-NUM] -- Number of symbols on the right-hand side of rule RULE-NUM. */ +static const yytype_int8 yyr2[] = +{ + 0, 2, 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, 3, 3, 3, 2, 2, 3, 3, + 3, 5, 5, 5, 2, 3, 5, 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, 7, 11, 2, 3, 5, 9, 3, 7, 9, + 4, 6, 8, 10, 12, 2, 3, 1, 1, 4, + 1, 3, 3, 5, 5, 7 +}; + + +enum { YYENOMEM = -2 }; + +#define yyerrok (yyerrstatus = 0) +#define yyclearin (yychar = FITS_PARSER_YYEMPTY) + +#define YYACCEPT goto yyacceptlab +#define YYABORT goto yyabortlab +#define YYERROR goto yyerrorlab +#define YYNOMEM goto yyexhaustedlab + + +#define YYRECOVERING() (!!yyerrstatus) + +#define YYBACKUP(Token, Value) \ + do \ + if (yychar == FITS_PARSER_YYEMPTY) \ + { \ + yychar = (Token); \ + yylval = (Value); \ + YYPOPSTACK (yylen); \ + yystate = *yyssp; \ + goto yybackup; \ + } \ + else \ + { \ + yyerror (scanner, lParse, YY_("syntax error: cannot back up")); \ + YYERROR; \ + } \ + while (0) + +/* Backward compatibility with an undocumented macro. + Use FITS_PARSER_YYerror or FITS_PARSER_YYUNDEF. */ +#define YYERRCODE FITS_PARSER_YYUNDEF + + +/* Enable debugging if requested. */ +#if FITS_PARSER_YYDEBUG + +# ifndef YYFPRINTF +# include /* INFRINGES ON USER NAME SPACE */ +# define YYFPRINTF fprintf +# endif + +# define YYDPRINTF(Args) \ +do { \ + if (yydebug) \ + YYFPRINTF Args; \ +} while (0) + + + + +# define YY_SYMBOL_PRINT(Title, Kind, Value, Location) \ +do { \ + if (yydebug) \ + { \ + YYFPRINTF (stderr, "%s ", Title); \ + yy_symbol_print (stderr, \ + Kind, Value, scanner, lParse); \ + YYFPRINTF (stderr, "\n"); \ + } \ +} while (0) + + +/*-----------------------------------. +| Print this symbol's value on YYO. | +`-----------------------------------*/ + +static void +yy_symbol_value_print (FILE *yyo, + yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, yyscan_t scanner, ParseData *lParse) +{ + FILE *yyoutput = yyo; + YY_USE (yyoutput); + YY_USE (scanner); + YY_USE (lParse); + if (!yyvaluep) + return; + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + YY_USE (yykind); + YY_IGNORE_MAYBE_UNINITIALIZED_END +} + + +/*---------------------------. +| Print this symbol on YYO. | +`---------------------------*/ + +static void +yy_symbol_print (FILE *yyo, + yysymbol_kind_t yykind, YYSTYPE const * const yyvaluep, yyscan_t scanner, ParseData *lParse) +{ + YYFPRINTF (yyo, "%s %s (", + yykind < YYNTOKENS ? "token" : "nterm", yysymbol_name (yykind)); + + yy_symbol_value_print (yyo, yykind, yyvaluep, scanner, lParse); + YYFPRINTF (yyo, ")"); +} + +/*------------------------------------------------------------------. +| yy_stack_print -- Print the state stack from its BOTTOM up to its | +| TOP (included). | +`------------------------------------------------------------------*/ + +static void +yy_stack_print (yy_state_t *yybottom, yy_state_t *yytop) +{ + YYFPRINTF (stderr, "Stack now"); + for (; yybottom <= yytop; yybottom++) + { + int yybot = *yybottom; + YYFPRINTF (stderr, " %d", yybot); + } + YYFPRINTF (stderr, "\n"); +} + +# define YY_STACK_PRINT(Bottom, Top) \ +do { \ + if (yydebug) \ + yy_stack_print ((Bottom), (Top)); \ +} while (0) + + +/*------------------------------------------------. +| Report that the YYRULE is going to be reduced. | +`------------------------------------------------*/ + +static void +yy_reduce_print (yy_state_t *yyssp, YYSTYPE *yyvsp, + int yyrule, yyscan_t scanner, ParseData *lParse) +{ + int yylno = yyrline[yyrule]; + int yynrhs = yyr2[yyrule]; + int yyi; + YYFPRINTF (stderr, "Reducing stack by rule %d (line %d):\n", + yyrule - 1, yylno); + /* The symbols being reduced. */ + for (yyi = 0; yyi < yynrhs; yyi++) + { + YYFPRINTF (stderr, " $%d = ", yyi + 1); + yy_symbol_print (stderr, + YY_ACCESSING_SYMBOL (+yyssp[yyi + 1 - yynrhs]), + &yyvsp[(yyi + 1) - (yynrhs)], scanner, lParse); + YYFPRINTF (stderr, "\n"); + } +} + +# define YY_REDUCE_PRINT(Rule) \ +do { \ + if (yydebug) \ + yy_reduce_print (yyssp, yyvsp, Rule, scanner, lParse); \ +} while (0) + +/* Nonzero means print parse trace. It is left uninitialized so that + multiple parsers can coexist. */ +int yydebug; +#else /* !FITS_PARSER_YYDEBUG */ +# define YYDPRINTF(Args) ((void) 0) +# define YY_SYMBOL_PRINT(Title, Kind, Value, Location) +# define YY_STACK_PRINT(Bottom, Top) +# define YY_REDUCE_PRINT(Rule) +#endif /* !FITS_PARSER_YYDEBUG */ + + +/* YYINITDEPTH -- initial size of the parser's stacks. */ +#ifndef YYINITDEPTH +# define YYINITDEPTH 200 +#endif + +/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only + if the built-in stack extension method is used). + + Do not make this value too large; the results are undefined if + YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) + evaluated with infinite-precision integer arithmetic. */ + +#ifndef YYMAXDEPTH +# define YYMAXDEPTH 10000 +#endif + + + + + + +/*-----------------------------------------------. +| Release the memory associated to this symbol. | +`-----------------------------------------------*/ + +static void +yydestruct (const char *yymsg, + yysymbol_kind_t yykind, YYSTYPE *yyvaluep, yyscan_t scanner, ParseData *lParse) +{ + YY_USE (yyvaluep); + YY_USE (scanner); + YY_USE (lParse); + if (!yymsg) + yymsg = "Deleting"; + YY_SYMBOL_PRINT (yymsg, yykind, yyvaluep, yylocationp); + + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + YY_USE (yykind); + YY_IGNORE_MAYBE_UNINITIALIZED_END +} + + + + + + +/*----------. +| yyparse. | +`----------*/ + +int +yyparse (yyscan_t scanner, ParseData *lParse) +{ +/* Lookahead token kind. */ +int yychar; + + +/* The semantic value of the lookahead symbol. */ +/* Default value used for initialization, for pacifying older GCCs + or non-GCC compilers. */ +YY_INITIAL_VALUE (static YYSTYPE yyval_default;) +YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default); + + /* Number of syntax errors so far. */ + int yynerrs = 0; + + yy_state_fast_t yystate = 0; + /* Number of tokens to shift before error messages enabled. */ + int yyerrstatus = 0; + + /* Refer to the stacks through separate pointers, to allow yyoverflow + to reallocate them elsewhere. */ + + /* Their size. */ + YYPTRDIFF_T yystacksize = YYINITDEPTH; + + /* The state stack: array, bottom, top. */ + yy_state_t yyssa[YYINITDEPTH]; + yy_state_t *yyss = yyssa; + yy_state_t *yyssp = yyss; + + /* The semantic value stack: array, bottom, top. */ + YYSTYPE yyvsa[YYINITDEPTH]; + YYSTYPE *yyvs = yyvsa; + YYSTYPE *yyvsp = yyvs; + + int yyn; + /* The return value of yyparse. */ + int yyresult; + /* Lookahead symbol kind. */ + yysymbol_kind_t yytoken = YYSYMBOL_YYEMPTY; + /* The variables used to return semantic value and location from the + action routines. */ + YYSTYPE yyval; + + + +#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N)) + + /* The number of symbols on the RHS of the reduced rule. + Keep to zero when no symbol should be popped. */ + int yylen = 0; + + YYDPRINTF ((stderr, "Starting parse\n")); + + yychar = FITS_PARSER_YYEMPTY; /* Cause a token to be read. */ + + goto yysetstate; + + +/*------------------------------------------------------------. +| yynewstate -- push a new state, which is found in yystate. | +`------------------------------------------------------------*/ +yynewstate: + /* In all cases, when you get here, the value and location stacks + have just been pushed. So pushing a state here evens the stacks. */ + yyssp++; + + +/*--------------------------------------------------------------------. +| yysetstate -- set current state (the top of the stack) to yystate. | +`--------------------------------------------------------------------*/ +yysetstate: + YYDPRINTF ((stderr, "Entering state %d\n", yystate)); + YY_ASSERT (0 <= yystate && yystate < YYNSTATES); + YY_IGNORE_USELESS_CAST_BEGIN + *yyssp = YY_CAST (yy_state_t, yystate); + YY_IGNORE_USELESS_CAST_END + YY_STACK_PRINT (yyss, yyssp); + + if (yyss + yystacksize - 1 <= yyssp) +#if !defined yyoverflow && !defined YYSTACK_RELOCATE + YYNOMEM; +#else + { + /* Get the current used size of the three stacks, in elements. */ + YYPTRDIFF_T yysize = yyssp - yyss + 1; + +# if defined yyoverflow + { + /* Give user a chance to reallocate the stack. Use copies of + these so that the &'s don't force the real ones into + memory. */ + yy_state_t *yyss1 = yyss; + YYSTYPE *yyvs1 = yyvs; + + /* Each stack pointer address is followed by the size of the + data in use in that stack, in bytes. This used to be a + conditional around just the two extra args, but that might + be undefined if yyoverflow is a macro. */ + yyoverflow (YY_("memory exhausted"), + &yyss1, yysize * YYSIZEOF (*yyssp), + &yyvs1, yysize * YYSIZEOF (*yyvsp), + &yystacksize); + yyss = yyss1; + yyvs = yyvs1; + } +# else /* defined YYSTACK_RELOCATE */ + /* Extend the stack our own way. */ + if (YYMAXDEPTH <= yystacksize) + YYNOMEM; + yystacksize *= 2; + if (YYMAXDEPTH < yystacksize) + yystacksize = YYMAXDEPTH; + + { + yy_state_t *yyss1 = yyss; + union yyalloc *yyptr = + YY_CAST (union yyalloc *, + YYSTACK_ALLOC (YY_CAST (YYSIZE_T, YYSTACK_BYTES (yystacksize)))); + if (! yyptr) + YYNOMEM; + YYSTACK_RELOCATE (yyss_alloc, yyss); + YYSTACK_RELOCATE (yyvs_alloc, yyvs); +# undef YYSTACK_RELOCATE + if (yyss1 != yyssa) + YYSTACK_FREE (yyss1); + } +# endif + + yyssp = yyss + yysize - 1; + yyvsp = yyvs + yysize - 1; + + YY_IGNORE_USELESS_CAST_BEGIN + YYDPRINTF ((stderr, "Stack size increased to %ld\n", + YY_CAST (long, yystacksize))); + YY_IGNORE_USELESS_CAST_END + + if (yyss + yystacksize - 1 <= yyssp) + YYABORT; + } +#endif /* !defined yyoverflow && !defined YYSTACK_RELOCATE */ + + + if (yystate == YYFINAL) + YYACCEPT; + + goto yybackup; + + +/*-----------. +| yybackup. | +`-----------*/ +yybackup: + /* Do appropriate processing given the current state. Read a + lookahead token if we need one and don't already have one. */ + + /* First try to decide what to do without reference to lookahead token. */ + yyn = yypact[yystate]; + if (yypact_value_is_default (yyn)) + goto yydefault; + + /* Not known => get a lookahead token if don't already have one. */ + + /* YYCHAR is either empty, or end-of-input, or a valid lookahead. */ + if (yychar == FITS_PARSER_YYEMPTY) + { + YYDPRINTF ((stderr, "Reading a token\n")); + yychar = yylex (&yylval, scanner); + } + + if (yychar <= FITS_PARSER_YYEOF) + { + yychar = FITS_PARSER_YYEOF; + yytoken = YYSYMBOL_YYEOF; + YYDPRINTF ((stderr, "Now at end of input.\n")); + } + else if (yychar == FITS_PARSER_YYerror) + { + /* The scanner already issued an error message, process directly + to error recovery. But do not keep the error token as + lookahead, it is too special and may lead us to an endless + loop in error recovery. */ + yychar = FITS_PARSER_YYUNDEF; + yytoken = YYSYMBOL_YYerror; + goto yyerrlab1; + } + else + { + yytoken = YYTRANSLATE (yychar); + YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); + } + + /* If the proper action on seeing token YYTOKEN is to reduce or to + detect an error, take that action. */ + yyn += yytoken; + if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) + goto yydefault; + yyn = yytable[yyn]; + if (yyn <= 0) + { + if (yytable_value_is_error (yyn)) + goto yyerrlab; + yyn = -yyn; + goto yyreduce; + } + + /* Count tokens shifted since error; after three, turn off error + status. */ + if (yyerrstatus) + yyerrstatus--; + + /* Shift the lookahead token. */ + YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); + yystate = yyn; + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END + + /* Discard the shifted token. */ + yychar = FITS_PARSER_YYEMPTY; + goto yynewstate; + + +/*-----------------------------------------------------------. +| yydefault -- do the default action for the current state. | +`-----------------------------------------------------------*/ +yydefault: + yyn = yydefact[yystate]; + if (yyn == 0) + goto yyerrlab; + goto yyreduce; + + +/*-----------------------------. +| yyreduce -- do a reduction. | +`-----------------------------*/ +yyreduce: + /* yyn is the number of a rule to reduce with. */ + yylen = yyr2[yyn]; + + /* If YYLEN is nonzero, implement the default value of the action: + '$$ = $1'. + + Otherwise, the following line sets YYVAL to garbage. + This behavior is undocumented and Bison + users should not rely upon it. Assigning to YYVAL + unconditionally makes the parser a bit smaller, and it avoids a + GCC warning that YYVAL may be used uninitialized. */ + yyval = yyvsp[1-yylen]; + + + YY_REDUCE_PRINT (yyn); + switch (yyn) + { + case 4: /* line: '\n' */ +#line 270 "eval.y" + {} +#line 1821 "eval_y.c" + break; + + case 5: /* line: expr '\n' */ +#line 272 "eval.y" + { if( (yyvsp[-1].Node)<0 ) { + yyerror(scanner, lParse, "Couldn't build node structure: out of memory?"); + YYERROR; } + lParse->resultNode = (yyvsp[-1].Node); + } +#line 1831 "eval_y.c" + break; + + case 6: /* line: bexpr '\n' */ +#line 278 "eval.y" + { if( (yyvsp[-1].Node)<0 ) { + yyerror(scanner, lParse, "Couldn't build node structure: out of memory?"); + YYERROR; } + lParse->resultNode = (yyvsp[-1].Node); + } +#line 1841 "eval_y.c" + break; + + case 7: /* line: sexpr '\n' */ +#line 284 "eval.y" + { if( (yyvsp[-1].Node)<0 ) { + yyerror(scanner, lParse, "Couldn't build node structure: out of memory?"); + YYERROR; } + lParse->resultNode = (yyvsp[-1].Node); + } +#line 1851 "eval_y.c" + break; + + case 8: /* line: bits '\n' */ +#line 290 "eval.y" + { if( (yyvsp[-1].Node)<0 ) { + yyerror(scanner, lParse, "Couldn't build node structure: out of memory?"); + YYERROR; } + lParse->resultNode = (yyvsp[-1].Node); + } +#line 1861 "eval_y.c" + break; + + case 9: /* line: error '\n' */ +#line 295 "eval.y" + { yyerrok; } +#line 1867 "eval_y.c" + break; + + case 10: /* bvector: '{' bexpr */ +#line 299 "eval.y" + { (yyval.Node) = New_Vector(lParse, (yyvsp[0].Node) ); TEST((yyval.Node)); } +#line 1873 "eval_y.c" + break; + + case 11: /* bvector: bvector ',' bexpr */ +#line 301 "eval.y" + { + if( lParse->Nodes[(yyvsp[-2].Node)].nSubNodes >= MAXSUBS ) { + (yyvsp[-2].Node) = Close_Vec(lParse, (yyvsp[-2].Node) ); TEST((yyvsp[-2].Node)); + (yyval.Node) = New_Vector(lParse, (yyvsp[-2].Node) ); TEST((yyval.Node)); + } else { + (yyval.Node) = (yyvsp[-2].Node); + } + lParse->Nodes[(yyval.Node)].SubNodes[ lParse->Nodes[(yyval.Node)].nSubNodes++ ] + = (yyvsp[0].Node); + } +#line 1888 "eval_y.c" + break; + + case 12: /* vector: '{' expr */ +#line 314 "eval.y" + { (yyval.Node) = New_Vector(lParse, (yyvsp[0].Node) ); TEST((yyval.Node)); } +#line 1894 "eval_y.c" + break; + + case 13: /* vector: vector ',' expr */ +#line 316 "eval.y" + { + if( TYPE((yyvsp[-2].Node)) < TYPE((yyvsp[0].Node)) ) + TYPE((yyvsp[-2].Node)) = TYPE((yyvsp[0].Node)); + if( lParse->Nodes[(yyvsp[-2].Node)].nSubNodes >= MAXSUBS ) { + (yyvsp[-2].Node) = Close_Vec(lParse, (yyvsp[-2].Node) ); TEST((yyvsp[-2].Node)); + (yyval.Node) = New_Vector(lParse, (yyvsp[-2].Node) ); TEST((yyval.Node)); + } else { + (yyval.Node) = (yyvsp[-2].Node); + } + lParse->Nodes[(yyval.Node)].SubNodes[ lParse->Nodes[(yyval.Node)].nSubNodes++ ] + = (yyvsp[0].Node); + } +#line 1911 "eval_y.c" + break; + + case 14: /* vector: vector ',' bexpr */ +#line 329 "eval.y" + { + if( lParse->Nodes[(yyvsp[-2].Node)].nSubNodes >= MAXSUBS ) { + (yyvsp[-2].Node) = Close_Vec(lParse, (yyvsp[-2].Node) ); TEST((yyvsp[-2].Node)); + (yyval.Node) = New_Vector(lParse, (yyvsp[-2].Node) ); TEST((yyval.Node)); + } else { + (yyval.Node) = (yyvsp[-2].Node); + } + lParse->Nodes[(yyval.Node)].SubNodes[ lParse->Nodes[(yyval.Node)].nSubNodes++ ] + = (yyvsp[0].Node); + } +#line 1926 "eval_y.c" + break; + + case 15: /* vector: bvector ',' expr */ +#line 340 "eval.y" + { + TYPE((yyvsp[-2].Node)) = TYPE((yyvsp[0].Node)); + if( lParse->Nodes[(yyvsp[-2].Node)].nSubNodes >= MAXSUBS ) { + (yyvsp[-2].Node) = Close_Vec(lParse, (yyvsp[-2].Node) ); TEST((yyvsp[-2].Node)); + (yyval.Node) = New_Vector(lParse, (yyvsp[-2].Node) ); TEST((yyval.Node)); + } else { + (yyval.Node) = (yyvsp[-2].Node); + } + lParse->Nodes[(yyval.Node)].SubNodes[ lParse->Nodes[(yyval.Node)].nSubNodes++ ] + = (yyvsp[0].Node); + } +#line 1942 "eval_y.c" + break; + + case 16: /* expr: vector '}' */ +#line 354 "eval.y" + { (yyval.Node) = Close_Vec(lParse, (yyvsp[-1].Node) ); TEST((yyval.Node)); } +#line 1948 "eval_y.c" + break; + + case 17: /* bexpr: bvector '}' */ +#line 358 "eval.y" + { (yyval.Node) = Close_Vec(lParse, (yyvsp[-1].Node) ); TEST((yyval.Node)); } +#line 1954 "eval_y.c" + break; + + case 18: /* bits: BITSTR */ +#line 362 "eval.y" + { + (yyval.Node) = New_Const(lParse, BITSTR, (yyvsp[0].str), strlen((yyvsp[0].str))+1 ); TEST((yyval.Node)); + SIZE((yyval.Node)) = strlen((yyvsp[0].str)); } +#line 1962 "eval_y.c" + break; + + case 19: /* bits: BITCOL */ +#line 366 "eval.y" + { (yyval.Node) = New_Column(lParse, (yyvsp[0].lng) ); TEST((yyval.Node)); } +#line 1968 "eval_y.c" + break; + + case 20: /* bits: BITCOL '{' expr '}' */ +#line 368 "eval.y" + { + if( TYPE((yyvsp[-1].Node)) != LONG + || OPER((yyvsp[-1].Node)) != CONST_OP ) { + yyerror(scanner, lParse, "Offset argument must be a constant integer"); + YYERROR; + } + (yyval.Node) = New_Offset(lParse, (yyvsp[-3].lng), (yyvsp[-1].Node) ); TEST((yyval.Node)); + } +#line 1981 "eval_y.c" + break; + + case 21: /* bits: bits '&' bits */ +#line 377 "eval.y" + { (yyval.Node) = New_BinOp(lParse, BITSTR, (yyvsp[-2].Node), '&', (yyvsp[0].Node) ); TEST((yyval.Node)); + SIZE((yyval.Node)) = ( SIZE((yyvsp[-2].Node))>SIZE((yyvsp[0].Node)) ? SIZE((yyvsp[-2].Node)) : SIZE((yyvsp[0].Node)) ); } +#line 1988 "eval_y.c" + break; + + case 22: /* bits: bits '|' bits */ +#line 380 "eval.y" + { (yyval.Node) = New_BinOp(lParse, BITSTR, (yyvsp[-2].Node), '|', (yyvsp[0].Node) ); TEST((yyval.Node)); + SIZE((yyval.Node)) = ( SIZE((yyvsp[-2].Node))>SIZE((yyvsp[0].Node)) ? SIZE((yyvsp[-2].Node)) : SIZE((yyvsp[0].Node)) ); } +#line 1995 "eval_y.c" + break; + + case 23: /* bits: bits '+' bits */ +#line 383 "eval.y" + { + if (SIZE((yyvsp[-2].Node))+SIZE((yyvsp[0].Node)) >= MAX_STRLEN) { + yyerror(scanner, lParse, "Combined bit string size exceeds " MAX_STRLEN_S " bits"); + YYERROR; + } + (yyval.Node) = New_BinOp(lParse, BITSTR, (yyvsp[-2].Node), '+', (yyvsp[0].Node) ); TEST((yyval.Node)); + SIZE((yyval.Node)) = SIZE((yyvsp[-2].Node)) + SIZE((yyvsp[0].Node)); + } +#line 2008 "eval_y.c" + break; + + case 24: /* bits: bits '[' expr ']' */ +#line 392 "eval.y" + { (yyval.Node) = New_Deref(lParse, (yyvsp[-3].Node), 1, (yyvsp[-1].Node), 0, 0, 0, 0 ); TEST((yyval.Node)); } +#line 2014 "eval_y.c" + break; + + case 25: /* bits: bits '[' expr ',' expr ']' */ +#line 394 "eval.y" + { (yyval.Node) = New_Deref(lParse, (yyvsp[-5].Node), 2, (yyvsp[-3].Node), (yyvsp[-1].Node), 0, 0, 0 ); TEST((yyval.Node)); } +#line 2020 "eval_y.c" + break; + + case 26: /* bits: bits '[' expr ',' expr ',' expr ']' */ +#line 396 "eval.y" + { (yyval.Node) = New_Deref(lParse, (yyvsp[-7].Node), 3, (yyvsp[-5].Node), (yyvsp[-3].Node), (yyvsp[-1].Node), 0, 0 ); TEST((yyval.Node)); } +#line 2026 "eval_y.c" + break; + + case 27: /* bits: bits '[' expr ',' expr ',' expr ',' expr ']' */ +#line 398 "eval.y" + { (yyval.Node) = New_Deref(lParse, (yyvsp[-9].Node), 4, (yyvsp[-7].Node), (yyvsp[-5].Node), (yyvsp[-3].Node), (yyvsp[-1].Node), 0 ); TEST((yyval.Node)); } +#line 2032 "eval_y.c" + break; + + case 28: /* bits: bits '[' expr ',' expr ',' expr ',' expr ',' expr ']' */ +#line 400 "eval.y" + { (yyval.Node) = New_Deref(lParse, (yyvsp[-11].Node), 5, (yyvsp[-9].Node), (yyvsp[-7].Node), (yyvsp[-5].Node), (yyvsp[-3].Node), (yyvsp[-1].Node) ); TEST((yyval.Node)); } +#line 2038 "eval_y.c" + break; + + case 29: /* bits: NOT bits */ +#line 402 "eval.y" + { (yyval.Node) = New_Unary(lParse, BITSTR, NOT, (yyvsp[0].Node) ); TEST((yyval.Node)); } +#line 2044 "eval_y.c" + break; + + case 30: /* bits: '(' bits ')' */ +#line 405 "eval.y" + { (yyval.Node) = (yyvsp[-1].Node); } +#line 2050 "eval_y.c" + break; + + case 31: /* expr: LONG */ +#line 409 "eval.y" + { (yyval.Node) = New_Const(lParse, LONG, &((yyvsp[0].lng)), sizeof(long) ); TEST((yyval.Node)); } +#line 2056 "eval_y.c" + break; + + case 32: /* expr: DOUBLE */ +#line 411 "eval.y" + { (yyval.Node) = New_Const(lParse, DOUBLE, &((yyvsp[0].dbl)), sizeof(double) ); TEST((yyval.Node)); } +#line 2062 "eval_y.c" + break; + + case 33: /* expr: COLUMN */ +#line 413 "eval.y" + { (yyval.Node) = New_Column(lParse, (yyvsp[0].lng) ); TEST((yyval.Node)); } +#line 2068 "eval_y.c" + break; + + case 34: /* expr: COLUMN '{' expr '}' */ +#line 415 "eval.y" + { + if( TYPE((yyvsp[-1].Node)) != LONG + || OPER((yyvsp[-1].Node)) != CONST_OP ) { + yyerror(scanner, lParse, "Offset argument must be a constant integer"); + YYERROR; + } + (yyval.Node) = New_Offset(lParse, (yyvsp[-3].lng), (yyvsp[-1].Node) ); TEST((yyval.Node)); + } +#line 2081 "eval_y.c" + break; + + case 35: /* expr: ROWREF */ +#line 424 "eval.y" + { (yyval.Node) = New_Func(lParse, LONG, row_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); } +#line 2087 "eval_y.c" + break; + + case 36: /* expr: NULLREF */ +#line 426 "eval.y" + { (yyval.Node) = New_Func(lParse, LONG, null_fct, 0, 0, 0, 0, 0, 0, 0, 0 ); } +#line 2093 "eval_y.c" + break; + + case 37: /* expr: expr '%' expr */ +#line 428 "eval.y" + { PROMOTE((yyvsp[-2].Node),(yyvsp[0].Node)); (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), '%', (yyvsp[0].Node) ); + TEST((yyval.Node)); } +#line 2100 "eval_y.c" + break; + + case 38: /* expr: expr '+' expr */ +#line 431 "eval.y" + { PROMOTE((yyvsp[-2].Node),(yyvsp[0].Node)); (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), '+', (yyvsp[0].Node) ); + TEST((yyval.Node)); } +#line 2107 "eval_y.c" + break; + + case 39: /* expr: expr '-' expr */ +#line 434 "eval.y" + { PROMOTE((yyvsp[-2].Node),(yyvsp[0].Node)); (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), '-', (yyvsp[0].Node) ); + TEST((yyval.Node)); } +#line 2114 "eval_y.c" + break; + + case 40: /* expr: expr '*' expr */ +#line 437 "eval.y" + { PROMOTE((yyvsp[-2].Node),(yyvsp[0].Node)); (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), '*', (yyvsp[0].Node) ); + TEST((yyval.Node)); } +#line 2121 "eval_y.c" + break; + + case 41: /* expr: expr '/' expr */ +#line 440 "eval.y" + { PROMOTE((yyvsp[-2].Node),(yyvsp[0].Node)); (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), '/', (yyvsp[0].Node) ); + TEST((yyval.Node)); } +#line 2128 "eval_y.c" + break; + + case 42: /* expr: expr '&' expr */ +#line 443 "eval.y" + { + if (TYPE((yyvsp[-2].Node)) != LONG || + TYPE((yyvsp[0].Node)) != LONG) { + yyerror(scanner, lParse, "Bitwise operations with incompatible types; only (bit OP bit) and (int OP int) are allowed"); + YYERROR; + } + (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), '&', (yyvsp[0].Node) ); + } +#line 2141 "eval_y.c" + break; + + case 43: /* expr: expr '|' expr */ +#line 452 "eval.y" + { + if (TYPE((yyvsp[-2].Node)) != LONG || + TYPE((yyvsp[0].Node)) != LONG) { + yyerror(scanner, lParse, "Bitwise operations with incompatible types; only (bit OP bit) and (int OP int) are allowed"); + YYERROR; + } + (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), '|', (yyvsp[0].Node) ); + } +#line 2154 "eval_y.c" + break; + + case 44: /* expr: expr XOR expr */ +#line 461 "eval.y" + { + if (TYPE((yyvsp[-2].Node)) != LONG || + TYPE((yyvsp[0].Node)) != LONG) { + yyerror(scanner, lParse, "Bitwise operations with incompatible types; only (bit OP bit) and (int OP int) are allowed"); + YYERROR; + } + (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), '^', (yyvsp[0].Node) ); + } +#line 2167 "eval_y.c" + break; + + case 45: /* expr: expr POWER expr */ +#line 470 "eval.y" + { PROMOTE((yyvsp[-2].Node),(yyvsp[0].Node)); (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), POWER, (yyvsp[0].Node) ); + TEST((yyval.Node)); } +#line 2174 "eval_y.c" + break; + + case 46: /* expr: '+' expr */ +#line 473 "eval.y" + { (yyval.Node) = (yyvsp[0].Node); } +#line 2180 "eval_y.c" + break; + + case 47: /* expr: '-' expr */ +#line 475 "eval.y" + { (yyval.Node) = New_Unary(lParse, TYPE((yyvsp[0].Node)), UMINUS, (yyvsp[0].Node) ); TEST((yyval.Node)); } +#line 2186 "eval_y.c" + break; + + case 48: /* expr: '(' expr ')' */ +#line 477 "eval.y" + { (yyval.Node) = (yyvsp[-1].Node); } +#line 2192 "eval_y.c" + break; + + case 49: /* expr: expr '*' bexpr */ +#line 479 "eval.y" + { (yyvsp[0].Node) = New_Unary(lParse, TYPE((yyvsp[-2].Node)), 0, (yyvsp[0].Node) ); + (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[-2].Node)), (yyvsp[-2].Node), '*', (yyvsp[0].Node) ); + TEST((yyval.Node)); } +#line 2200 "eval_y.c" + break; + + case 50: /* expr: bexpr '*' expr */ +#line 483 "eval.y" + { (yyvsp[-2].Node) = New_Unary(lParse, TYPE((yyvsp[0].Node)), 0, (yyvsp[-2].Node) ); + (yyval.Node) = New_BinOp(lParse, TYPE((yyvsp[0].Node)), (yyvsp[-2].Node), '*', (yyvsp[0].Node) ); + TEST((yyval.Node)); } +#line 2208 "eval_y.c" + break; + + case 51: /* expr: bexpr '?' expr ':' expr */ +#line 487 "eval.y" + { + PROMOTE((yyvsp[-2].Node),(yyvsp[0].Node)); + if( ! Test_Dims( lParse, (yyvsp[-2].Node),(yyvsp[0].Node)) ) { + yyerror(scanner, lParse, "Incompatible dimensions in '?:' arguments"); + YYERROR; + } + (yyval.Node) = New_Func(lParse, 0, ifthenelse_fct, 3, (yyvsp[-2].Node), (yyvsp[0].Node), (yyvsp[-4].Node), + 0, 0, 0, 0 ); + TEST((yyval.Node)); + if( SIZE((yyvsp[-2].Node))Nodes[(yyvsp[-1].Node)].value.data.lng); + naxis = lParse->Nodes[(yyvsp[-3].Node)].value.naxis; + + if (iaxis == 0) iaxis = naxis; /* NAXIS(V,0) = NAXIS */ + else if (iaxis <= naxis) iaxis = lParse->Nodes[(yyvsp[-3].Node)].value.naxes[iaxis-1]; /* NAXIS(V,n) = NAXISn */ + else iaxis = 1; /* Out of bounds use 1 */ + + (yyval.Node) = New_Const(lParse, LONG, &iaxis, sizeof(iaxis) ); + TEST((yyval.Node)); + } + } else if (FSTRCMP((yyvsp[-4].str),"ARRAY(") == 0) { /* NAXES(bexpr,n) */ + (yyval.Node) = New_Array(lParse, (yyvsp[-3].Node), (yyvsp[-1].Node)); + TEST((yyval.Node)); + } else { + yyerror(scanner, lParse, "Function(bool,expr) not supported"); + YYERROR; + } + TEST((yyval.Node)); + } +#line 2363 "eval_y.c" + break; + + case 57: /* expr: FUNCTION sexpr ')' */ +#line 618 "eval.y" + { if (FSTRCMP((yyvsp[-2].str),"NELEM(") == 0) { + (yyval.Node) = New_Const(lParse, LONG, &( SIZE((yyvsp[-1].Node)) ), sizeof(long) ); + } else if (FSTRCMP((yyvsp[-2].str),"NVALID(") == 0) { + (yyval.Node) = New_Func(lParse, LONG, nonnull_fct, 1, (yyvsp[-1].Node), + 0, 0, 0, 0, 0, 0 ); + } else { + yyerror(scanner, lParse, "Function(str) not supported"); + YYERROR; + } + TEST((yyval.Node)); + } +#line 2379 "eval_y.c" + break; + + case 58: /* expr: FUNCTION bits ')' */ +#line 630 "eval.y" + { if (FSTRCMP((yyvsp[-2].str),"NELEM(") == 0) { + (yyval.Node) = New_Const(lParse, LONG, &( SIZE((yyvsp[-1].Node)) ), sizeof(long) ); + } else if (FSTRCMP((yyvsp[-2].str),"NVALID(") == 0) { /* Bit arrays do not have NULL */ + (yyval.Node) = New_Const(lParse, LONG, &( SIZE((yyvsp[-1].Node)) ), sizeof(long) ); + } else if (FSTRCMP((yyvsp[-2].str),"SUM(") == 0) { + (yyval.Node) = New_Func(lParse, LONG, sum_fct, 1, (yyvsp[-1].Node), + 0, 0, 0, 0, 0, 0 ); + } else if (FSTRCMP((yyvsp[-2].str),"MIN(") == 0) { + (yyval.Node) = New_Func(lParse, TYPE((yyvsp[-1].Node)), /* Force 1D result */ + min1_fct, 1, (yyvsp[-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((yyval.Node)) = 1; + } else if (FSTRCMP((yyvsp[-2].str),"ACCUM(") == 0) { + long zero = 0; + (yyval.Node) = New_BinOp(lParse, LONG , (yyvsp[-1].Node), ACCUM, New_Const(lParse, LONG, &zero, sizeof(zero) )); + } else if (FSTRCMP((yyvsp[-2].str),"MAX(") == 0) { + (yyval.Node) = New_Func(lParse, TYPE((yyvsp[-1].Node)), /* Force 1D result */ + max1_fct, 1, (yyvsp[-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((yyval.Node)) = 1; + } else { + yyerror(scanner, lParse, "Function(bits) not supported"); + YYERROR; + } + TEST((yyval.Node)); + } +#line 2414 "eval_y.c" + break; + + case 59: /* expr: FUNCTION expr ')' */ +#line 661 "eval.y" + { if (FSTRCMP((yyvsp[-2].str),"SUM(") == 0) + (yyval.Node) = New_Func(lParse, TYPE((yyvsp[-1].Node)), sum_fct, 1, (yyvsp[-1].Node), + 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"AVERAGE(") == 0) + (yyval.Node) = New_Func(lParse, DOUBLE, average_fct, 1, (yyvsp[-1].Node), + 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"STDDEV(") == 0) + (yyval.Node) = New_Func(lParse, DOUBLE, stddev_fct, 1, (yyvsp[-1].Node), + 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"MEDIAN(") == 0) + (yyval.Node) = New_Func(lParse, TYPE((yyvsp[-1].Node)), median_fct, 1, (yyvsp[-1].Node), + 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"NELEM(") == 0) + (yyval.Node) = New_Const(lParse, LONG, &( SIZE((yyvsp[-1].Node)) ), sizeof(long) ); + else if (FSTRCMP((yyvsp[-2].str),"NVALID(") == 0) + (yyval.Node) = New_Func(lParse, LONG, nonnull_fct, 1, (yyvsp[-1].Node), + 0, 0, 0, 0, 0, 0 ); + else if ((FSTRCMP((yyvsp[-2].str),"ACCUM(") == 0) && (TYPE((yyvsp[-1].Node)) == LONG)) { + long zero = 0; + (yyval.Node) = New_BinOp(lParse, LONG , (yyvsp[-1].Node), ACCUM, New_Const(lParse, LONG, &zero, sizeof(zero) )); + } else if ((FSTRCMP((yyvsp[-2].str),"ACCUM(") == 0) && (TYPE((yyvsp[-1].Node)) == DOUBLE)) { + double zero = 0; + (yyval.Node) = New_BinOp(lParse, DOUBLE , (yyvsp[-1].Node), ACCUM, New_Const(lParse, DOUBLE, &zero, sizeof(zero) )); + } else if ((FSTRCMP((yyvsp[-2].str),"SEQDIFF(") == 0) && (TYPE((yyvsp[-1].Node)) == LONG)) { + long zero = 0; + (yyval.Node) = New_BinOp(lParse, LONG , (yyvsp[-1].Node), DIFF, New_Const(lParse, LONG, &zero, sizeof(zero) )); + } else if ((FSTRCMP((yyvsp[-2].str),"SEQDIFF(") == 0) && (TYPE((yyvsp[-1].Node)) == DOUBLE)) { + double zero = 0; + (yyval.Node) = New_BinOp(lParse, DOUBLE , (yyvsp[-1].Node), DIFF, New_Const(lParse, DOUBLE, &zero, sizeof(zero) )); + } else if (FSTRCMP((yyvsp[-2].str),"ABS(") == 0) + (yyval.Node) = New_Func(lParse, 0, abs_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"MIN(") == 0) + (yyval.Node) = New_Func(lParse, TYPE((yyvsp[-1].Node)), /* Force 1D result */ + min1_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"MAX(") == 0) + (yyval.Node) = New_Func(lParse, TYPE((yyvsp[-1].Node)), /* Force 1D result */ + max1_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"RANDOM(") == 0) { /* Vector RANDOM() */ + (yyval.Node) = New_Func(lParse, 0, rnd_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + TEST((yyval.Node)); + TYPE((yyval.Node)) = DOUBLE; + } else if (FSTRCMP((yyvsp[-2].str),"RANDOMN(") == 0) { + (yyval.Node) = New_Func(lParse, 0, gasrnd_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + TEST((yyval.Node)); + TYPE((yyval.Node)) = DOUBLE; + } else if (FSTRCMP((yyvsp[-2].str),"ELEMENTNUM(") == 0) { + if (OPER((yyvsp[-1].Node)) == CONST_OP) { + long one = 1; + (yyval.Node) = New_Const(lParse, LONG, &one, sizeof(one) ); + } else { + (yyval.Node) = New_Func(lParse, 0, elemnum_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + TEST((yyval.Node)); + TYPE((yyval.Node)) = LONG; + } + } else if (FSTRCMP((yyvsp[-2].str),"NAXIS(") == 0) { /* NAXIS(V) */ + if (OPER((yyvsp[-1].Node)) == CONST_OP) { /* if V is constant, return 1 in every case */ + long one = 1; + (yyval.Node) = New_Const(lParse, LONG, &one, sizeof(one) ); + } else { /* determine now the dimension of the expression */ + long naxis = lParse->Nodes[(yyvsp[-1].Node)].value.naxis; + + (yyval.Node) = New_Const(lParse, LONG, &naxis, sizeof(naxis) ); + TEST((yyval.Node)); + } + } + else { /* These all take DOUBLE arguments */ + if( TYPE((yyvsp[-1].Node)) != DOUBLE ) (yyvsp[-1].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-1].Node) ); + if (FSTRCMP((yyvsp[-2].str),"SIN(") == 0) + (yyval.Node) = New_Func(lParse, 0, sin_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"COS(") == 0) + (yyval.Node) = New_Func(lParse, 0, cos_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"TAN(") == 0) + (yyval.Node) = New_Func(lParse, 0, tan_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"ARCSIN(") == 0 + || FSTRCMP((yyvsp[-2].str),"ASIN(") == 0) + (yyval.Node) = New_Func(lParse, 0, asin_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"ARCCOS(") == 0 + || FSTRCMP((yyvsp[-2].str),"ACOS(") == 0) + (yyval.Node) = New_Func(lParse, 0, acos_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"ARCTAN(") == 0 + || FSTRCMP((yyvsp[-2].str),"ATAN(") == 0) + (yyval.Node) = New_Func(lParse, 0, atan_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"SINH(") == 0) + (yyval.Node) = New_Func(lParse, 0, sinh_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"COSH(") == 0) + (yyval.Node) = New_Func(lParse, 0, cosh_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"TANH(") == 0) + (yyval.Node) = New_Func(lParse, 0, tanh_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"EXP(") == 0) + (yyval.Node) = New_Func(lParse, 0, exp_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"LOG(") == 0) + (yyval.Node) = New_Func(lParse, 0, log_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"LOG10(") == 0) + (yyval.Node) = New_Func(lParse, 0, log10_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"SQRT(") == 0) + (yyval.Node) = New_Func(lParse, 0, sqrt_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"ROUND(") == 0) + (yyval.Node) = New_Func(lParse, 0, round_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"FLOOR(") == 0) + (yyval.Node) = New_Func(lParse, 0, floor_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"CEIL(") == 0) + (yyval.Node) = New_Func(lParse, 0, ceil_fct, 1, (yyvsp[-1].Node), 0, 0, 0, 0, 0, 0 ); + else if (FSTRCMP((yyvsp[-2].str),"RANDOMP(") == 0) { + (yyval.Node) = New_Func(lParse, 0, poirnd_fct, 1, (yyvsp[-1].Node), + 0, 0, 0, 0, 0, 0 ); + TYPE((yyval.Node)) = LONG; + } else { + yyerror(scanner, lParse, "Function(expr) not supported"); + YYERROR; + } + } + TEST((yyval.Node)); + } +#line 2532 "eval_y.c" + break; + + case 60: /* expr: IFUNCTION sexpr ',' sexpr ')' */ +#line 775 "eval.y" + { + if (FSTRCMP((yyvsp[-4].str),"STRSTR(") == 0) { + (yyval.Node) = New_Func(lParse, LONG, strpos_fct, 2, (yyvsp[-3].Node), (yyvsp[-1].Node), 0, + 0, 0, 0, 0 ); + TEST((yyval.Node)); + } + } +#line 2544 "eval_y.c" + break; + + case 61: /* expr: FUNCTION expr ',' expr ')' */ +#line 783 "eval.y" + { + if (FSTRCMP((yyvsp[-4].str),"DEFNULL(") == 0) { + if( SIZE((yyvsp[-3].Node))>=SIZE((yyvsp[-1].Node)) && Test_Dims( lParse, (yyvsp[-3].Node), (yyvsp[-1].Node) ) ) { + PROMOTE((yyvsp[-3].Node),(yyvsp[-1].Node)); + (yyval.Node) = New_Func(lParse, 0, defnull_fct, 2, (yyvsp[-3].Node), (yyvsp[-1].Node), 0, + 0, 0, 0, 0 ); + TEST((yyval.Node)); + } else { + yyerror(scanner, lParse, "Dimensions of DEFNULL arguments " + "are not compatible"); + YYERROR; + } + } else if (FSTRCMP((yyvsp[-4].str),"ARCTAN2(") == 0) { + if( TYPE((yyvsp[-3].Node)) != DOUBLE ) (yyvsp[-3].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-3].Node) ); + if( TYPE((yyvsp[-1].Node)) != DOUBLE ) (yyvsp[-1].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-1].Node) ); + if( Test_Dims( lParse, (yyvsp[-3].Node), (yyvsp[-1].Node) ) ) { + (yyval.Node) = New_Func(lParse, 0, atan2_fct, 2, (yyvsp[-3].Node), (yyvsp[-1].Node), 0, 0, 0, 0, 0 ); + TEST((yyval.Node)); + if( SIZE((yyvsp[-3].Node))Nodes[(yyvsp[-1].Node)].value.data.lng); + naxis = lParse->Nodes[(yyvsp[-3].Node)].value.naxis; + + if (iaxis == 0) iaxis = naxis; /* NAXIS(V,0) = NAXIS */ + else if (iaxis <= naxis) iaxis = lParse->Nodes[(yyvsp[-3].Node)].value.naxes[iaxis-1]; /* NAXIS(V,n) = NAXISn */ + else iaxis = 1; /* Out of bounds use 1 */ + + (yyval.Node) = New_Const(lParse, LONG, &iaxis, sizeof(iaxis) ); + TEST((yyval.Node)); + } + } else if (FSTRCMP((yyvsp[-4].str),"ARRAY(") == 0) { /* NAXES(expr,n) */ + (yyval.Node) = New_Array(lParse, (yyvsp[-3].Node), (yyvsp[-1].Node)); + TEST((yyval.Node)); + } else { + yyerror(scanner, lParse, "Function(expr,expr) not supported"); + YYERROR; + } + } +#line 2651 "eval_y.c" + break; + + case 62: /* expr: FUNCTION expr ',' expr ',' expr ',' expr ')' */ +#line 886 "eval.y" + { + if (FSTRCMP((yyvsp[-8].str),"ANGSEP(") == 0) { + if( TYPE((yyvsp[-7].Node)) != DOUBLE ) (yyvsp[-7].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-7].Node) ); + if( TYPE((yyvsp[-5].Node)) != DOUBLE ) (yyvsp[-5].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-5].Node) ); + if( TYPE((yyvsp[-3].Node)) != DOUBLE ) (yyvsp[-3].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-3].Node) ); + if( TYPE((yyvsp[-1].Node)) != DOUBLE ) (yyvsp[-1].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-1].Node) ); + if( Test_Dims( lParse, (yyvsp[-7].Node), (yyvsp[-5].Node) ) && Test_Dims( lParse, (yyvsp[-5].Node), (yyvsp[-3].Node) ) && + Test_Dims( lParse, (yyvsp[-3].Node), (yyvsp[-1].Node) ) ) { + (yyval.Node) = New_Func(lParse, 0, angsep_fct, 4, (yyvsp[-7].Node), (yyvsp[-5].Node), (yyvsp[-3].Node), (yyvsp[-1].Node),0,0,0 ); + TEST((yyval.Node)); + if( SIZE((yyvsp[-7].Node))=SIZE((yyvsp[-1].Node)) && Test_Dims( lParse, (yyvsp[-3].Node), (yyvsp[-1].Node) ) ) { + (yyval.Node) = New_Func(lParse, 0, defnull_fct, 2, (yyvsp[-3].Node), (yyvsp[-1].Node), 0, + 0, 0, 0, 0 ); + TEST((yyval.Node)); + } else { + yyerror(scanner, lParse, "Dimensions of DEFNULL arguments are not compatible"); + YYERROR; + } + } else { + yyerror(scanner, lParse, "Boolean Function(expr,expr) not supported"); + YYERROR; + } + } +#line 3014 "eval_y.c" + break; + + case 104: /* bexpr: BFUNCTION expr ',' expr ',' expr ')' */ +#line 1086 "eval.y" + { + if( TYPE((yyvsp[-5].Node)) != DOUBLE ) (yyvsp[-5].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-5].Node) ); + if( TYPE((yyvsp[-3].Node)) != DOUBLE ) (yyvsp[-3].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-3].Node) ); + if( TYPE((yyvsp[-1].Node)) != DOUBLE ) (yyvsp[-1].Node) = New_Unary(lParse, DOUBLE, 0, (yyvsp[-1].Node) ); + if( ! (Test_Dims( lParse, (yyvsp[-5].Node), (yyvsp[-3].Node) ) && Test_Dims( lParse, (yyvsp[-3].Node), (yyvsp[-1].Node) ) ) ) { + yyerror(scanner, lParse, "Dimensions of NEAR arguments " + "are not compatible"); + YYERROR; + } else { + if (FSTRCMP((yyvsp[-6].str),"NEAR(") == 0) { + (yyval.Node) = New_Func(lParse, BOOLEAN, near_fct, 3, (yyvsp[-5].Node), (yyvsp[-3].Node), (yyvsp[-1].Node), + 0, 0, 0, 0 ); + } else { + yyerror(scanner, lParse, "Boolean Function not supported"); + YYERROR; + } + TEST((yyval.Node)); + + if( SIZE((yyval.Node))= MAX_STRLEN) { + yyerror(scanner, lParse, "Combined string size exceeds " MAX_STRLEN_S " characters"); + YYERROR; + } + (yyval.Node) = New_BinOp(lParse, STRING, (yyvsp[-2].Node), '+', (yyvsp[0].Node) ); TEST((yyval.Node)); + SIZE((yyval.Node)) = SIZE((yyvsp[-2].Node)) + SIZE((yyvsp[0].Node)); + } +#line 3303 "eval_y.c" + break; + + case 133: /* sexpr: bexpr '?' sexpr ':' sexpr */ +#line 1269 "eval.y" + { + int outSize; + if( SIZE((yyvsp[-4].Node))!=1 ) { + yyerror(scanner, lParse, "Cannot have a vector string column"); + YYERROR; + } + /* 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((yyvsp[-2].Node)); + if (SIZE((yyvsp[0].Node)) > outSize) outSize = SIZE((yyvsp[0].Node)); + (yyval.Node) = New_FuncSize(lParse, 0, ifthenelse_fct, 3, (yyvsp[-2].Node), (yyvsp[0].Node), (yyvsp[-4].Node), + 0, 0, 0, 0, outSize); + + TEST((yyval.Node)); + if( SIZE((yyvsp[-2].Node)) outSize) outSize = SIZE((yyvsp[-1].Node)); + + (yyval.Node) = New_FuncSize(lParse, 0, defnull_fct, 2, (yyvsp[-3].Node), (yyvsp[-1].Node), 0, + 0, 0, 0, 0, outSize ); + TEST((yyval.Node)); + if( SIZE((yyvsp[-1].Node))>SIZE((yyvsp[-3].Node)) ) SIZE((yyval.Node)) = SIZE((yyvsp[-1].Node)); + } else { + yyerror(scanner, lParse, "Function(string,string) not supported"); + YYERROR; + } + } +#line 3348 "eval_y.c" + break; + + case 135: /* sexpr: FUNCTION sexpr ',' expr ',' expr ')' */ +#line 1307 "eval.y" + { + if (FSTRCMP((yyvsp[-6].str),"STRMID(") == 0) { + int len; + if( TYPE((yyvsp[-3].Node)) != LONG || SIZE((yyvsp[-3].Node)) != 1 || + TYPE((yyvsp[-1].Node)) != LONG || SIZE((yyvsp[-1].Node)) != 1) { + yyerror(scanner, lParse, "When using STRMID(S,P,N), P and N must be integers (and not vector columns)"); + YYERROR; + } + if (OPER((yyvsp[-1].Node)) == CONST_OP) { + /* Constant value: use that directly */ + len = (lParse->Nodes[(yyvsp[-1].Node)].value.data.lng); + } else { + /* Variable value: use the maximum possible (from $2) */ + len = SIZE((yyvsp[-5].Node)); + } + if (len <= 0 || len >= MAX_STRLEN) { + yyerror(scanner, lParse, "STRMID(S,P,N), N must be 1-" MAX_STRLEN_S); + YYERROR; + } + (yyval.Node) = New_FuncSize(lParse, 0, strmid_fct, 3, (yyvsp[-5].Node), (yyvsp[-3].Node),(yyvsp[-1].Node),0,0,0,0,len); + TEST((yyval.Node)); + } else { + yyerror(scanner, lParse, "Function(string,expr,expr) not supported"); + YYERROR; + } + } +#line 3379 "eval_y.c" + break; + + +#line 3383 "eval_y.c" + + default: break; + } + /* User semantic actions sometimes alter yychar, and that requires + that yytoken be updated with the new translation. We take the + approach of translating immediately before every use of yytoken. + One alternative is translating here after every semantic action, + but that translation would be missed if the semantic action invokes + YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or + if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an + incorrect destructor might then be invoked immediately. In the + case of YYERROR or YYBACKUP, subsequent parser actions might lead + to an incorrect destructor call or verbose syntax error message + before the lookahead is translated. */ + YY_SYMBOL_PRINT ("-> $$ =", YY_CAST (yysymbol_kind_t, yyr1[yyn]), &yyval, &yyloc); + + YYPOPSTACK (yylen); + yylen = 0; + + *++yyvsp = yyval; + + /* 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. */ + { + const int yylhs = yyr1[yyn] - YYNTOKENS; + const int yyi = yypgoto[yylhs] + *yyssp; + yystate = (0 <= yyi && yyi <= YYLAST && yycheck[yyi] == *yyssp + ? yytable[yyi] + : yydefgoto[yylhs]); + } + + goto yynewstate; + + +/*--------------------------------------. +| yyerrlab -- here on detecting error. | +`--------------------------------------*/ +yyerrlab: + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = yychar == FITS_PARSER_YYEMPTY ? YYSYMBOL_YYEMPTY : YYTRANSLATE (yychar); + /* If not already recovering from an error, report this error. */ + if (!yyerrstatus) + { + ++yynerrs; + yyerror (scanner, lParse, YY_("syntax error")); + } + + if (yyerrstatus == 3) + { + /* If just tried and failed to reuse lookahead token after an + error, discard it. */ + + if (yychar <= FITS_PARSER_YYEOF) + { + /* Return failure if at end of input. */ + if (yychar == FITS_PARSER_YYEOF) + YYABORT; + } + else + { + yydestruct ("Error: discarding", + yytoken, &yylval, scanner, lParse); + yychar = FITS_PARSER_YYEMPTY; + } + } + + /* Else will try to reuse lookahead token after shifting the error + token. */ + goto yyerrlab1; + + +/*---------------------------------------------------. +| yyerrorlab -- error raised explicitly by YYERROR. | +`---------------------------------------------------*/ +yyerrorlab: + /* Pacify compilers when the user code never invokes YYERROR and the + label yyerrorlab therefore never appears in user code. */ + if (0) + YYERROR; + ++yynerrs; + + /* Do not reclaim the symbols of the rule whose action triggered + this YYERROR. */ + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); + yystate = *yyssp; + goto yyerrlab1; + + +/*-------------------------------------------------------------. +| yyerrlab1 -- common code for both syntax error and YYERROR. | +`-------------------------------------------------------------*/ +yyerrlab1: + yyerrstatus = 3; /* Each real token shifted decrements this. */ + + /* Pop stack until we find a state that shifts the error token. */ + for (;;) + { + yyn = yypact[yystate]; + if (!yypact_value_is_default (yyn)) + { + yyn += YYSYMBOL_YYerror; + if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYSYMBOL_YYerror) + { + yyn = yytable[yyn]; + if (0 < yyn) + break; + } + } + + /* Pop the current state because it cannot handle the error token. */ + if (yyssp == yyss) + YYABORT; + + + yydestruct ("Error: popping", + YY_ACCESSING_SYMBOL (yystate), yyvsp, scanner, lParse); + YYPOPSTACK (1); + yystate = *yyssp; + YY_STACK_PRINT (yyss, yyssp); + } + + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END + + + /* Shift the error token. */ + YY_SYMBOL_PRINT ("Shifting", YY_ACCESSING_SYMBOL (yyn), yyvsp, yylsp); + + yystate = yyn; + goto yynewstate; + + +/*-------------------------------------. +| yyacceptlab -- YYACCEPT comes here. | +`-------------------------------------*/ +yyacceptlab: + yyresult = 0; + goto yyreturnlab; + + +/*-----------------------------------. +| yyabortlab -- YYABORT comes here. | +`-----------------------------------*/ +yyabortlab: + yyresult = 1; + goto yyreturnlab; + + +/*-----------------------------------------------------------. +| yyexhaustedlab -- YYNOMEM (memory exhaustion) comes here. | +`-----------------------------------------------------------*/ +yyexhaustedlab: + yyerror (scanner, lParse, YY_("memory exhausted")); + yyresult = 2; + goto yyreturnlab; + + +/*----------------------------------------------------------. +| yyreturnlab -- parsing is finished, clean up and return. | +`----------------------------------------------------------*/ +yyreturnlab: + if (yychar != FITS_PARSER_YYEMPTY) + { + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = YYTRANSLATE (yychar); + yydestruct ("Cleanup: discarding lookahead", + yytoken, &yylval, scanner, lParse); + } + /* Do not reclaim the symbols of the rule whose action triggered + this YYABORT or YYACCEPT. */ + YYPOPSTACK (yylen); + YY_STACK_PRINT (yyss, yyssp); + while (yyssp != yyss) + { + yydestruct ("Cleanup: popping", + YY_ACCESSING_SYMBOL (+*yyssp), yyvsp, scanner, lParse); + YYPOPSTACK (1); + } +#ifndef yyoverflow + if (yyss != yyssa) + YYSTACK_FREE (yyss); +#endif + + return yyresult; +} + +#line 1336 "eval.y" + + +/*************************************************************************/ +/* Start of "New" routines which build the expression Nodal structure */ +/*************************************************************************/ + +static int Alloc_Node( ParseData *lParse ) +{ + /* 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( lParse->nNodes == lParse->nNodesAlloc ) { + if( lParse->Nodes ) { + lParse->nNodesAlloc += lParse->nNodesAlloc; + newNodePtr = (Node *)realloc( lParse->Nodes, + sizeof(Node)*lParse->nNodesAlloc ); + } else { + lParse->nNodesAlloc = 100; + newNodePtr = (Node *)malloc ( sizeof(Node)*lParse->nNodesAlloc ); + } + + if( newNodePtr ) { + lParse->Nodes = newNodePtr; + } else { + lParse->status = MEMORY_ALLOCATION; + return( -1 ); + } + } + + return ( lParse->nNodes++ ); +} + +static void Free_Last_Node( ParseData *lParse ) +{ + if( lParse->nNodes ) lParse->nNodes--; +} + +static int New_Const( ParseData *lParse, int returnType, void *value, long len ) +{ + Node *this; + int n; + + n = Alloc_Node(lParse); + if( n>=0 ) { + this = lParse->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( ParseData *lParse, int ColNum ) +{ + Node *this; + int n, i; + + n = Alloc_Node(lParse); + if( n>=0 ) { + this = lParse->Nodes + n; + this->operation = -ColNum; + this->DoOp = NULL; + this->nSubNodes = 0; + this->type = lParse->varData[ColNum].type; + this->value.nelem = lParse->varData[ColNum].nelem; + this->value.naxis = lParse->varData[ColNum].naxis; + for( i=0; ivarData[ColNum].naxis; i++ ) + this->value.naxes[i] = lParse->varData[ColNum].naxes[i]; + } + return(n); +} + +static int New_Offset( ParseData *lParse, int ColNum, int offsetNode ) +{ + Node *this; + int n, i, colNode; + + colNode = New_Column( lParse, ColNum ); + if( colNode<0 ) return(-1); + + n = Alloc_Node(lParse); + if( n>=0 ) { + this = lParse->Nodes + n; + this->operation = '{'; + this->DoOp = Do_Offset; + this->nSubNodes = 2; + this->SubNodes[0] = colNode; + this->SubNodes[1] = offsetNode; + this->type = lParse->varData[ColNum].type; + this->value.nelem = lParse->varData[ColNum].nelem; + this->value.naxis = lParse->varData[ColNum].naxis; + for( i=0; ivarData[ColNum].naxis; i++ ) + this->value.naxes[i] = lParse->varData[ColNum].naxes[i]; + } + return(n); +} + +static int New_Unary( ParseData *lParse, int returnType, int Op, int Node1 ) +{ + Node *this, *that; + int i,n; + + if( Node1<0 ) return(-1); + that = lParse->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(lParse); + if( n>=0 ) { + this = lParse->Nodes + n; + this->operation = Op; + this->DoOp = Do_Unary; + this->nSubNodes = 1; + this->SubNodes[0] = Node1; + this->type = returnType; + + that = lParse->Nodes + Node1; /* Reset in case .Nodes mv'd */ + this->value.nelem = that->value.nelem; + this->value.naxis = that->value.naxis; + for( i=0; ivalue.naxis; i++ ) + this->value.naxes[i] = that->value.naxes[i]; + + if( that->operation==CONST_OP ) this->DoOp( lParse, this ); + } + return( n ); +} + +static int New_BinOp( ParseData *lParse, 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(lParse); + if( n>=0 ) { + this = lParse->Nodes + n; + this->operation = Op; + this->nSubNodes = 2; + this->SubNodes[0]= Node1; + this->SubNodes[1]= Node2; + this->type = returnType; + + that1 = lParse->Nodes + Node1; + that2 = lParse->Nodes + Node2; + constant = (that1->operation==CONST_OP + && that2->operation==CONST_OP); + if( that1->type!=STRING && that1->type!=BITSTR ) + if( !Test_Dims( lParse, Node1, Node2 ) ) { + Free_Last_Node(lParse); + yyerror(0, lParse, "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; ivalue.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( lParse, this ); + } + return( n ); +} + +static int New_Func( ParseData *lParse, + int returnType, funcOp Op, int nNodes, + int Node1, int Node2, int Node3, int Node4, + int Node5, int Node6, int Node7 ) +{ + return New_FuncSize(lParse, + returnType, Op, nNodes, + Node1, Node2, Node3, Node4, + Node5, Node6, Node7, 0); +} + +static int New_FuncSize( ParseData *lParse, + 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(lParse); + if( n>=0 ) { + this = lParse->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 = lParse->Nodes + Node1; + this->type = that->type; + this->value.nelem = that->value.nelem; + this->value.naxis = that->value.naxis; + for( i=0; ivalue.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( lParse, this ); + } + return( n ); +} + +static int New_Deref( ParseData *lParse, 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 = lParse->Nodes + Var; + if( theVar->operation==CONST_OP || theVar->value.nelem==1 ) { + yyerror(0, lParse, "Cannot index a scalar value"); + return(-1); + } + + n = Alloc_Node(lParse); + if( n>=0 ) { + this = lParse->Nodes + n; + this->nSubNodes = nDim+1; + theVar = lParse->Nodes + (this->SubNodes[0]=Var); + theDim[0] = lParse->Nodes + (this->SubNodes[1]=Dim1); + theDim[1] = lParse->Nodes + (this->SubNodes[2]=Dim2); + theDim[2] = lParse->Nodes + (this->SubNodes[3]=Dim3); + theDim[3] = lParse->Nodes + (this->SubNodes[4]=Dim4); + theDim[4] = lParse->Nodes + (this->SubNodes[5]=Dim5); + constant = theVar->operation==CONST_OP; + for( idx=0; idxoperation==CONST_OP); + + for( idx=0; idxvalue.nelem>1 ) { + Free_Last_Node(lParse); + yyerror(0, lParse, "Cannot use an array as an index value"); + return(-1); + } else if( theDim[idx]->type!=LONG ) { + Free_Last_Node(lParse); + yyerror(0, lParse, "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; idxvalue.naxis; idx++ ) { + elem *= ( this->value.naxes[idx] = theVar->value.naxes[idx] ); + } + this->value.nelem = elem; + } else { + Free_Last_Node(lParse); + yyerror(0, lParse, "Must specify just one or all indices for vector"); + return(-1); + } + if( constant ) this->DoOp( lParse, this ); + } + return(n); +} + +extern int fits_parser_yyGetVariable( ParseData *lParse, char *varName, YYSTYPE *varVal ); + +static int New_GTI( ParseData *lParse, funcOp Op, char *fname, int Node1, int Node2, char *start, char *stop ) +{ + fitsfile *fptr; + Node *this, *that0, *that1, *that2; + 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]; + YYSTYPE colVal; + + if( (Op == gtifilt_fct || Op == gtifind_fct) && Node1==-99 ) { + type = fits_parser_yyGetVariable( lParse, "TIME", &colVal ); + if( type==COLUMN ) { + Node1 = New_Column( lParse, (int)colVal.lng ); + } else { + yyerror(0, lParse, "Could not build TIME column for GTIFILTER/GTIFIND"); + return(-1); + } + } + + if (Op == gtiover_fct) { + if (Node1 == -99 || Node2 == -99) { + yyerror(0, lParse, "startExpr and stopExpr values must be defined for GTIOVERLAP"); + return(-1); + } + /* Also case TIME_STOP to double precision */ + Node2 = New_Unary( lParse, DOUBLE, 0, Node2 ); + if (Node2 < 0) return(-1); + + } + + /* Type cast TIME to double precision */ + Node1 = New_Unary( lParse, DOUBLE, 0, Node1 ); + Node0 = Alloc_Node(lParse); /* 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 = lParse->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, &lParse->status ); + if( *extname ) { + ffmnhd( fptr, movetotype, extname, extvers, &lParse->status ); + ffghdn( fptr, &hdunum ); + } else if( hdunum ) { + ffmahd( fptr, ++hdunum, &hdutype, &lParse->status ); + } else if( !lParse->status ) { + yyerror(0, lParse, "Cannot use primary array for GTI filter"); + return( -1 ); + } + } else { + yyerror(0, lParse, "File extension specifier lacks closing ']'"); + return( -1 ); + } + break; + case '+': + samefile = 1; + hdunum = atoi( fname ) + 1; + if( hdunum>1 ) + ffmahd( fptr, hdunum, &hdutype, &lParse->status ); + else { + yyerror(0, lParse, "Cannot use primary array for GTI filter / GTIFIND"); + return( -1 ); + } + break; + default: + samefile = 0; + if( ! ffopen( &fptr, fname, READONLY, &lParse->status ) ) + ffghdn( fptr, &hdunum ); + break; + } + if( lParse->status ) return(-1); + + /* If at primary, search for GTI extension */ + + if( hdunum==1 ) { + while( 1 ) { + hdunum++; + if( ffmahd( fptr, hdunum, &hdutype, &lParse->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( lParse->status ) { + if( lParse->status==END_OF_FILE ) + yyerror(0, lParse, "GTI extension not found in this file"); + return(-1); + } + } + + /* Locate START/STOP Columns */ + + ffgcno( fptr, CASEINSEN, start, &startCol, &lParse->status ); + ffgcno( fptr, CASEINSEN, stop, &stopCol, &lParse->status ); + if( lParse->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(lParse); + if( n >= 0 ) { + this = lParse->Nodes + n; + this->SubNodes[1] = Node1; + this->operation = (int) Op; + if (Op == gtifilt_fct) { + this->nSubNodes = 2; + this->DoOp = Do_GTI; + this->type = BOOLEAN; + } else if (Op == gtifind_fct) { + this->nSubNodes = 2; + this->DoOp = Do_GTI; + this->type = LONG; + } else { + this->nSubNodes = 3; + this->DoOp = Do_GTI_Over; + this->type = DOUBLE; + } + that1 = lParse->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]; + if (Op == gtiover_fct) { + this->SubNodes[2] = Node2; + that2 = lParse->Nodes + Node2; + if (that1->value.nelem != that2->value.nelem) { + yyerror(0, lParse, "Dimensions of TIME and TIME_STOP must match for GTIOVERLAP"); + return(-1); + } + } + + /* Init START/STOP node to be treated as a "constant" */ + + this->SubNodes[0] = Node0; + that0 = lParse->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, &lParse->status ) ) + return(-1); + that0->value.nelem = nrows; + if( nrows ) { + + that0->value.data.dblptr = (double*)malloc( 2*nrows*sizeof(double) ); + if( !that0->value.data.dblptr ) { + lParse->status = MEMORY_ALLOCATION; + return(-1); + } + + ffgcvd( fptr, startCol, 1L, 1L, nrows, 0.0, + that0->value.data.dblptr, &i, &lParse->status ); + ffgcvd( fptr, stopCol, 1L, 1L, nrows, 0.0, + that0->value.data.dblptr+nrows, &i, &lParse->status ); + if( lParse->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; + } + + /* GTIOVERLAP() requires ordered GTI */ + if (that0->type != 1 && Op == gtiover_fct) { + yyerror(0, lParse, "Input GTI must be time-ordered for GTIOVERLAP"); + return(-1); + } + + /* 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 (timeSpan == 0) timeSpan = 1.0; + + if( fabs( dt / timeSpan ) > 1e-12 ) { + for( i=0; i<(nrows+nrows); i++ ) + that0->value.data.dblptr[i] += dt; + } + } + /* If Node1 is constant (gtifilt_fct) or + Node1 and Node2 are constant (gtiover_fct), then evaluate now */ + if( OPER(Node1)==CONST_OP && (Op == gtifilt_fct || OPER(Node2)==CONST_OP)) { + this->DoOp( lParse, this ); + } + } + + if( samefile ) + ffmahd( fptr, evthdu, &hdutype, &lParse->status ); + else + ffclos( fptr, &lParse->status ); + + return( n ); +} + +static int New_REG( ParseData *lParse, 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; + YYSTYPE colVal; + + if( NodeX==-99 ) { + type = fits_parser_yyGetVariable( lParse, "X", &colVal ); + if( type==COLUMN ) { + NodeX = New_Column( lParse, (int)colVal.lng ); + } else { + yyerror(0, lParse, "Could not build X column for REGFILTER"); + return(-1); + } + } + if( NodeY==-99 ) { + type = fits_parser_yyGetVariable( lParse, "Y", &colVal ); + if( type==COLUMN ) { + NodeY = New_Column( lParse, (int)colVal.lng ); + } else { + yyerror(0, lParse, "Could not build Y column for REGFILTER"); + return(-1); + } + } + NodeX = New_Unary( lParse, DOUBLE, 0, NodeX ); + NodeY = New_Unary( lParse, DOUBLE, 0, NodeY ); + Node0 = Alloc_Node(lParse); /* This will hold the Region Data */ + if( NodeX<0 || NodeY<0 || Node0<0 ) return(-1); + + if( ! (Test_Dims( lParse, NodeX, NodeY ) ) ) { + yyerror(0, lParse, "Dimensions of REGFILTER arguments are not compatible"); + return (-1); + } + + n = Alloc_Node(lParse); + if( n >= 0 ) { + this = lParse->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(lParse, n, NodeX); + if( SIZE(NodeX)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 ) { + yyerror(0, lParse, "Could not extract valid pair of column names from REGFILTER"); + Free_Last_Node(lParse); + return( -1 ); + } + fits_get_colnum( lParse->def_fptr, CASEINSEN, cX, &Xcol, + &lParse->status ); + fits_get_colnum( lParse->def_fptr, CASEINSEN, cY, &Ycol, + &lParse->status ); + if( lParse->status ) { + yyerror(0, lParse, "Could not locate columns indicated for WCS info"); + Free_Last_Node(lParse); + return( -1 ); + } + + } else { + /* Try to find columns used in X/Y expressions */ + Xcol = Locate_Col( lParse, lParse->Nodes + NodeX ); + Ycol = Locate_Col( lParse, lParse->Nodes + NodeY ); + if( Xcol<0 || Ycol<0 ) { + yyerror(0, lParse, "Found multiple X/Y column references in REGFILTER"); + Free_Last_Node(lParse); + 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( lParse->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 ) { + lParse->status = tstat; + Free_Last_Node(lParse); + return( -1 ); + } else { + wcs.exists = 1; + } + } + + /* Read in Region file */ + + fits_read_rgnfile( fname, &wcs, &Rgn, &lParse->status ); + if( lParse->status ) { + Free_Last_Node(lParse); + return( -1 ); + } + + that0->value.data.ptr = Rgn; + + if( OPER(NodeX)==CONST_OP && OPER(NodeY)==CONST_OP ) + this->DoOp( lParse, this ); + } + + return( n ); +} + +static int New_Vector( ParseData *lParse, int subNode ) +{ + Node *this, *that; + int n; + + n = Alloc_Node(lParse); + if( n >= 0 ) { + this = lParse->Nodes + n; + that = lParse->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( ParseData *lParse, int vecNode ) +{ + Node *this; + int n, nelem=0; + + this = lParse->Nodes + vecNode; + for( n=0; n < this->nSubNodes; n++ ) { + if( TYPE( this->SubNodes[n] ) != this->type ) { + this->SubNodes[n] = New_Unary( lParse, 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 New_Array( ParseData *lParse, int valueNode, int dimNode ) +{ + Node *dims; + long naxis, nelem; + long naxes[MAXDIMS]; + Node *this; + int n,i; + + if( valueNode<0 || dimNode<0 ) return(-1); + + /* Check that dimensions are {a,b,c,d} + - vector + - every element is constant integer + - 5 or fewer dimensions + */ + + if (SIZE(valueNode) > 1) { + yyerror(0, lParse, "ARRAY(V,n) value V must have vector dimension of 1"); + return (-1); + } + + dims = &(lParse->Nodes[dimNode]); + for (i=0; iNodes[dimNode].value.data.lng; + + } else if (OPER(dimNode) == '{') { /* ARRAY(V,{a,b,c,d,e}) up to 5 dimensions */ + if (dims->nSubNodes > MAXDIMS) { + yyerror(0, lParse, "ARRAY(V,{...}) number of dimensions must not exceed 5"); + return (-1); + } + naxis = dims->nSubNodes; + for (i=0; inSubNodes; i++) { + if ( TYPE(dims->SubNodes[i]) != LONG ) { + dims->SubNodes[i] = New_Unary(lParse, LONG, 0, dims->SubNodes[i]); + if (dims->SubNodes[i] < 0) return (-1); + } + naxes[i] = lParse->Nodes[ dims->SubNodes[i] ].value.data.lng; + } + } else { + yyerror(0, lParse, "ARRAY(V,dims) dims must be either integer or const vector"); + return (-1); + } + + nelem = 1; + for (i=0; i=0 ) { + this = lParse->Nodes + n; + this->operation = array_fct; + this->nSubNodes = 1; + this->SubNodes[0]= valueNode; + this->type = TYPE(valueNode); + + this->value.nelem = nelem; + this->value.naxis = naxis; + for( i=0; ivalue.naxes[i] = naxes[i]; + + this->DoOp = Do_Array; + } + return( n ); +} + +static int Locate_Col( ParseData *lParse, 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 lParse->colData[ - this->operation].colnum; + + for( i=0; inSubNodes; i++ ) { + that = lParse->Nodes + this->SubNodes[i]; + if( that->operation>0 ) { + newCol = Locate_Col( lParse, 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 = lParse->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( ParseData *lParse, int Node1, int Node2 ) +{ + Node *that1, *that2; + int valid, i; + + if( Node1<0 || Node2<0 ) return(0); + + that1 = lParse->Nodes + Node1; + that2 = lParse->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; ivalue.naxis; i++ ) { + if( that1->value.naxes[i]!=that2->value.naxes[i] ) + valid = 0; + } + } else + valid = 0; + return( valid ); +} + +static void Copy_Dims( ParseData *lParse, int Node1, int Node2 ) +{ + Node *that1, *that2; + int i; + + if( Node1<0 || Node2<0 ) return; + + that1 = lParse->Nodes + Node1; + that2 = lParse->Nodes + Node2; + + that1->value.nelem = that2->value.nelem; + that1->value.naxis = that2->value.naxis; + for( i=0; ivalue.naxis; i++ ) + that1->value.naxes[i] = that2->value.naxes[i]; +} + +/********************************************************************/ +/* Routines for actually evaluating the expression start here */ +/********************************************************************/ + +void Evaluate_Parser( ParseData *lParse, 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; + static int rand_initialized = 0; + + /* Initialize the random number generator once and only once */ + if (rand_initialized == 0) { + simplerng_srand( (unsigned int) time(NULL) ); + rand_initialized = 1; + } + + lParse->firstRow = firstRow; + lParse->nRows = nRows; + + /* Reset Column Nodes' pointers to point to right data and UNDEF arrays */ + + rowOffset = firstRow - lParse->firstDataRow; + for( i=0; inNodes; i++ ) { + if( OPER(i) > 0 || OPER(i) == CONST_OP ) continue; + + column = -OPER(i); + offset = lParse->varData[column].nelem * rowOffset; + + lParse->Nodes[i].value.undef = lParse->varData[column].undef + offset; + + switch( lParse->Nodes[i].type ) { + case BITSTR: + lParse->Nodes[i].value.data.strptr = + (char**)lParse->varData[column].data + rowOffset; + lParse->Nodes[i].value.undef = NULL; + break; + case STRING: + lParse->Nodes[i].value.data.strptr = + (char**)lParse->varData[column].data + rowOffset; + lParse->Nodes[i].value.undef = lParse->varData[column].undef + rowOffset; + break; + case BOOLEAN: + lParse->Nodes[i].value.data.logptr = + (char*)lParse->varData[column].data + offset; + break; + case LONG: + lParse->Nodes[i].value.data.lngptr = + (long*)lParse->varData[column].data + offset; + break; + case DOUBLE: + lParse->Nodes[i].value.data.dblptr = + (double*)lParse->varData[column].data + offset; + break; + } + } + + Evaluate_Node( lParse, lParse->resultNode ); +} + +static void Evaluate_Node( ParseData *lParse, int thisNode ) + /**********************************************************************/ + /* Recursively evaluate thisNode's subNodes, then call one of the */ + /* Do_ functions pointed to by thisNode's DoOp element. */ + /**********************************************************************/ +{ + Node *this; + int i; + + if( lParse->status ) return; + + this = lParse->Nodes + thisNode; + if( this->operation>0 ) { /* <=0 indicate constants and columns */ + i = this->nSubNodes; + while( i-- ) { + Evaluate_Node( lParse, this->SubNodes[i] ); + if( lParse->status ) return; + } + this->DoOp( lParse, this ); + } +} + +static void Allocate_Ptrs( ParseData *lParse, Node *this ) +{ + long elem, row, size; + + if( this->type==BITSTR || this->type==STRING ) { + + this->value.data.strptr = (char**)malloc( lParse->nRows + * sizeof(char*) ); + if( this->value.data.strptr ) { + this->value.data.strptr[0] = (char*)malloc( lParse->nRows + * (this->value.nelem+2) + * sizeof(char) ); + if( this->value.data.strptr[0] ) { + row = 0; + while( (++row)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 { + lParse->status = MEMORY_ALLOCATION; + free( this->value.data.strptr ); + } + } else { + lParse->status = MEMORY_ALLOCATION; + } + + } else { + + elem = this->value.nelem * lParse->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 ) { + lParse->status = MEMORY_ALLOCATION; + } else { + this->value.undef = (char *)this->value.data.ptr + elem*size; + } + } +} + +static void Do_Unary( ParseData *lParse, Node *this ) +{ + Node *that; + long elem; + + that = lParse->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( lParse, this ); + + if( !lParse->status ) { + + if( this->type!=BITSTR ) { + elem = lParse->nRows; + if( this->type!=STRING ) + elem *= this->value.nelem; + while( elem-- ) + this->value.undef[elem] = that->value.undef[elem]; + } + + elem = lParse->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 = lParse->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( ParseData *lParse, Node *this ) +{ + Node *col; + long fRow, nRowOverlap, nRowReload, rowOffset; + long nelem, elem, offset, nRealElem; + int status; + + col = lParse->Nodes + this->SubNodes[0]; + rowOffset = lParse->Nodes[ this->SubNodes[1] ].value.data.lng; + + Allocate_Ptrs( lParse, this ); + + fRow = lParse->firstRow + rowOffset; + if( this->type==STRING || this->type==BITSTR ) + nRealElem = 1; + else + nRealElem = this->value.nelem; + + nelem = nRealElem; + + if( fRow < lParse->firstDataRow ) { + + /* Must fill in data at start of array */ + + nRowReload = lParse->firstDataRow - fRow; + if( nRowReload > lParse->nRows ) nRowReload = lParse->nRows; + nRowOverlap = lParse->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 + lParse->nRows > lParse->firstDataRow + lParse->nDataRows ) { + + /* Must fill in data at end of array */ + + nRowReload = (fRow+lParse->nRows) - (lParse->firstDataRow+lParse->nDataRows); + if( nRowReload>lParse->nRows ) { + nRowReload = lParse->nRows; + } else { + fRow = lParse->firstDataRow + lParse->nDataRows; + } + nRowOverlap = lParse->nRows - nRowReload; + + offset = nRowOverlap * nelem; + + /* NULLify any values falling out of bounds */ + + elem = lParse->nRows * nelem; + while( fRow+nRowReload>lParse->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 = lParse->nRows; + offset = 0; + + } + + if( nRowReload>0 ) { + switch( this->type ) { + case BITSTR: + case STRING: + status = (*lParse->loadData)( lParse, -col->operation, fRow, nRowReload, + this->value.data.strptr+offset, + this->value.undef+offset ); + break; + case BOOLEAN: + status = (*lParse->loadData)( lParse, -col->operation, fRow, nRowReload, + this->value.data.logptr+offset, + this->value.undef+offset ); + break; + case LONG: + status = (*lParse->loadData)( lParse, -col->operation, fRow, nRowReload, + this->value.data.lngptr+offset, + this->value.undef+offset ); + break; + case DOUBLE: + status = (*lParse->loadData)( lParse, -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 = lParse->nRows * nelem; + + offset = nelem * rowOffset; + while( nRowOverlap-- && !lParse->status ) { + while( nelem-- && !lParse->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( ParseData *lParse, Node *this ) +{ + Node *that1, *that2; + char *sptr1=NULL, *sptr2=NULL; + int const1, const2; + long rows; + + that1 = lParse->Nodes + this->SubNodes[0]; + that2 = lParse->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( lParse, this ); + + if( !lParse->status ) { + rows = lParse->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; ivalue.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( ParseData *lParse, Node *this ) +{ + Node *that1, *that2; + char *sptr1, *sptr2, null1=0, null2=0; + int const1, const2, val; + long rows; + + that1 = lParse->Nodes + this->SubNodes[0]; + that2 = lParse->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( lParse, this ); + + if( !lParse->status ) { + + rows = lParse->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( ParseData *lParse, Node *this ) +{ + Node *that1, *that2; + int vector1, vector2; + char val1=0, val2=0, null1=0, null2=0; + long rows, nelem, elem; + + that1 = lParse->Nodes + this->SubNodes[0]; + that2 = lParse->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 = lParse->nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( lParse, this ); + + if( !lParse->status ) { + previous = that2->value.data.lng; + + /* Cumulative sum of this chunk */ + for (i=0; ivalue.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 = lParse->nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( lParse, this ); + + if( !lParse->status ) { + + if (this->operation == ACCUM) { + long i, previous, curr; + + previous = that2->value.data.lng; + + /* Cumulative sum of this chunk */ + for (i=0; ivalue.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( ParseData *lParse, Node *this ) +{ + Node *that1, *that2; + int vector1, vector2; + long val1=0, val2=0; + char null1=0, null2=0; + long rows, nelem, elem; + + that1 = lParse->Nodes + this->SubNodes[0]; + that2 = lParse->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 '&': 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 yyerror(0, lParse, "Divide by Zero"); + break; + case '/': + if( val2 ) this->value.data.lng = (val1 / val2); + else yyerror(0, lParse, "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 = lParse->nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( lParse, this ); + + if( !lParse->status ) { + previous = that2->value.data.lng; + undef = (long) that2->value.undef; + + if (this->operation == ACCUM) { + /* Cumulative sum of this chunk */ + for (i=0; ivalue.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; ivalue.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 = lParse->nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( lParse, this ); + + while( rows-- && !lParse->status ) { + while( nelem-- && !lParse->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 '&': 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( ParseData *lParse, 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 = lParse->Nodes + this->SubNodes[0]; + that2 = lParse->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 yyerror(0, lParse, "Divide by Zero"); + break; + case '/': + if( val2 ) this->value.data.dbl = (val1 / val2); + else yyerror(0, lParse, "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 = lParse->nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( lParse, this ); + + if( !lParse->status ) { + previous = that2->value.data.dbl; + undef = (long) that2->value.undef; + + if (this->operation == ACCUM) { + /* Cumulative sum of this chunk */ + for (i=0; ivalue.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; ivalue.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 = lParse->nRows; + nelem = this->value.nelem; + elem = this->value.nelem * rows; + + Allocate_Ptrs( lParse, this ); + + while( rows-- && !lParse->status ) { + while( nelem-- && !lParse->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 */ + + /* 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 void Do_Func( ParseData *lParse, 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] = lParse->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 = simplerng_getpoisson(pVals[0].data.dbl); + else + this->value.data.lng = simplerng_getpoisson(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; + case setnull_fct: /* Only defined for numeric expressions */ + 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; + 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 ) + yyerror(0, lParse, "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 ) + yyerror(0, lParse, "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 ) + yyerror(0, lParse, "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 ) + yyerror(0, lParse, "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 ) + yyerror(0, lParse, "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(lParse, + 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( lParse, this ); + + row = lParse->nRows; + elem = row * this->value.nelem; + + if( !lParse->status ) { + switch( this->operation ) { + + /* Special functions with no arguments */ + + case row_fct: + while( row-- ) { + this->value.data.lngptr[row] = lParse->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 axiselem_fct: + { + long ielem; + long iaxis[MAXDIMS] = {1, 1, 1, 1, 1}; + long ipos = pVals[1].data.lng - 1; /* This should be a constant long value */ + int naxis = this->value.naxis; + int j; + if (ipos < 0 || ipos >= MAXDIMS) { + yyerror(0, lParse, "AXISELEM(V,n) n value exceeded maximum dimension"); + free( this->value.data.ptr ); + break; + } + + for (ielem = 0; ielemvalue.data.lngptr[ielem] = iaxis[ipos]; + this->value.undef[ielem] = 0; + iaxis[0]++; + for (j = 0; j < naxis; j++) { + if (iaxis[j] > this->value.naxes[j]) { + iaxis[j] = 1; + if (j < (naxis-1)) iaxis[j+1]++; + } else { + break; + } + } + + } + } + break; + case elemnum_fct: + { + long ielem; + long elemnum = 1; + int j; + + for (ielem = 0; ielemvalue.data.lngptr[ielem] = elemnum; + this->value.undef[ielem] = 0; + elemnum ++; + if (elemnum > this->value.nelem) elemnum = 1; + } + } + break; + case rnd_fct: + while( elem-- ) { + this->value.data.dblptr[elem] = simplerng_getuniform(); + this->value.undef[elem] = 0; + } + break; + + case gasrnd_fct: + while( elem-- ) { + this->value.data.dblptr[elem] = simplerng_getnorm(); + 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] = simplerng_getpoisson(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] = + simplerng_getpoisson(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] = simplerng_getpoisson(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] = + simplerng_getpoisson(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) { + yyerror(0, lParse, "Could not allocate temporary memory in median function"); + free( this->value.data.ptr ); + break; + } + + for (irow=0; irow 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) { + yyerror(0, lParse, "Could not allocate temporary memory in median function"); + free( this->value.data.ptr ); + break; + } + + for (irow=0; irow 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; + case setnull_fct: + switch( this->type ) { + case LONG: + while( elem-- ) { + if ( theParams[1]->value.data.lng == + theParams[0]->value.data.lngptr[elem] ) { + this->value.data.lngptr[elem] = 0; + this->value.undef[elem] = 1; + } else { + this->value.data.lngptr[elem] = theParams[0]->value.data.lngptr[elem]; + this->value.undef[elem] = theParams[0]->value.undef[elem]; + } + } + break; + case DOUBLE: + while( elem-- ) { + if ( theParams[1]->value.data.dbl == + theParams[0]->value.data.dblptr[elem] ) { + this->value.data.dblptr[elem] = 0; + this->value.undef[elem] = 1; + } else { + this->value.data.dblptr[elem] = theParams[0]->value.data.dblptr[elem]; + this->value.undef[elem] = theParams[0]->value.undef[elem]; + } + } + break; + } + 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(lParse, + 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 (!lParse->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( ParseData *lParse, Node *this ) +{ + Node *theVar, *theDims[MAXDIMS]; + int isConst[MAXDIMS], allConst; + long dimVals[MAXDIMS]; + int i, nDims; + long row, elem, dsize; + + theVar = lParse->Nodes + this->SubNodes[0]; + + i = nDims = this->nSubNodes-1; + allConst = 1; + while( i-- ) { + theDims[i] = lParse->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( lParse, this ); + + if( !lParse->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; rownRows; 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 { + yyerror(0, lParse, "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 ] ) { + yyerror(0, lParse, "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; rownRows; 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; rownRows; 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; rownRows; row++ ) { + + for( i=0; ivalue.undef[row] ) { + yyerror(0, lParse, "Null encountered as vector index"); + free( this->value.data.ptr ); + break; + } else + dimVals[i] = theDims[i]->value.data.lngptr[row]; + } + } + if( lParse->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 { + yyerror(0, lParse, "Index out of range"); + free( this->value.data.ptr ); + } + } + + } else { + + /* Reduce dimensions by 1, using a nonconstant expression */ + + for( row=0; rownRows; row++ ) { + + /* Index cannot be a constant */ + + if( theDims[0]->value.undef[row] ) { + yyerror(0, lParse, "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 ] ) { + yyerror(0, lParse, "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; ioperation>0 ) { + free( theDims[i]->value.data.ptr ); + } +} + +static void Do_GTI( ParseData *lParse, Node *this ) +{ + Node *theExpr, *theTimes; + double *start, *stop, *times; + long elem, nGTI, gti; + int ordered; + int dorow = (this->operation == gtifind_fct); + + theTimes = lParse->Nodes + this->SubNodes[0]; + theExpr = lParse->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 ) { + gti = Search_GTI( theExpr->value.data.dbl, nGTI, start, stop, ordered, 0 ); + if (dorow) { + this->value.data.lng = (gti >= 0) ? (gti+1) : -1; + } else { + this->value.data.log = (gti>=0); + } + this->operation = CONST_OP; + + } else { + + Allocate_Ptrs( lParse, this ); + + times = theExpr->value.data.dblptr; + if( !lParse->status ) { + + elem = lParse->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]stop[gti] ) { + gti = Search_GTI( times[elem], nGTI, start, stop, ordered, 0 ); + } + if (dorow) { + this->value.data.lngptr[elem] = ( gti >= 0 ) ? (gti + 1) : (-1); + this->value.undef[elem] = ( gti >= 0 ) ? 0 : 1; + } else { + this->value.data.logptr[elem] = ( gti>=0 ); + } + } + } else { /* nGTI == 0 */ + + if (dorow) { /* no good times so all values are undef */ + while( elem-- ) { + this->value.undef[elem] = 1; + } + } else { /* no good times so all logicals are 0 */ + while( elem-- ) { + this->value.data.logptr[elem] = 0; + this->value.undef[elem] = 0; + } + } + + } + } + } + + if( theExpr->operation>0 ) + free( theExpr->value.data.ptr ); +} + +static void Do_GTI_Over( ParseData *lParse, Node *this ) +{ + Node *theTimes, *theStart, *theStop; + double *gtiStart, *gtiStop; + double *evtStart, *evtStop; + long elem, nGTI, gti, nextGTI; + int ordered; + + theTimes = lParse->Nodes + this->SubNodes[0]; /* GTI times */ + theStop = lParse->Nodes + this->SubNodes[2]; /* User start time */ + theStart = lParse->Nodes + this->SubNodes[1]; /* User stop time */ + + nGTI = theTimes->value.nelem; + gtiStart = theTimes->value.data.dblptr; /* GTI start */ + gtiStop = theTimes->value.data.dblptr + nGTI; /* GTI stop */ + + if( theStart->operation==CONST_OP && theStop->operation==CONST_OP) { + + this->value.data.dbl = + (GTI_Over( theStart->value.data.dbl, theStop->value.data.dbl, + nGTI, gtiStart, gtiStop, >i)); + this->operation = CONST_OP; + + } else { + char undefStart = 0, undefStop = 0; /* Input values are undef? */ + double uStart, uStop; /* User start/stop values */ + if (theStart->operation==CONST_OP) uStart = theStart->value.data.dbl; + if (theStop ->operation==CONST_OP) uStop = theStop ->value.data.dbl; + + Allocate_Ptrs( lParse, this ); + + evtStart = theStart->value.data.dblptr; + evtStop = theStop ->value.data.dblptr; + if( !lParse->status ) { + + elem = lParse->nRows * this->value.nelem; + if( nGTI ) { + double toverlap = 0.0; + gti = -1; + while( elem-- ) { + if (theStart->operation!=CONST_OP) { + undefStart = theStart->value.undef[elem]; + uStart = evtStart[elem]; + } + if (theStop->operation!=CONST_OP) { + undefStop = theStop ->value.undef[elem]; + uStop = evtStop[elem]; + } + /* This works because at least one of the values is not const */ + if( (this->value.undef[elem] = (undefStart||undefStop)) ) + continue; + + /* Before searching entire GTI, check the GTI found last time */ + if( gti<0 || + uStartgtiStop[gti] || + uStop gtiStop[gti]) { + /* Nope, need to recalculate */ + toverlap = GTI_Over(uStart, uStop, + nGTI, gtiStart, gtiStop, + >i); + } else { + /* We are in same GTI, the overlap is just stop-start of user range */ + toverlap = (uStop-uStart); + } + + /* This works because at least one of the values is not const */ + this->value.data.dblptr[elem] = toverlap; + } + } else + /* nGTI == 0; there is no overlap so set all values to 0.0 */ + while( elem-- ) { + this->value.data.dblptr[elem] = 0.0; + this->value.undef[elem] = 0; + } + } + } + + if( theStart->operation>0 ) { + free( theStart->value.data.ptr ); + } + if( theStop->operation>0 ) { + free( theStop->value.data.ptr ); + } +} + +static double GTI_Over(double evtStart, double evtStop, + long nGTI, double *start, double *stop, + long *gtiout) +{ + long gti1, gti2, nextGTI1, nextGTI2; + long gti, nMax; + double overlap = 0.0; + + *gtiout = -1L; + /* Zero or negative bin size */ + if (evtStop <= evtStart) return 0.0; + + /* Locate adjacent GTIs for evtStart and evtStop */ + gti1 = Search_GTI(evtStart, nGTI, start, stop, 1, &nextGTI1); + gti2 = Search_GTI(evtStop, nGTI, start, stop, 1, &nextGTI2); + + /* evtStart is in gti1, we return that for future processing */ + if (gti1 >= 0) *gtiout = gti1; + + /* Both evtStart/evtStop are beyond the last GTI */ + if (nextGTI1 < 0 && nextGTI2 < 0) return 0.0; + + /* Both evtStart/evtStop are in the same gap between GTIs */ + if (gti1 < 0 && gti2 < 0 && nextGTI1 == nextGTI2) return 0.0; + + /* Both evtStart/evtStop are in the same GTI */ + if (gti1 >= 0 && gti1 == gti2) return (evtStop-evtStart); + + /* Count through the remaining GTIs; there will be at least one */ + /* The largest GTI to consider is either nextGTI2-1, if it exists, + or nGTI-1 */ + if (nextGTI2 < 0) nMax = nGTI-1; + else if (gti2 >= 0) nMax = nextGTI2; + else nMax = nextGTI2-1; + for (gti = nextGTI1; gti <= nMax; gti++) { + double starti = start[gti], stopi = stop[gti]; + /* Trim the GTI by actual evtStart/Stop times */ + if (evtStart > starti) starti = evtStart; + if (evtStop < stopi ) stopi = evtStop; + overlap += (stopi - starti); + } + + return overlap; +} + +/* + * Search_GTI - search GTI for requested evtTime + * + * double evtTime - requested event time + * long nGTI - number of entries in start[] and stop[] + * double start[], stop[] - start and stop of each GTI + * int ordered - set to 1 if time-ordered + * long *nextGTI0 - upon return, *nextGTI0 is either + * the GTI evtTime is inside + * the next GTI if evtTime is not inside + * -1L if there is no next GTI + * not set if nextGTI0 is a null pointer + * + * NOTE: for *nextGTI to be well-defined, the GTI must + * be ordered. This is true when called by Do_GTI. + * + * RETURNS: gti index that evtTime is located inside, or -1L + */ +static long Search_GTI( double evtTime, long nGTI, double *start, + double *stop, int ordered, long *nextGTI0 ) +{ + long gti, nextGTI = -1L, 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 { + nextGTI = gti+1; + gti = -1L; + break; + } + } else if( evtTime evtTime) nextGTI = 0; + gti = -1L; + } + + } else { /* Use "SLOW" linear search. Not required to be + ordered, so we have to search the whole table + no matter what. + */ + gti = nGTI; + while( gti-- ) { + if( stop[gti] >= evtTime ) nextGTI = gti; + if( evtTime>=start[gti] && evtTime<=stop[gti] ) + break; + } + } + + if (nextGTI >= nGTI) nextGTI = -1; + if (nextGTI0) *nextGTI0 = nextGTI; + + return( gti ); +} + +static void Do_REG( ParseData *lParse, 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 = lParse->Nodes + this->SubNodes[0]; + theX = lParse->Nodes + this->SubNodes[1]; + theY = lParse->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( lParse, this ); + + if( !lParse->status ) { + + rows = lParse->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( ParseData *lParse, Node *this ) +{ + Node *that; + long row, elem, idx, jdx, offset=0; + int node; + + Allocate_Ptrs( lParse, this ); + + if( !lParse->status ) { + + for( node=0; nodenSubNodes; node++ ) { + + that = lParse->Nodes + this->SubNodes[node]; + + if( that->operation == CONST_OP ) { + + idx = lParse->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 = lParse->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( lParse->Nodes[this->SubNodes[node]].value.data.ptr ); +} + +static void Do_Array( ParseData *lParse, Node *this ) +{ + Node *that; + long row, elem, idx, jdx, offset=0; + int node; + + Allocate_Ptrs( lParse, this ); + + if( !lParse->status ) { + + /* This is the item to be replicated */ + that = lParse->Nodes + this->SubNodes[0]; + + if( that->operation == CONST_OP ) { + + idx = lParse->nRows*this->value.nelem + offset; + while( (idx--)>=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 = lParse->nRows; + idx = row * this->value.nelem - 1; + while( row-- ) { + elem = this->value.nelem; + while( elem-- ) { + this->value.undef[idx] = that->value.undef[row]; + + switch( this->type ) { + case BOOLEAN: + this->value.data.logptr[idx] = that->value.data.logptr[row]; + break; + case LONG: + this->value.data.lngptr[idx] = that->value.data.lngptr[row]; + break; + case DOUBLE: + this->value.data.dblptr[idx] = that->value.data.dblptr[row]; + break; + } + idx--; + } + } + + } /* not constant */ + + if( OPER(this->SubNodes[0])>0 ) + free( lParse->Nodes[this->SubNodes[0]].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=0; + char chr1, chr2; + + l1 = strlen(bits1); + l2 = strlen(bits2); + length = (l1 > l2) ? l1 : l2; + stream = (char *)malloc(sizeof(char)*(length+1)); + if (l1 < 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) + { + ldiff = l1 - l2; + i=0; + while( ldiff-- ) stream[i++] = '0'; + while( l2-- ) stream[i++] = *(bits2++); + stream[i] = '\0'; + bits2 = stream; + } + + 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; + } + free(stream); + return (result); +} + +static void bitand(char *result,char *bitstrm1,char *bitstrm2) +{ + int i, l1, l2, ldiff, largestStream; + char *stream=0; + char chr1, chr2; + + l1 = strlen(bitstrm1); + l2 = strlen(bitstrm2); + largestStream = (l1 > l2) ? l1 : l2; + stream = (char *)malloc(sizeof(char)*(largestStream+1)); + 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++; + } + free(stream); + *result = '\0'; +} + +static void bitor(char *result,char *bitstrm1,char *bitstrm2) +{ + int i, l1, l2, ldiff, largestStream; + char *stream=0; + char chr1, chr2; + + l1 = strlen(bitstrm1); + l2 = strlen(bitstrm2); + largestStream = (l1 > l2) ? l1 : l2; + stream = (char *)malloc(sizeof(char)*(largestStream+1)); + 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++; + } + free(stream); + *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, largestStream; + char *stream=0; + char chr1, chr2; + + l1 = strlen(bitstrm1); + l2 = strlen(bitstrm2); + largestStream = (l1 > l2) ? l1 : l2; + stream = (char *)malloc(sizeof(char)*(largestStream+1)); + 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')) ) + { + free(stream); + return( 0 ); + } + } + free(stream); + 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(ParseData *lParse, 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) { + yyerror(0, lParse, "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 yyerror(yyscan_t scanner, ParseData *lParse, char *s) +{ + char msg[80]; + + if( !lParse->status ) lParse->status = PARSE_SYNTAX_ERR; + + strncpy(msg, s, 80); + msg[79] = '\0'; + ffpmsg(msg); +} diff --git a/vendor/cfitsio/fits_hcompress.c b/vendor/cfitsio/fits_hcompress.c new file mode 100644 index 000000000..fb9d6e58f --- /dev/null +++ b/vendor/cfitsio/fits_hcompress.c @@ -0,0 +1,1859 @@ +/* ######################################################################### +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 +#include +#include +#include +#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<> 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=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>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<> 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=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>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; i0) ? (*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 + (initialize to all zeros) + */ + signbits = (unsigned char *) calloc(1, (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 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=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< 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 *) calloc(1, (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 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=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)< 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<>(-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<nqy) ? nqx : nqy; + log2n = (int) (log((float) nqmax)/log(2.0)+0.5); + if (nqmax > (1<= 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>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<0) { + /* + * put out the last few bits + */ + output_nbits(outfile, bitbuffer & ((1<=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<= 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>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<0) { + /* + * put out the last few bits + */ + output_nbits(outfile, bitbuffer & ((1<=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; + + 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> 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); + 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> 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 +#include +#include +#include +#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<> 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<=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= 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= 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<> 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<=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= 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= 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= 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>1; + pt = tmp; + p1 = &a[n2*nhalf]; /* pointer to a[i] */ + for (i=nhalf; 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> 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=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=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=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=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=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=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 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 */ + + /* 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 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 */ + + /* 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; inqy) ? nqx : nqy; + log2n = (int) (log((float) nqmax)/log(2.0)+0.5); + if (nqmax > (1<= 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<>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<= 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<>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>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>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>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>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; +LONGLONG plane_val; + + plane_val = ((LONGLONG) 1) << bit; + + /* + * expand each 2x2 block + */ + k = 0; /* k is index of a[i/2,j/2] */ + for (i = 0; i>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>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<>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<>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/vendor/cfitsio/fitscore.c b/vendor/cfitsio/fitscore.c new file mode 100644 index 000000000..47d1ea04e --- /dev/null +++ b/vendor/cfitsio/fitscore.c @@ -0,0 +1,9889 @@ +/* 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 +#include +#include +#include +#include +#include +/* stddef.h is apparently needed to define size_t with some compilers ?? */ +#include +#include +#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 + + Note that this method of calculation limits minor/micro fields to < 100. +*/ +{ + *version = (float)CFITSIO_MAJOR + (float)(.01*CFITSIO_MINOR) + + (float)(.0001*CFITSIO_MICRO); + +/* *version = 4.2.0 Nov 2022 + + Previous releases: + *version = 4.1.0 Feb 2022 + *version = 4.0.0 May 2021 + *version = 3.49 Aug 2020 + *version = 3.48 Apr 2020 + *version = 3.47 May 2019 + *version = 3.46 Oct 2018 + *version = 3.45 May 2018 + *version = 3.44 Apr 2018 + *version = 3.43 Mar 2018 + *version = 3.42 Mar 2017 + *version = 3.41 Nov 2016 + *version = 3.40 Oct 2016 + *version = 3.39 Apr 2016 + *version = 3.38 Feb 2016 + *version = 3.37 3 Jun 2014 + *version = 3.36 6 Dec 2013 + *version = 3.35 23 May 2013 + *version = 3.34 20 Mar 2013 + *version = 3.33 14 Feb 2013 + *version = 3.32 Oct 2012 + *version = 3.31 18 Jul 2012 + *version = 3.30 11 Apr 2012 + *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 117: + strcpy(errtext, "bad value for file download timeout setting"); + 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[FLEN_ERRMSG], 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 */ + snprintf(msg, FLEN_ERRMSG, + "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 */ + snprintf(msg, FLEN_ERRMSG,"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[FLEN_ERRMSG]; + + 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) + { + snprintf(msg, FLEN_ERRMSG, + "Character %d in this keyword is illegal. Hex Value = %X", + (int) (ii+1), (int) card[ii] ); + + if (card[ii] == 0) + strncat(msg, " (NULL char.)",FLEN_ERRMSG-strlen(msg)-1); + else if (card[ii] == 9) + strncat(msg, " (TAB char.)",FLEN_ERRMSG-strlen(msg)-1); + else if (card[ii] == 10) + strncat(msg, " (Line Feed char.)",FLEN_ERRMSG-strlen(msg)-1); + else if (card[ii] == 11) + strncat(msg, " (Vertical Tab)",FLEN_ERRMSG-strlen(msg)-1); + else if (card[ii] == 12) + strncat(msg, " (Form Feed char.)",FLEN_ERRMSG-strlen(msg)-1); + else if (card[ii] == 13) + strncat(msg, " (Carriage Return)",FLEN_ERRMSG-strlen(msg)-1); + else if (card[ii] == 27) + strncat(msg, " (Escape char.)",FLEN_ERRMSG-strlen(msg)-1); + else if (card[ii] == 127) + strncat(msg, " (Delete char.)",FLEN_ERRMSG-strlen(msg)-1); + + 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], tmpname2[FLEN_KEYWORD],*cptr; + char *saveptr; + int tstatus = -1, nblank = 0, ntoken = 0, maxlen = 0, specialchar = 0; + + if (*status > 0) + return(*status); + + *tmpname = '\0'; + *tmpname2 = '\0'; + *card = '\0'; + + /* skip leading blanks in the name */ + while(*(keyname + nblank) == ' ') + nblank++; + + strncat(tmpname, keyname + nblank, FLEN_KEYWORD - 1); + + len = strlen(value); + namelen = strlen(tmpname); + + /* delete non-significant trailing blanks in the name */ + if (namelen) { + cptr = tmpname + namelen - 1; + + while(*cptr == ' ') { + *cptr = '\0'; + cptr--; + } + + namelen = cptr - tmpname + 1; + } + + /* 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); + } + + if (namelen <= 8 && fftkey(tmpname, &tstatus) <= 0 ) { + + /* a normal 8-char (or less) 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 if ((FSTRNCMP(tmpname, "HIERARCH ", 9) == 0) || + (FSTRNCMP(tmpname, "hierarch ", 9) == 0) ) { + + /* this is an explicit ESO HIERARCH keyword */ + + strcat(card, tmpname); /* copy keyword name to buffer */ + + if (namelen + 3 + len > 80) { + /* save 1 char by not putting a space before the equals sign */ + strcat(card, "= "); + namelen += 2; + } else { + strcat(card, " = "); + namelen += 3; + } + } else { + + /* scan the keyword name to determine the number and max length of the tokens */ + /* and test if any of the tokens contain nonstandard characters */ + + strncat(tmpname2, tmpname, FLEN_KEYWORD - 1); + cptr = ffstrtok(tmpname2, " ",&saveptr); + while (cptr) { + if (strlen(cptr) > maxlen) maxlen = strlen(cptr); /* find longest token */ + + /* name contains special characters? */ + tstatus = -1; /* suppress any error message */ + if (fftkey(cptr, &tstatus) > 0) specialchar = 1; + + cptr = ffstrtok(NULL, " ",&saveptr); + ntoken++; + } + + tstatus = -1; /* suppress any error message */ + +/* if (ntoken > 1) { */ + if (ntoken > 0) { /* temporarily change so that this case should always be true */ + /* for now at least, treat all cases as an implicit ESO HIERARCH keyword. */ + /* This could change if FITS is ever expanded to directly support longer keywords. */ + + if (namelen + 11 > FLEN_CARD-1) + { + ffpmsg( + "The following keyword is too long to fit on a card:"); + ffpmsg(keyname); + return(*status = BAD_KEYCHAR); + } + strcat(card, "HIERARCH "); + strcat(card, tmpname); + namelen += 9; + + if (namelen + 3 + len > 80) { + /* save 1 char by not putting a space before the equals sign */ + strcat(card, "= "); + namelen += 2; + } else { + strcat(card, " = "); + namelen += 3; + } + + } else if ((fftkey(tmpname, &tstatus) <= 0)) { + /* should never get here (at least for now) */ + /* allow keyword names longer than 8 characters */ + + strncat(card, tmpname, FLEN_KEYWORD - 1); + strcat(card, "= "); + namelen += 2; + } else { + /* should never get here (at least for now) */ + ffpmsg("Illegal keyword name:"); + ffpmsg(tmpname); + return(*status = BAD_KEYCHAR); + } + } + + if (len > 0) /* now process the value string */ + { + 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) */ + } + } + } + + /* issue a warning if this keyword does not strictly conform to the standard + HIERARCH convention, which requires, + 1) at least 2 tokens in the name, + 2) no tokens longer than 8 characters, and + 3) no special characters in any of the tokens */ + + if (ntoken == 1 || specialchar == 1) { + ffpmsg("Warning: the following keyword does not conform to the HIERARCH convention"); + /* ffpmsg(" (e.g., name is not hierarchical or contains non-standard characters)."); */ + ffpmsg(card); + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffmkey(fitsfile *fptr, /* I - FITS file pointer */ + const 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; + int keylength = 8; + + /* 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] = ' '; + + keylength = strcspn(tcard, "="); + if (keylength == 80) keylength = 8; + + for (ii=0; ii < keylength; 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 || value < 0 ) + return(*status = 206); + + snprintf(suffix, 16, "%d", value); /* construct keyword suffix */ + + strcpy(keyname, keyroot); /* copy root string to name string */ + while (rootlen > 0 && keyname[rootlen - 1] == ' ') { + rootlen--; /* remove trailing spaces in root name */ + keyname[rootlen] = '\0'; + } + if (strlen(suffix) + strlen(keyname) > 8) + return (*status=206); + + strcat(keyname, suffix); /* append suffix to the root */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffnkey(int value, /* I - index number to be appended to root name */ + const 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); + + snprintf(keyname, FLEN_VALUE,"%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; + char strbuf[21]; + + if (*status > 0) + return(*status); + + value[0] = '\0'; + if (comm) + comm[0] = '\0'; + + cardlen = strlen(card); + if (cardlen >= FLEN_CARD) + { + strncpy(strbuf,card,20); + strbuf[20]='\0'; + ffpmsg("The card string starting with the chars below is too long:"); + ffpmsg(strbuf); + return(*status = BAD_KEYCHAR); + } + + /* 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, "CONTINUE", 8) == 0 || + FSTRNCMP(card, " ", 8) == 0 ) + { + /* 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 if (FSTRNCMP(&card[8], "= ", 2) == 0 ) + { + /* normal keyword with '= ' in cols 9-10 */ + valpos = 10; /* starting position of the value field */ + } + else + { + 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 '=' */ + } + + 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 && jj < FLEN_VALUE-1; 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 == FLEN_VALUE-1) + { + jj = minvalue(jj, FLEN_VALUE-2); /* 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] ) || nblank >= FLEN_VALUE-1 ) + { + ffpmsg("This complex keyword value has no closing ')' within range:"); + 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 */ + if (nblank >= FLEN_VALUE) /* This should not happen for correct input */ + nblank = FLEN_VALUE-1; + 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++; + } + strncpy(comm, &card[ii],FLEN_COMMENT-1); /* copy the remaining characters */ + comm[FLEN_COMMENT-1] = '\0'; + + 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, lentok1=0, remainlen=0; + 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; + + len = strcspn(tok, " =+"); /* length of name */ + if (len >= FLEN_KEYWORD) + return(*status = BAD_KEYCHAR); + + lentok1 = len; + 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; + + /* Check optional "+" indicator to delete multiple keywords */ + if (tok[0] == '+' && len < FLEN_KEYWORD) { + strcat(card, "+"); + return (*status); + } + + /* 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 */ + /* this name has to fit on columns 41-80 of card, + and first name must now fit in 1-40 */ + if (lentok1 > 40) + { + card[0] = '\0'; + return (*status = BAD_KEYCHAR); + } + if (len > 40) + { + card[0] = '\0'; + 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); + card[80] = '\0'; /* necessary to add terminator in case len = 40 */ + + /* + 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, 72); + 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; + remainlen = 139; + while (more) + { + tok++; /* temporarily move past the quote char */ + len = strcspn(tok, "'"); /* length of quoted string */ + tok--; + if (len+2 > remainlen) + return (*status=BAD_KEYCHAR); + strncat(value, tok, len + 2); + remainlen -= (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 */ + if (len > 139) + return (*status=BAD_KEYCHAR); + 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 */ + if (len > 137) + return (*status=BAD_KEYCHAR); + 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: explicit deletion, return '-' */ + if (pass && strcmp(spat,"--") == 0) { + strcpy(outrec, "-"); + strncat(outrec, inrec, 8); + outrec[9] = 0; + for(i1=8; i1>1 && outrec[i1] == ' '; i1--) outrec[i1] = 0; + return 0; + } + + /* Return case: no match, or do-not-transfer pattern */ + if (pass == 0 || spat[0] == '\0' || strcmp(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; (*status == 0) && (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 (*status == 0) { + if (outrec[0] == '-') { /* prefix -KEYNAME means delete */ + int i1; + + /* Preserve only the keyword portion of name */ + outrec[9] = 0; + for(i1=8; i1>1 && outrec[i1] == ' '; i1--) outrec[i1] = 0; + + ffpmrk(); + ffdkey(outfptr, outrec+1, status); /* delete the keyword */ + if (*status == 0) { + int nkeys1; + /* get number of keywords again in case of change*/ + ffghsp(infptr, &nkeys1, &nmore, status); + if (nkeys1 != nkeys) { + nrec --; + nkeys = nkeys1; + } + } + *status = 0; + ffcmrk(); + + } else if (outrec[0]) { + ffprec(outfptr, outrec, status); /* copy the keyword */ + } + } + 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 = 0, mval = 0, lval = 0; + 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++; + + if (strlen(&tform[ii]) > FLEN_VALUE-1) + { + ffpmsg("Error: ASCII table TFORM code is too long (ffasfm)"); + 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 */ + + + 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 + { + snprintf(message, FLEN_ERRMSG, + "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; + snprintf(message,FLEN_ERRMSG,"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); + } + + if (nchar-ii > FLEN_VALUE-1) + { + ffpmsg("Error: binary table TFORM code is too long (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 + { + if (sscanf(form,"%ld", &repeat) != 1) /* read repeat count */ + { + ffpmsg("Error: Bad repeat format in TFORM (ffbnfm)."); + return(*status = BAD_TFORM); + } + } + + /*-----------------------------------------------*/ + /* 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 short 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] == 'W') /* internal code to signify unsigned long long integer */ + { + datacode = TULONGLONG; + width = 8; + } + 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 + { + snprintf(message, FLEN_ERRMSG, + "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); + } + + if (strlen(&tform[ii]) > FLEN_VALUE-1) + { + ffpmsg("Error: binary table TFORM code is too long (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] == 'W') /* internal code to signify unsigned long long integer */ + { + datacode = TULONGLONG; + width = 8; + } + 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 + { + snprintf(message, FLEN_ERRMSG, + "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]; + int tstatus, ii, founde, foundw, match, exact, unique; + long ivalue; + tcolumn *colptr; + + if (*status <= 0) + { + (fptr->Fptr)->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 += ((fptr->Fptr)->startcol); /* offset to starting column */ + + founde = FALSE; /* initialize 'found exact match' flag */ + foundw = FALSE; /* initialize 'found wildcard match' flag */ + unique = FALSE; + + for (ii = (fptr->Fptr)->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 */ + (fptr->Fptr)->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; + (fptr->Fptr)->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) + { + snprintf(errmsg, FLEN_ERRMSG, "ffgcnn could not find column: %.45s", templt); + ffpmsg(errmsg); + } + } + } + + (fptr->Fptr)->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); + if (width) + *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; + + case TLONGLONG: + min_val = -9.2233720368547755808E18; + max_val = 9.2233720368547755807E18; + 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 */ + (tzero != 9223372036854775808.) && /* indicates unsigned long long */ + (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 if ((min_val >= -9.2233720368547755808E18) && (max_val <= 9.2233720368547755807E18)) { + effcode = TLONGLONG; + + } else if ((min_val >= 0.0) && (max_val <= 1.8446744073709551616E19)) { + effcode = TULONGLONG; + + } else { /* exceeds the range of a 64-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, ntilebins; + 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)->tilerow) { + ntilebins = + (((fptr->Fptr)->znaxis[0] - 1) / ((fptr->Fptr)->tilesize[0])) + 1; + + for (ii = 0; ii < ntilebins; ii++) { + if ((fptr->Fptr)->tiledata[ii]) { + free((fptr->Fptr)->tiledata[ii]); + } + + if ((fptr->Fptr)->tilenullarray[ii]) { + free((fptr->Fptr)->tilenullarray[ii]); + } + } + + free((fptr->Fptr)->tileanynull); + free((fptr->Fptr)->tiletype); + free((fptr->Fptr)->tiledatasize); + free((fptr->Fptr)->tilenullarray); + free((fptr->Fptr)->tiledata); + free((fptr->Fptr)->tilerow); + + (fptr->Fptr)->tileanynull = 0; + (fptr->Fptr)->tiletype = 0; + (fptr->Fptr)->tiledatasize = 0; + (fptr->Fptr)->tilenullarray = 0; + (fptr->Fptr)->tiledata = 0; + (fptr->Fptr)->tilerow = 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 */ + if ((fptr->Fptr)->tilerow) { + + ntilebins = + (((fptr->Fptr)->znaxis[0] - 1) / ((fptr->Fptr)->tilesize[0])) + 1; + + for (ii = 0; ii < ntilebins; ii++) { + if ((fptr->Fptr)->tiledata[ii]) { + free((fptr->Fptr)->tiledata[ii]); + } + + if ((fptr->Fptr)->tilenullarray[ii]) { + free((fptr->Fptr)->tilenullarray[ii]); + } + } + + free((fptr->Fptr)->tileanynull); + free((fptr->Fptr)->tiletype); + free((fptr->Fptr)->tiledatasize); + free((fptr->Fptr)->tilenullarray); + free((fptr->Fptr)->tiledata); + free((fptr->Fptr)->tilerow); + + (fptr->Fptr)->tileanynull = 0; + (fptr->Fptr)->tiletype = 0; + (fptr->Fptr)->tiledatasize = 0; + (fptr->Fptr)->tilenullarray = 0; + (fptr->Fptr)->tiledata = 0; + (fptr->Fptr)->tilerow = 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, ntilebins; + 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[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 = 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)."); + snprintf(errmsg, FLEN_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)->tilerow) { + + ntilebins = + (((fptr->Fptr)->znaxis[0] - 1) / ((fptr->Fptr)->tilesize[0])) + 1; + + for (ii = 0; ii < ntilebins; ii++) { + if ((fptr->Fptr)->tiledata[ii]) { + free((fptr->Fptr)->tiledata[ii]); + } + + if ((fptr->Fptr)->tilenullarray[ii]) { + free((fptr->Fptr)->tilenullarray[ii]); + } + } + + free((fptr->Fptr)->tileanynull); + free((fptr->Fptr)->tiletype); + free((fptr->Fptr)->tiledatasize); + free((fptr->Fptr)->tilenullarray); + free((fptr->Fptr)->tiledata); + free((fptr->Fptr)->tilerow); + + (fptr->Fptr)->tileanynull = 0; + (fptr->Fptr)->tiletype = 0; + (fptr->Fptr)->tiledatasize = 0; + (fptr->Fptr)->tilenullarray = 0; + (fptr->Fptr)->tiledata = 0; + (fptr->Fptr)->tilerow = 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 */ + snprintf(message,FLEN_ERRMSG,"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 */ + snprintf(message,FLEN_ERRMSG,"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 */ + snprintf(message,FLEN_ERRMSG,"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 ) + { + snprintf(message,FLEN_ERRMSG,"Column %d is too wide to fit in table (ffainit)", + ii+1); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG," 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, ntilebins; + 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)->tilerow) { + + ntilebins = + (((fptr->Fptr)->znaxis[0] - 1) / ((fptr->Fptr)->tilesize[0])) + 1; + + for (ii = 0; ii < ntilebins; ii++) { + if ((fptr->Fptr)->tiledata[ii]) { + free((fptr->Fptr)->tiledata[ii]); + } + + if ((fptr->Fptr)->tilenullarray[ii]) { + free((fptr->Fptr)->tilenullarray[ii]); + } + } + + free((fptr->Fptr)->tileanynull); + free((fptr->Fptr)->tiletype); + free((fptr->Fptr)->tiledatasize); + free((fptr->Fptr)->tilenullarray); + free((fptr->Fptr)->tiledata); + free((fptr->Fptr)->tilerow); + + (fptr->Fptr)->tileanynull = 0; + (fptr->Fptr)->tiletype = 0; + (fptr->Fptr)->tiledatasize = 0; + (fptr->Fptr)->tilenullarray = 0; + (fptr->Fptr)->tiledata = 0; + (fptr->Fptr)->tilerow = 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 */ + snprintf(message,FLEN_ERRMSG,"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 + + ( ((fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize + 2879) / 2880 * 2880 ); + + /* determine the byte offset to the beginning of each column */ + ffgtbc(fptr, &totalwidth, status); + + if (totalwidth != rowlen) + { + snprintf(message,FLEN_ERRMSG, + "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 { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message, FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "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. */ + /* If writemode has 16 added, then treat */ + /* TSTRING column as TBYTE vector */ + 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 - abs(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[FLEN_ERRMSG]; + 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 && writemode != 15) { + + /* 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 */ + { + snprintf(message,FLEN_ERRMSG, "Image group number is less than 1: %.0f", + (double) firstrow); + ffpmsg(message); + return(*status = BAD_ROW_NUM); + } + else + { + snprintf(message, FLEN_ERRMSG,"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) + { + snprintf(message, FLEN_ERRMSG,"Starting element number less than 1: %ld", + (long) firstelem); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + else if (nelem < 0) + { + snprintf(message, FLEN_ERRMSG,"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) + { + snprintf(message, FLEN_ERRMSG,"Specified column number is out of range: %d", + colnum); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG," 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: use writemode = 15,16,17,18 to interpret TSTRING columns + as TBYTE vectors instead (but not for ASCII tables). + writemode = 15 equivalent to writemode =-1 + writemode = 16 equivalent to writemode = 0 + writemode = 17 equivalent to writemode = 1 + writemode = 18 equivalent to writemode = 2 + */ + if (writemode >= 15 && writemode <= 18) { + + if (abs(*tcode) == TSTRING && *hdutype != ASCII_TBL ) { + *incre = 1; /* each element is 1 byte wide */ + if (*tcode < 0) *repeat = *twidth; /* variable columns appear to put width in *twidth */ + *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 (*tcode < 0) { + *tcode = -TBYTE; /* variable-length */ + } else { + *tcode = TBYTE; + } + } + + /* translate to the equivalent as listed above */ + writemode -= 16; + } + + /* 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) { + if (*twidth) + *repeat = *repeat / *twidth; /* repeat = # of unit strings in field */ + else + *repeat = 0; + } + 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) + { + if (*twidth) + *maxelem = (DBUFFSIZE - 1)/ *twidth; /* leave room for final \0 */ + else + *maxelem = DBUFFSIZE - 1; + + if (*maxelem == 0) { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message, FLEN_ERRMSG, + "Attempted to read from group %ld of the HDU,", (long) firstrow); + ffpmsg(message); + + snprintf(message, FLEN_ERRMSG, + "however the HDU only contains %ld group(s).", + (long) ((fptr->Fptr)->numrows) ); + ffpmsg(message); + } + else + { + ffpmsg("Attempt to read past end of array:"); + snprintf(message, FLEN_ERRMSG, + " Image has %ld elements;", (long) *repeat); + ffpmsg(message); + + snprintf(message, FLEN_ERRMSG, + " Tried to read %ld elements starting at element %ld.", + (long) nelem, (long) firstelem); + ffpmsg(message); + } + } + else + { + ffpmsg("Attempt to read past end of table:"); + snprintf(message, FLEN_ERRMSG, + " Table has %.0f rows with %.0f elements per row;", + (double) ((fptr->Fptr)->numrows), (double) *repeat); + ffpmsg(message); + + snprintf(message, FLEN_ERRMSG, + " 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. + */ + if (*rowlen <= LONG_MAX) { + *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) + { + snprintf(message,FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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"); + snprintf(message,FLEN_ERRMSG, + " 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) + { + snprintf(message,FLEN_ERRMSG, + "Starting element to read in variable length column is too large: %ld", + (long) firstelem); + ffpmsg(message); + snprintf(message,FLEN_ERRMSG, + " 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[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 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 ) + { + snprintf(message,FLEN_ERRMSG,"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 */ + snprintf(message,FLEN_ERRMSG, + "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[FLEN_ERRMSG]; + 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) ) + { + snprintf(message,FLEN_ERRMSG,"Failed to create temporary file for the heap"); + ffpmsg(message); + return(*status); + } + if ( ffcopy(fptr, tptr, 0, status) ) + { + snprintf(message,FLEN_ERRMSG,"Failed to create copy of the heap"); + ffpmsg(message); + ffclos(tptr, status); + return(*status); + } + + buffer = (char *) malloc(buffsize); /* allocate initial buffer */ + if (!buffer) + { + snprintf(message,FLEN_ERRMSG,"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 */ + { + snprintf(message,FLEN_ERRMSG, + "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 ii, stdriver, ntilebins; + + /* 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)->tilerow) { + + ntilebins = + (((fptr->Fptr)->znaxis[0] - 1) / ((fptr->Fptr)->tilesize[0])) + 1; + + for (ii = 0; ii < ntilebins; ii++) { + if ((fptr->Fptr)->tiledata[ii]) { + free((fptr->Fptr)->tiledata[ii]); + } + + if ((fptr->Fptr)->tilenullarray[ii]) { + free((fptr->Fptr)->tilenullarray[ii]); + } + } + + free((fptr->Fptr)->tileanynull); + free((fptr->Fptr)->tiletype); + free((fptr->Fptr)->tiledatasize); + free((fptr->Fptr)->tilenullarray); + free((fptr->Fptr)->tiledata); + free((fptr->Fptr)->tilerow); + + (fptr->Fptr)->tileanynull = 0; + (fptr->Fptr)->tiletype = 0; + (fptr->Fptr)->tiledatasize = 0; + (fptr->Fptr)->tilenullarray = 0; + (fptr->Fptr)->tiledata = 0; + (fptr->Fptr)->tilerow = 0; + } + } + } + + if (*status > 0 && *status != NO_CLOSE_ERROR) + { + snprintf(message,FLEN_ERRMSG, + "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, lenform=0; + 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) + { + snprintf(message,FLEN_ERRMSG, + "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; + lenform = strlen(tform); + + /* print as double, because the string-to-64-bit */ + /* conversion is platform dependent (%lld, %ld, %I64d) */ + + snprintf(lenval,40, "(%.0f)", (double) maxlen); + + if (lenform+strlen(lenval)+2 > FLEN_VALUE-1) + { + ffpmsg("Error assembling TFORMn string (ffuptf)."); + return(*status = BAD_TFORM); + } + strcat(newform, tform); + + 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 ) */ + + snprintf(valstring,FLEN_VALUE, "%.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 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;iFptr)->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_seed = (fptr->Fptr)->request_dither_seed; + } + + 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) */ + + snprintf(message,FLEN_ERRMSG, + "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(hduname, extname, 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(hduname, extname, 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 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 + ZQUANTIZ, ZDITHER0 + + 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 (FSTRNCMP (card1, "QUANTIZ", 7) == 0) + return (TYP_CMPRS_KEY); + else if (FSTRNCMP (card1, "DITHER0", 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(const 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 */ + *negative = 0; + 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 > 20) { + *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 { + *dtype = TULONGLONG; + } + } else if (len == 20) { + if (strcmp(p,"18446744073709551615") <= 0 ) { + *dtype = TULONGLONG; + } 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(const 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(const 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 ffc2uxx(const 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 */ + ULONGLONG *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') + ffc2ujj(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(const 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(const 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 ffc2uj(const char *cval, /* I - string representation of the value */ + ULONGLONG *ival, /* O - numerical value of the input string */ + int *status) /* IO - error status */ +/* + convert formatted string to a ULONGLONG 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 */ + ffc2uxx(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) DULONGLONG_MAX || dval < -0.49) + *status = NUM_OVERFLOW; + else + *ival = (ULONGLONG) dval; + } + } + else if (dtype == 'F') + { + if (dval > (double) DULONGLONG_MAX || dval < -0.49) + *status = NUM_OVERFLOW; + else + *ival = (ULONGLONG) dval; + } + else if (dtype == 'L') + { + *ival = (ULONGLONG) 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(const 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(const 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(const 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(const 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(const 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 = (char *) 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,23); + ffpmsg(msg); + + *status = NUM_OVERFLOW; + errno = 0; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2ujj(const char *cval, /* I - string representation of the value */ + ULONGLONG *ival, /* O - numerical value of the input string */ + int *status) /* IO - error status */ +/* + convert null-terminated formatted string to an unsigned 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 */ +/* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */ +/* !!!!! This needs to be modified to use the unsigned long long version of _atoi64 */ +/* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */ + + *ival = _atoi64(cval); + loc = (char *) 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 = strtoull(cval, &loc, 10); /* read the string as an integer */ +#else + *ival = strtoul(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 ffc2ujj converting string to unsigned longlong int: "); + strncat(msg,cval,25); + ffpmsg(msg); + + *status = NUM_OVERFLOW; + errno = 0; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2ll(const 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(const 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] != '\'') + { + if (instr[0] == '\0') { + outstr[0] = '\0'; + return(*status = VALUE_UNDEFINED); /* null value string */ + } else { + 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(const 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; + short *sptr, iret; + + 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 */ + if (strlen(cval) > 72) + { + strcpy(msg,"Error: Invalid string to float in ffc2rr"); + ffpmsg(msg); + return (*status=BAD_C2F); + } + 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; + } + + sptr = (short *) fval; +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr++; /* point to MSBs */ +#endif + iret = fnan(*sptr); /* if iret == 1, then the float value is a NaN */ + + if (errno == ERANGE || (iret == 1) ) + { + strcpy(msg,"Error in ffc2rr converting string to float: "); + strncat(msg,cval,30); + ffpmsg(msg); + *fval = 0.; + + *status = NUM_OVERFLOW; + errno = 0; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffc2dd(const 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; + short *sptr, iret; + + 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 */ + if (strlen(cval) > 72) + { + strcpy(msg,"Error: Invalid string to double in ffc2dd"); + ffpmsg(msg); + return (*status=BAD_C2D); + } + 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; + } + + sptr = (short *) dval; +#if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS + sptr += 3; /* point to MSBs */ +#endif + iret = dnan(*sptr); /* if iret == 1, then the double value is a NaN */ + + if (errno == ERANGE || (iret == 1) ) + { + strcpy(msg,"Error in ffc2dd converting string to double: "); + strncat(msg,cval,30); + ffpmsg(msg); + *dval = 0.; + + *status = NUM_OVERFLOW; + errno = 0; + } + + return(*status); +} + +/* ================================================================== */ +/* A hack for nonunix machines, which lack strcasecmp and strncasecmp */ +/* ================================================================== */ + +int fits_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 fits_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); +} +/* + * fits_recalloc - an allocator/reallocator in the style of calloc and realloc + * + * Allocates or reallocates storage upon request. Newly allocated + * storage is zeroed in the style of calloc. + * + * Cases handled are: + * ptr == 0 or old_num == 0 - use calloc to allocate new storage + * new_num = 0 - frees any storage if ptr is non-NULL + * new_num < old_num - uses realloc() to reduce storage allocated + * new_num > old_num - uses realloc() and sets newly allocated + * storage to zero (old portion left unchanged) + * + * void *ptr - "old" pointer, or NULL to allocate new storage + * size_t old_num - old number of records allocated + * size_t new_num - new number of records allocated + * size_t size - size of record in bytes + * + * RETURNS: newly allocated storage + * + * */ +void *fits_recalloc(void *ptr, size_t old_num, size_t new_num, size_t size) +{ + void *newptr; + + if (ptr == 0 || old_num == 0) { /* Starting from nothing */ + + return calloc(new_num, size); + + } else if (new_num == old_num) { /* Same size, do nothing */ + + return ptr; + + } else if (new_num == 0) { /* Freeing */ + + if (ptr) free(ptr); + return 0; + + } else if (new_num < old_num) { /* Shrinking */ + + newptr = realloc(ptr, new_num*size); + if (!newptr) free(ptr); + return (newptr); + } + + /* Growing */ + newptr = realloc(ptr, new_num*size); + if (!newptr) { + free(ptr); + return newptr; + } + + /* Zero the new portion of the array */ + memset( (char *) newptr + old_num*size/sizeof(char), 0, + (new_num - old_num)*size ); + return (newptr); +} + diff --git a/vendor/cfitsio/fitsio.h b/vendor/cfitsio/fitsio.h new file mode 100644 index 000000000..3bca703ed --- /dev/null +++ b/vendor/cfitsio/fitsio.h @@ -0,0 +1,2085 @@ +/* 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 4.2.0 +/* Minor and micro numbers must not exceed 99 under current method + of version representataion in ffvers(). */ +#define CFITSIO_MICRO 0 +#define CFITSIO_MINOR 2 +#define CFITSIO_MAJOR 4 +#define CFITSIO_SONAME 10 + +/* the SONAME is incremented in a new release if the binary shared */ +/* library (on linux and Mac systems) is not backward compatible */ +/* with the previous release of CFITSIO */ + + +/* CFITS_API is defined below for use on Windows systems. */ +/* It is used to identify the public functions which should be exported. */ +/* This has no effect on non-windows platforms where "WIN32" is not defined */ + +#if defined (WIN32) + #if defined(cfitsio_EXPORTS) + #define CFITS_API __declspec(dllexport) + #else + #define CFITS_API /* __declspec(dllimport) */ + #endif /* CFITS_API */ +#else /* defined (WIN32) */ + #define CFITS_API +#endif + +#include + +/* 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 /* apparently needed on debian linux systems */ +#endif /* to define off_t */ + +#include /* apparently needed to define size_t with gcc 2.8.1 */ +#include /* 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: "(defined(linux) && defined(__off_t_defined))" */ +/* the mingw-w64 compiler requires: "(defined(__MINGW32__) && defined(_OFF_T_DEFINED))" */ +#if defined(_OFF_T) \ + || (defined(linux) && defined(__off_t_defined)) \ + || (defined(__MINGW32__) && defined(_OFF_T_DEFINED)) \ + || defined(_MIPS_SZLONG) || defined(__APPLE__) || defined(_AIX) +# define OFF_T off_t +#elif defined(__BORLANDC__) || (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; + typedef unsigned __int64 ULONGLONG; + +#else /* newer versions do support 'long long' */ + typedef long long LONGLONG; + typedef unsigned long long ULONGLONG; + +#endif + +#elif defined( __BORLANDC__) /* for the Borland 5.5 compiler, in particular */ + typedef __int64 LONGLONG; + typedef unsigned __int64 ULONGLONG; +#else + typedef long long LONGLONG; + typedef unsigned long long ULONGLONG; +#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 75 /* 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 TULONGLONG 80 +#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 ULONGLONG_IMG 80 + +#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 codes */ +#define NO_DITHER -1 +#define SUBTRACTIVE_DITHER_1 1 +#define SUBTRACTIVE_DITHER_2 2 +#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 -1 + +#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 */ + int noextsyntax; /* flag for file opened with request to ignore extended syntax*/ + 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 */ + int startcol; /* used by ffgcnn to record starting column number */ + 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 */ + + /* these record the 'requested' options to be used when the image is compressed */ + int request_compress_type; /* requested image compression algorithm */ + long request_tilesize[MAX_COMPRESS_DIM]; /* requested tiling size */ + float request_quantize_level; /* requested quantize level */ + int request_quantize_method ; /* requested quantizing method */ + int request_dither_seed; /* starting offset into the array of random dithering */ + int request_lossy_int_compress; /* lossy compress integer image as if float image? */ + int request_huge_hdu; /* use '1Q' rather then '1P' variable length arrays */ + float request_hcomp_scale; /* requested HCOMPRESS scale factor */ + int request_hcomp_smooth; /* requested HCOMPRESS smooth parameter */ + + /* these record the actual options that were used when the image was compressed */ + int compress_type; /* type of compression algorithm */ + long tilesize[MAX_COMPRESS_DIM]; /* size of compression tiles */ + float quantize_level; /* floating point quantization level */ + int quantize_method; /* floating point pixel quantization algorithm */ + int dither_seed; /* starting offset into the array of random dithering */ + + /* other compression parameters */ + int compressimg; /* 1 if HDU contains a compressed image, else 0 */ + char zcmptype[12]; /* compression type string */ + int zbitpix; /* FITS data type of image (BITPIX) */ + int zndim; /* dimension of image */ + long znaxis[MAX_COMPRESS_DIM]; /* length of each axis */ + 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: Rice pixels/block */ + int rice_bytepix; /* 2nd compression parameter: Rice bytes/pixel */ + float hcomp_scale; /* 1st hcompress compression parameter */ + int hcomp_smooth; /* 2nd hcompress compression parameter */ + + int *tilerow; /* row number of the array of uncompressed tiledata */ + long *tiledatasize; /* length of the array of tile data in bytes */ + int *tiletype; /* datatype of the array of tile (TINT, TSHORT, etc) */ + void **tiledata; /* array of uncompressed tile of data, for row *tilerow */ + void **tilenullarray; /* array of optional array of null value flags */ + int *tileanynull; /* anynulls in the array of 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 */ +#define TemporaryCol 3 /* flag for temporary iterator column INTERNAL */ + +/*============================================================================= +* +* 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; + +/* 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 CFITS_API fits_read_wcstab(fitsfile *fptr, int nwtb, wtbarr *wtb, int *status); + +/* The following exclusion if __CINT__ is defined is needed for ROOT */ +#ifndef __CINT__ +#ifdef __cplusplus +} +#endif +#endif + +#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_NETTIMEOUT 117 /* bad value for file download timeout setting */ + +#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 ); +CFITS_API fitsfile* CUnit2FITS(int unit); + +/*---------------- FITS file URL parsing routines -------------*/ +int CFITS_API fits_get_token (char **ptr, char *delimiter, char *token, int *isanumber); +int CFITS_API fits_get_token2(char **ptr, char *delimiter, char **token, int *isanumber, int *status); +char CFITS_API *fits_split_names(char *list); +int CFITS_API ffiurl( char *url, char *urltype, char *infile, + char *outfile, char *extspec, char *rowfilter, + char *binspec, char *colspec, int *status); +int CFITS_API ffifile (char *url, char *urltype, char *infile, + char *outfile, char *extspec, char *rowfilter, + char *binspec, char *colspec, char *pixfilter, int *status); +int CFITS_API ffifile2 (char *url, char *urltype, char *infile, + char *outfile, char *extspec, char *rowfilter, + char *binspec, char *colspec, char *pixfilter, char *compspec, int *status); +int CFITS_API ffrtnm(char *url, char *rootname, int *status); +int CFITS_API ffexist(const char *infile, int *exists, int *status); +int CFITS_API ffexts(char *extspec, int *extnum, char *extname, int *extvers, + int *hdutype, char *colname, char *rowexpress, int *status); +int CFITS_API ffextn(char *url, int *extension_num, int *status); +int CFITS_API ffurlt(fitsfile *fptr, char *urlType, int *status); +int CFITS_API 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 CFITS_API ffbinr(char **binspec, char *colname, double *minin, + double *maxin, double *binsizein, char *minname, + char *maxname, char *binname, int *status); +int CFITS_API fits_copy_cell2image(fitsfile *fptr, fitsfile *newptr, char *colname, + long rownum, int *status); +int CFITS_API fits_copy_image2cell(fitsfile *fptr, fitsfile *newptr, char *colname, + long rownum, int copykeyflag, int *status); +int CFITS_API fits_copy_pixlist2image(fitsfile *infptr, fitsfile *outfptr, int firstkey, /* I - first HDU record number to start with */ + int naxis, int *colnum, int *status); +int CFITS_API ffimport_file( char *filename, char **contents, int *status ); +int CFITS_API ffrwrg( char *rowlist, LONGLONG maxrows, int maxranges, int *numranges, + long *minrow, long *maxrow, int *status); +int CFITS_API ffrwrgll( char *rowlist, LONGLONG maxrows, int maxranges, int *numranges, + LONGLONG *minrow, LONGLONG *maxrow, int *status); +/*---------------- FITS file I/O routines -------------*/ +int CFITS_API fits_init_cfitsio(void); +int CFITS_API 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 CFITS_API ffopen(fitsfile **fptr, const char *filename, int iomode, int *status); +int CFITS_API ffopentest(int soname, fitsfile **fptr, const char *filename, int iomode, int *status); + +int CFITS_API ffdopn(fitsfile **fptr, const char *filename, int iomode, int *status); +int CFITS_API ffeopn(fitsfile **fptr, const char *filename, int iomode, + char *extlist, int *hdutype, int *status); +int CFITS_API fftopn(fitsfile **fptr, const char *filename, int iomode, int *status); +int CFITS_API ffiopn(fitsfile **fptr, const char *filename, int iomode, int *status); +int CFITS_API ffdkopn(fitsfile **fptr, const char *filename, int iomode, int *status); +int CFITS_API ffreopen(fitsfile *openfptr, fitsfile **newfptr, int *status); +int CFITS_API ffinit( fitsfile **fptr, const char *filename, int *status); +int CFITS_API ffdkinit(fitsfile **fptr, const char *filename, int *status); +int CFITS_API ffimem(fitsfile **fptr, void **buffptr, + size_t *buffsize, size_t deltasize, + void *(*mem_realloc)(void *p, size_t newsize), + int *status); +int CFITS_API fftplt(fitsfile **fptr, const char *filename, const char *tempname, + int *status); +int CFITS_API ffflus(fitsfile *fptr, int *status); +int CFITS_API ffflsh(fitsfile *fptr, int clearbuf, int *status); +int CFITS_API ffclos(fitsfile *fptr, int *status); +int CFITS_API ffdelt(fitsfile *fptr, int *status); +int CFITS_API ffflnm(fitsfile *fptr, char *filename, int *status); +int CFITS_API ffflmd(fitsfile *fptr, int *filemode, int *status); +int CFITS_API fits_delete_iraf_file(const char *filename, int *status); + +/*---------------- utility routines -------------*/ + +float CFITS_API ffvers(float *version); +void CFITS_API ffupch(char *string); +void CFITS_API ffgerr(int status, char *errtext); +void CFITS_API ffpmsg(const char *err_message); +void CFITS_API ffpmrk(void); +int CFITS_API ffgmsg(char *err_message); +void CFITS_API ffcmsg(void); +void CFITS_API ffcmrk(void); +void CFITS_API ffrprt(FILE *stream, int status); +void CFITS_API ffcmps(char *templt, char *colname, int casesen, int *match, + int *exact); +int CFITS_API fftkey(const char *keyword, int *status); +int CFITS_API fftrec(char *card, int *status); +int CFITS_API ffnchk(fitsfile *fptr, int *status); +int CFITS_API ffkeyn(const char *keyroot, int value, char *keyname, int *status); +int CFITS_API ffnkey(int value, const char *keyroot, char *keyname, int *status); +int CFITS_API ffgkcl(char *card); +int CFITS_API ffdtyp(const char *cval, char *dtype, int *status); +int CFITS_API ffinttyp(char *cval, int *datatype, int *negative, int *status); +int CFITS_API ffpsvc(char *card, char *value, char *comm, int *status); +int CFITS_API ffgknm(char *card, char *name, int *length, int *status); +int CFITS_API ffgthd(char *tmplt, char *card, int *hdtype, int *status); +int CFITS_API ffmkky(const char *keyname, char *keyval, const char *comm, char *card, int *status); +int CFITS_API 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 CFITS_API 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 CFITS_API ffasfm(char *tform, int *datacode, long *width, int *decim, int *status); +int CFITS_API ffbnfm(char *tform, int *datacode, long *repeat, long *width, int *status); +int CFITS_API ffbnfmll(char *tform, int *datacode, LONGLONG *repeat, long *width, int *status); +int CFITS_API ffgabc(int tfields, char **tform, int space, long *rowlen, long *tbcol, + int *status); +int CFITS_API 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 CFITS_API ffmbyt(fitsfile *fptr, LONGLONG bytpos, int ignore_err, int *status); +/*----------------- write single keywords --------------*/ +int CFITS_API ffpky(fitsfile *fptr, int datatype, const char *keyname, void *value, + const char *comm, int *status); +int CFITS_API ffprec(fitsfile *fptr, const char *card, int *status); +int CFITS_API ffpcom(fitsfile *fptr, const char *comm, int *status); +int CFITS_API ffpunt(fitsfile *fptr, const char *keyname, const char *unit, int *status); +int CFITS_API ffphis(fitsfile *fptr, const char *history, int *status); +int CFITS_API ffpdat(fitsfile *fptr, int *status); +int CFITS_API ffverifydate(int year, int month, int day, int *status); +int CFITS_API ffgstm(char *timestr, int *timeref, int *status); +int CFITS_API ffgsdt(int *day, int *month, int *year, int *status); +int CFITS_API ffdt2s(int year, int month, int day, char *datestr, int *status); +int CFITS_API fftm2s(int year, int month, int day, int hour, int minute, double second, + int decimals, char *datestr, int *status); +int CFITS_API ffs2dt(char *datestr, int *year, int *month, int *day, int *status); +int CFITS_API ffs2tm(char *datestr, int *year, int *month, int *day, int *hour, + int *minute, double *second, int *status); +int CFITS_API ffpkyu(fitsfile *fptr, const char *keyname, const char *comm, int *status); +int CFITS_API ffpkys(fitsfile *fptr, const char *keyname, const char *value, const char *comm,int *status); +int CFITS_API ffpkls(fitsfile *fptr, const char *keyname, const char *value, const char *comm,int *status); +int CFITS_API ffplsw(fitsfile *fptr, int *status); +int CFITS_API ffpkyl(fitsfile *fptr, const char *keyname, int value, const char *comm, int *status); +int CFITS_API ffpkyj(fitsfile *fptr, const char *keyname, LONGLONG value, const char *comm, int *status); +int CFITS_API ffpkyuj(fitsfile *fptr, const char *keyname, ULONGLONG value, const char *comm, int *status); +int CFITS_API ffpkyf(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm, + int *status); +int CFITS_API ffpkye(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm, + int *status); +int CFITS_API ffpkyg(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm, + int *status); +int CFITS_API ffpkyd(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm, + int *status); +int CFITS_API ffpkyc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm, + int *status); +int CFITS_API ffpkym(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm, + int *status); +int CFITS_API ffpkfc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm, + int *status); +int CFITS_API ffpkfm(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm, + int *status); +int CFITS_API ffpkyt(fitsfile *fptr, const char *keyname, long intval, double frac, const char *comm, + int *status); +int CFITS_API ffptdm( fitsfile *fptr, int colnum, int naxis, long naxes[], int *status); +int CFITS_API ffptdmll( fitsfile *fptr, int colnum, int naxis, LONGLONG naxes[], int *status); + +/*----------------- write array of keywords --------------*/ +int CFITS_API ffpkns(fitsfile *fptr, const char *keyroot, int nstart, int nkey, char *value[], + char *comm[], int *status); +int CFITS_API ffpknl(fitsfile *fptr, const char *keyroot, int nstart, int nkey, int *value, + char *comm[], int *status); +int CFITS_API ffpknj(fitsfile *fptr, const char *keyroot, int nstart, int nkey, long *value, + char *comm[], int *status); +int CFITS_API ffpknjj(fitsfile *fptr, const char *keyroot, int nstart, int nkey, LONGLONG *value, + char *comm[], int *status); +int CFITS_API ffpknf(fitsfile *fptr, const char *keyroot, int nstart, int nkey, float *value, + int decim, char *comm[], int *status); +int CFITS_API ffpkne(fitsfile *fptr, const char *keyroot, int nstart, int nkey, float *value, + int decim, char *comm[], int *status); +int CFITS_API ffpkng(fitsfile *fptr, const char *keyroot, int nstart, int nkey, double *value, + int decim, char *comm[], int *status); +int CFITS_API ffpknd(fitsfile *fptr, const char *keyroot, int nstart, int nkey, double *value, + int decim, char *comm[], int *status); +int CFITS_API ffcpky(fitsfile *infptr,fitsfile *outfptr,int incol,int outcol, + char *rootname, int *status); + +/*----------------- write required header keywords --------------*/ +int CFITS_API ffphps( fitsfile *fptr, int bitpix, int naxis, long naxes[], int *status); +int CFITS_API ffphpsll( fitsfile *fptr, int bitpix, int naxis, LONGLONG naxes[], int *status); +int CFITS_API ffphpr( fitsfile *fptr, int simple, int bitpix, int naxis, long naxes[], + LONGLONG pcount, LONGLONG gcount, int extend, int *status); +int CFITS_API ffphprll( fitsfile *fptr, int simple, int bitpix, int naxis, LONGLONG naxes[], + LONGLONG pcount, LONGLONG gcount, int extend, int *status); +int CFITS_API ffphtb(fitsfile *fptr, LONGLONG naxis1, LONGLONG naxis2, int tfields, char **ttype, + long *tbcol, char **tform, char **tunit, const char *extname, int *status); +int CFITS_API ffphbn(fitsfile *fptr, LONGLONG naxis2, int tfields, char **ttype, + char **tform, char **tunit, const char *extname, LONGLONG pcount, int *status); +int CFITS_API ffphext( fitsfile *fptr, const char *xtension, int bitpix, int naxis, long naxes[], + LONGLONG pcount, LONGLONG gcount, int *status); +/*----------------- write template keywords --------------*/ +int CFITS_API ffpktp(fitsfile *fptr, const char *filename, int *status); + +/*------------------ get header information --------------*/ +int CFITS_API ffghsp(fitsfile *fptr, int *nexist, int *nmore, int *status); +int CFITS_API ffghps(fitsfile *fptr, int *nexist, int *position, int *status); + +/*------------------ move position in header -------------*/ +int CFITS_API ffmaky(fitsfile *fptr, int nrec, int *status); +int CFITS_API ffmrky(fitsfile *fptr, int nrec, int *status); + +/*------------------ read single keywords -----------------*/ +int CFITS_API ffgnxk(fitsfile *fptr, char **inclist, int ninc, char **exclist, + int nexc, char *card, int *status); +int CFITS_API ffgrec(fitsfile *fptr, int nrec, char *card, int *status); +int CFITS_API ffgcrd(fitsfile *fptr, const char *keyname, char *card, int *status); +int CFITS_API ffgstr(fitsfile *fptr, const char *string, char *card, int *status); +int CFITS_API ffgunt(fitsfile *fptr, const char *keyname, char *unit, int *status); +int CFITS_API ffgkyn(fitsfile *fptr, int nkey, char *keyname, char *keyval, char *comm, + int *status); +int CFITS_API ffgkey(fitsfile *fptr, const char *keyname, char *keyval, char *comm, + int *status); + +int CFITS_API ffgky( fitsfile *fptr, int datatype, const char *keyname, void *value, + char *comm, int *status); +int CFITS_API ffgkys(fitsfile *fptr, const char *keyname, char *value, char *comm, int *status); +int CFITS_API ffgksl(fitsfile *fptr, const char *keyname, int *length, int *status); +int CFITS_API ffgkls(fitsfile *fptr, const char *keyname, char **value, char *comm, int *status); +int CFITS_API ffgsky(fitsfile *fptr, const char *keyname, int firstchar, int maxchar, + char *value, int *valuelen, char *comm, int *status); +int CFITS_API fffree(void *value, int *status); +int CFITS_API fffkls(char *value, int *status); +int CFITS_API ffgkyl(fitsfile *fptr, const char *keyname, int *value, char *comm, int *status); +int CFITS_API ffgkyj(fitsfile *fptr, const char *keyname, long *value, char *comm, int *status); +int CFITS_API ffgkyjj(fitsfile *fptr, const char *keyname, LONGLONG *value, char *comm, int *status); +int CFITS_API ffgkyujj(fitsfile *fptr, const char *keyname, ULONGLONG *value, char *comm, int *status); +int CFITS_API ffgkye(fitsfile *fptr, const char *keyname, float *value, char *comm,int *status); +int CFITS_API ffgkyd(fitsfile *fptr, const char *keyname, double *value,char *comm,int *status); +int CFITS_API ffgkyc(fitsfile *fptr, const char *keyname, float *value, char *comm,int *status); +int CFITS_API ffgkym(fitsfile *fptr, const char *keyname, double *value,char *comm,int *status); +int CFITS_API ffgkyt(fitsfile *fptr, const char *keyname, long *ivalue, double *dvalue, + char *comm, int *status); +int CFITS_API ffgtdm(fitsfile *fptr, int colnum, int maxdim, int *naxis, long naxes[], + int *status); +int CFITS_API ffgtdmll(fitsfile *fptr, int colnum, int maxdim, int *naxis, LONGLONG naxes[], + int *status); +int CFITS_API ffdtdm(fitsfile *fptr, char *tdimstr, int colnum, int maxdim, + int *naxis, long naxes[], int *status); +int CFITS_API ffdtdmll(fitsfile *fptr, char *tdimstr, int colnum, int maxdim, + int *naxis, LONGLONG naxes[], int *status); + +/*------------------ read array of keywords -----------------*/ +int CFITS_API ffgkns(fitsfile *fptr, const char *keyname, int nstart, int nmax, char *value[], + int *nfound, int *status); +int CFITS_API ffgknl(fitsfile *fptr, const char *keyname, int nstart, int nmax, int *value, + int *nfound, int *status); +int CFITS_API ffgknj(fitsfile *fptr, const char *keyname, int nstart, int nmax, long *value, + int *nfound, int *status); +int CFITS_API ffgknjj(fitsfile *fptr, const char *keyname, int nstart, int nmax, LONGLONG *value, + int *nfound, int *status); +int CFITS_API ffgkne(fitsfile *fptr, const char *keyname, int nstart, int nmax, float *value, + int *nfound, int *status); +int CFITS_API ffgknd(fitsfile *fptr, const char *keyname, int nstart, int nmax, double *value, + int *nfound, int *status); +int CFITS_API ffh2st(fitsfile *fptr, char **header, int *status); +int CFITS_API ffhdr2str( fitsfile *fptr, int exclude_comm, char **exclist, + int nexc, char **header, int *nkeys, int *status); +int CFITS_API ffcnvthdr2str( fitsfile *fptr, int exclude_comm, char **exclist, + int nexc, char **header, int *nkeys, int *status); + +/*----------------- read required header keywords --------------*/ +int CFITS_API ffghpr(fitsfile *fptr, int maxdim, int *simple, int *bitpix, int *naxis, + long naxes[], long *pcount, long *gcount, int *extend, int *status); + +int CFITS_API ffghprll(fitsfile *fptr, int maxdim, int *simple, int *bitpix, int *naxis, + LONGLONG naxes[], long *pcount, long *gcount, int *extend, int *status); + +int CFITS_API ffghtb(fitsfile *fptr,int maxfield, long *naxis1, long *naxis2, + int *tfields, char **ttype, long *tbcol, char **tform, char **tunit, + char *extname, int *status); + +int CFITS_API ffghtbll(fitsfile *fptr,int maxfield, LONGLONG *naxis1, LONGLONG *naxis2, + int *tfields, char **ttype, LONGLONG *tbcol, char **tform, char **tunit, + char *extname, int *status); + + +int CFITS_API ffghbn(fitsfile *fptr, int maxfield, long *naxis2, int *tfields, + char **ttype, char **tform, char **tunit, char *extname, + long *pcount, int *status); + +int CFITS_API ffghbnll(fitsfile *fptr, int maxfield, LONGLONG *naxis2, int *tfields, + char **ttype, char **tform, char **tunit, char *extname, + LONGLONG *pcount, int *status); + +/*--------------------- update keywords ---------------*/ +int CFITS_API ffuky(fitsfile *fptr, int datatype, const char *keyname, void *value, + const char *comm, int *status); +int CFITS_API ffucrd(fitsfile *fptr, const char *keyname, const char *card, int *status); +int CFITS_API ffukyu(fitsfile *fptr, const char *keyname, const char *comm, int *status); +int CFITS_API ffukys(fitsfile *fptr, const char *keyname, const char *value, const char *comm, int *status); +int CFITS_API ffukls(fitsfile *fptr, const char *keyname, const char *value, const char *comm, int *status); +int CFITS_API ffukyl(fitsfile *fptr, const char *keyname, int value, const char *comm, int *status); +int CFITS_API ffukyj(fitsfile *fptr, const char *keyname, LONGLONG value, const char *comm, int *status); +int CFITS_API ffukyf(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm, + int *status); +int CFITS_API ffukye(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm, + int *status); +int CFITS_API ffukyg(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm, + int *status); +int CFITS_API ffukyd(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm, + int *status); +int CFITS_API ffukyc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm, + int *status); +int CFITS_API ffukym(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm, + int *status); +int CFITS_API ffukfc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm, + int *status); +int CFITS_API ffukfm(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm, + int *status); + +/*--------------------- modify keywords ---------------*/ +int CFITS_API ffmrec(fitsfile *fptr, int nkey, const char *card, int *status); +int CFITS_API ffmcrd(fitsfile *fptr, const char *keyname, const char *card, int *status); +int CFITS_API ffmnam(fitsfile *fptr, const char *oldname, const char *newname, int *status); +int CFITS_API ffmcom(fitsfile *fptr, const char *keyname, const char *comm, int *status); +int CFITS_API ffmkyu(fitsfile *fptr, const char *keyname, const char *comm, int *status); +int CFITS_API ffmkys(fitsfile *fptr, const char *keyname, const char *value, const char *comm,int *status); +int CFITS_API ffmkls(fitsfile *fptr, const char *keyname, const char *value, const char *comm,int *status); +int CFITS_API ffmkyl(fitsfile *fptr, const char *keyname, int value, const char *comm, int *status); +int CFITS_API ffmkyj(fitsfile *fptr, const char *keyname, LONGLONG value, const char *comm, int *status); +int CFITS_API ffmkyf(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm, + int *status); +int CFITS_API ffmkye(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm, + int *status); +int CFITS_API ffmkyg(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm, + int *status); +int CFITS_API ffmkyd(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm, + int *status); +int CFITS_API ffmkyc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm, + int *status); +int CFITS_API ffmkym(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm, + int *status); +int CFITS_API ffmkfc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm, + int *status); +int CFITS_API ffmkfm(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm, + int *status); + +/*--------------------- insert keywords ---------------*/ +int CFITS_API ffirec(fitsfile *fptr, int nkey, const char *card, int *status); +int CFITS_API ffikey(fitsfile *fptr, const char *card, int *status); +int CFITS_API ffikyu(fitsfile *fptr, const char *keyname, const char *comm, int *status); +int CFITS_API ffikys(fitsfile *fptr, const char *keyname, const char *value, const char *comm,int *status); +int CFITS_API ffikls(fitsfile *fptr, const char *keyname, const char *value, const char *comm,int *status); +int CFITS_API ffikyl(fitsfile *fptr, const char *keyname, int value, const char *comm, int *status); +int CFITS_API ffikyj(fitsfile *fptr, const char *keyname, LONGLONG value, const char *comm, int *status); +int CFITS_API ffikyf(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm, + int *status); +int CFITS_API ffikye(fitsfile *fptr, const char *keyname, float value, int decim, const char *comm, + int *status); +int CFITS_API ffikyg(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm, + int *status); +int CFITS_API ffikyd(fitsfile *fptr, const char *keyname, double value, int decim, const char *comm, + int *status); +int CFITS_API ffikyc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm, + int *status); +int CFITS_API ffikym(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm, + int *status); +int CFITS_API ffikfc(fitsfile *fptr, const char *keyname, float *value, int decim, const char *comm, + int *status); +int CFITS_API ffikfm(fitsfile *fptr, const char *keyname, double *value, int decim, const char *comm, + int *status); + +/*--------------------- delete keywords ---------------*/ +int CFITS_API ffdkey(fitsfile *fptr, const char *keyname, int *status); +int CFITS_API ffdstr(fitsfile *fptr, const char *string, int *status); +int CFITS_API ffdrec(fitsfile *fptr, int keypos, int *status); + +/*--------------------- get HDU information -------------*/ +int CFITS_API ffghdn(fitsfile *fptr, int *chdunum); +int CFITS_API ffghdt(fitsfile *fptr, int *exttype, int *status); +int CFITS_API ffghad(fitsfile *fptr, long *headstart, long *datastart, long *dataend, + int *status); +int CFITS_API ffghadll(fitsfile *fptr, LONGLONG *headstart, LONGLONG *datastart, + LONGLONG *dataend, int *status); +int CFITS_API ffghof(fitsfile *fptr, OFF_T *headstart, OFF_T *datastart, OFF_T *dataend, + int *status); +int CFITS_API ffgipr(fitsfile *fptr, int maxaxis, int *imgtype, int *naxis, + long *naxes, int *status); +int CFITS_API ffgiprll(fitsfile *fptr, int maxaxis, int *imgtype, int *naxis, + LONGLONG *naxes, int *status); +int CFITS_API ffgidt(fitsfile *fptr, int *imgtype, int *status); +int CFITS_API ffgiet(fitsfile *fptr, int *imgtype, int *status); +int CFITS_API ffgidm(fitsfile *fptr, int *naxis, int *status); +int CFITS_API ffgisz(fitsfile *fptr, int nlen, long *naxes, int *status); +int CFITS_API ffgiszll(fitsfile *fptr, int nlen, LONGLONG *naxes, int *status); + +/*--------------------- HDU operations -------------*/ +int CFITS_API ffmahd(fitsfile *fptr, int hdunum, int *exttype, int *status); +int CFITS_API ffmrhd(fitsfile *fptr, int hdumov, int *exttype, int *status); +int CFITS_API ffmnhd(fitsfile *fptr, int exttype, char *hduname, int hduvers, + int *status); +int CFITS_API ffthdu(fitsfile *fptr, int *nhdu, int *status); +int CFITS_API ffcrhd(fitsfile *fptr, int *status); +int CFITS_API ffcrim(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status); +int CFITS_API ffcrimll(fitsfile *fptr, int bitpix, int naxis, LONGLONG *naxes, int *status); +int CFITS_API ffcrtb(fitsfile *fptr, int tbltype, LONGLONG naxis2, int tfields, char **ttype, + char **tform, char **tunit, const char *extname, int *status); +int CFITS_API ffiimg(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status); +int CFITS_API ffiimgll(fitsfile *fptr, int bitpix, int naxis, LONGLONG *naxes, int *status); +int CFITS_API ffitab(fitsfile *fptr, LONGLONG naxis1, LONGLONG naxis2, int tfields, char **ttype, + long *tbcol, char **tform, char **tunit, const char *extname, int *status); +int CFITS_API ffibin(fitsfile *fptr, LONGLONG naxis2, int tfields, char **ttype, char **tform, + char **tunit, const char *extname, LONGLONG pcount, int *status); +int CFITS_API ffrsim(fitsfile *fptr, int bitpix, int naxis, long *naxes, int *status); +int CFITS_API ffrsimll(fitsfile *fptr, int bitpix, int naxis, LONGLONG *naxes, int *status); +int CFITS_API ffdhdu(fitsfile *fptr, int *hdutype, int *status); +int CFITS_API ffcopy(fitsfile *infptr, fitsfile *outfptr, int morekeys, int *status); +int CFITS_API ffcpfl(fitsfile *infptr, fitsfile *outfptr, int prev, int cur, int follow, + int *status); +int CFITS_API ffcphd(fitsfile *infptr, fitsfile *outfptr, int *status); +int CFITS_API ffcpdt(fitsfile *infptr, fitsfile *outfptr, int *status); +int CFITS_API ffchfl(fitsfile *fptr, int *status); +int CFITS_API ffcdfl(fitsfile *fptr, int *status); +int CFITS_API ffwrhdu(fitsfile *fptr, FILE *outstream, int *status); + +int CFITS_API ffrdef(fitsfile *fptr, int *status); +int CFITS_API ffrhdu(fitsfile *fptr, int *hdutype, int *status); +int CFITS_API ffhdef(fitsfile *fptr, int morekeys, int *status); +int CFITS_API ffpthp(fitsfile *fptr, long theap, int *status); + +int CFITS_API ffcsum(fitsfile *fptr, long nrec, unsigned long *sum, int *status); +void CFITS_API ffesum(unsigned long sum, int complm, char *ascii); +unsigned long CFITS_API ffdsum(char *ascii, int complm, unsigned long *sum); +int CFITS_API ffpcks(fitsfile *fptr, int *status); +int CFITS_API ffupck(fitsfile *fptr, int *status); +int CFITS_API ffvcks(fitsfile *fptr, int *datastatus, int *hdustatus, int *status); +int CFITS_API ffgcks(fitsfile *fptr, unsigned long *datasum, unsigned long *hdusum, + int *status); + +/*--------------------- define scaling or null values -------------*/ +int CFITS_API ffpscl(fitsfile *fptr, double scale, double zeroval, int *status); +int CFITS_API ffpnul(fitsfile *fptr, LONGLONG nulvalue, int *status); +int CFITS_API fftscl(fitsfile *fptr, int colnum, double scale, double zeroval, int *status); +int CFITS_API fftnul(fitsfile *fptr, int colnum, LONGLONG nulvalue, int *status); +int CFITS_API ffsnul(fitsfile *fptr, int colnum, char *nulstring, int *status); + +/*--------------------- get column information -------------*/ +int CFITS_API ffgcno(fitsfile *fptr, int casesen, char *templt, int *colnum, + int *status); +int CFITS_API ffgcnn(fitsfile *fptr, int casesen, char *templt, char *colname, + int *colnum, int *status); + +int CFITS_API ffgtcl(fitsfile *fptr, int colnum, int *typecode, long *repeat, + long *width, int *status); +int CFITS_API ffgtclll(fitsfile *fptr, int colnum, int *typecode, LONGLONG *repeat, + LONGLONG *width, int *status); +int CFITS_API ffeqty(fitsfile *fptr, int colnum, int *typecode, long *repeat, + long *width, int *status); +int CFITS_API ffeqtyll(fitsfile *fptr, int colnum, int *typecode, LONGLONG *repeat, + LONGLONG *width, int *status); +int CFITS_API ffgncl(fitsfile *fptr, int *ncols, int *status); +int CFITS_API ffgnrw(fitsfile *fptr, long *nrows, int *status); +int CFITS_API ffgnrwll(fitsfile *fptr, LONGLONG *nrows, int *status); +int CFITS_API ffgacl(fitsfile *fptr, int colnum, char *ttype, long *tbcol, + char *tunit, char *tform, double *tscal, double *tzero, + char *tnull, char *tdisp, int *status); +int CFITS_API ffgbcl(fitsfile *fptr, int colnum, char *ttype, char *tunit, + char *dtype, long *repeat, double *tscal, double *tzero, + long *tnull, char *tdisp, int *status); +int CFITS_API ffgbclll(fitsfile *fptr, int colnum, char *ttype, char *tunit, + char *dtype, LONGLONG *repeat, double *tscal, double *tzero, + LONGLONG *tnull, char *tdisp, int *status); +int CFITS_API ffgrsz(fitsfile *fptr, long *nrows, int *status); +int CFITS_API ffgcdw(fitsfile *fptr, int colnum, int *width, int *status); + +/*--------------------- read primary array or image elements -------------*/ +int CFITS_API ffgpxv(fitsfile *fptr, int datatype, long *firstpix, LONGLONG nelem, + void *nulval, void *array, int *anynul, int *status); +int CFITS_API ffgpxvll(fitsfile *fptr, int datatype, LONGLONG *firstpix, LONGLONG nelem, + void *nulval, void *array, int *anynul, int *status); +int CFITS_API ffgpxf(fitsfile *fptr, int datatype, long *firstpix, LONGLONG nelem, + void *array, char *nullarray, int *anynul, int *status); +int CFITS_API ffgpxfll(fitsfile *fptr, int datatype, LONGLONG *firstpix, LONGLONG nelem, + void *array, char *nullarray, int *anynul, int *status); +int CFITS_API ffgsv(fitsfile *fptr, int datatype, long *blc, long *trc, long *inc, + void *nulval, void *array, int *anynul, int *status); + +int CFITS_API ffgpv(fitsfile *fptr, int datatype, LONGLONG firstelem, LONGLONG nelem, + void *nulval, void *array, int *anynul, int *status); +int CFITS_API ffgpf(fitsfile *fptr, int datatype, LONGLONG firstelem, LONGLONG nelem, + void *array, char *nullarray, int *anynul, int *status); +int CFITS_API ffgpvb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, unsigned + char nulval, unsigned char *array, int *anynul, int *status); +int CFITS_API ffgpvsb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, signed + char nulval, signed char *array, int *anynul, int *status); +int CFITS_API ffgpvui(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned short nulval, unsigned short *array, int *anynul, + int *status); +int CFITS_API ffgpvi(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + short nulval, short *array, int *anynul, int *status); +int CFITS_API ffgpvuj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned long nulval, unsigned long *array, int *anynul, + int *status); +int CFITS_API ffgpvj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + long nulval, long *array, int *anynul, int *status); +int CFITS_API ffgpvujj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + ULONGLONG nulval, ULONGLONG *array, int *anynul, int *status); +int CFITS_API ffgpvjj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + LONGLONG nulval, LONGLONG *array, int *anynul, int *status); +int CFITS_API ffgpvuk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned int nulval, unsigned int *array, int *anynul, int *status); +int CFITS_API ffgpvk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + int nulval, int *array, int *anynul, int *status); +int CFITS_API ffgpve(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + float nulval, float *array, int *anynul, int *status); +int CFITS_API ffgpvd(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + double nulval, double *array, int *anynul, int *status); + +int CFITS_API ffgpfb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned char *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfsb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + signed char *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfui(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned short *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfi(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + short *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfuj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned long *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + long *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfujj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + ULONGLONG *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfjj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + LONGLONG *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfuk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned int *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + int *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfe(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + float *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgpfd(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + double *array, char *nularray, int *anynul, int *status); + +int CFITS_API ffg2db(fitsfile *fptr, long group, unsigned char nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, unsigned char *array, + int *anynul, int *status); +int CFITS_API ffg2dsb(fitsfile *fptr, long group, signed char nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, signed char *array, + int *anynul, int *status); +int CFITS_API ffg2dui(fitsfile *fptr, long group, unsigned short nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, unsigned short *array, + int *anynul, int *status); +int CFITS_API ffg2di(fitsfile *fptr, long group, short nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, short *array, + int *anynul, int *status); +int CFITS_API ffg2duj(fitsfile *fptr, long group, unsigned long nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, unsigned long *array, + int *anynul, int *status); +int CFITS_API ffg2dj(fitsfile *fptr, long group, long nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, long *array, + int *anynul, int *status); +int CFITS_API ffg2dujj(fitsfile *fptr, long group, ULONGLONG nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, ULONGLONG *array, + int *anynul, int *status); +int CFITS_API ffg2djj(fitsfile *fptr, long group, LONGLONG nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, LONGLONG *array, + int *anynul, int *status); +int CFITS_API ffg2duk(fitsfile *fptr, long group, unsigned int nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, unsigned int *array, + int *anynul, int *status); +int CFITS_API ffg2dk(fitsfile *fptr, long group, int nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, int *array, + int *anynul, int *status); +int CFITS_API ffg2de(fitsfile *fptr, long group, float nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, float *array, + int *anynul, int *status); +int CFITS_API ffg2dd(fitsfile *fptr, long group, double nulval, LONGLONG ncols, + LONGLONG naxis1, LONGLONG naxis2, double *array, + int *anynul, int *status); + +int CFITS_API 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 CFITS_API 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 CFITS_API 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 CFITS_API ffg3di(fitsfile *fptr, long group, short nulval, LONGLONG ncols, + LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3, + short *array, int *anynul, int *status); +int CFITS_API 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 CFITS_API ffg3dj(fitsfile *fptr, long group, long nulval, LONGLONG ncols, + LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3, + long *array, int *anynul, int *status); +int CFITS_API ffg3dujj(fitsfile *fptr, long group, ULONGLONG nulval, LONGLONG ncols, + LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3, + ULONGLONG *array, int *anynul, int *status); +int CFITS_API ffg3djj(fitsfile *fptr, long group, LONGLONG nulval, LONGLONG ncols, + LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3, + LONGLONG *array, int *anynul, int *status); +int CFITS_API 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 CFITS_API ffg3dk(fitsfile *fptr, long group, int nulval, LONGLONG ncols, + LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3, + int *array, int *anynul, int *status); +int CFITS_API ffg3de(fitsfile *fptr, long group, float nulval, LONGLONG ncols, + LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3, + float *array, int *anynul, int *status); +int CFITS_API ffg3dd(fitsfile *fptr, long group, double nulval, LONGLONG ncols, + LONGLONG nrows, LONGLONG naxis1, LONGLONG naxis2, LONGLONG naxis3, + double *array, int *anynul, int *status); + +int CFITS_API 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 CFITS_API 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 CFITS_API 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 CFITS_API ffgsvi(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, short nulval, short *array, int *anynul, int *status); +int CFITS_API 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 CFITS_API ffgsvj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, long nulval, long *array, int *anynul, int *status); +int CFITS_API ffgsvujj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, ULONGLONG nulval, ULONGLONG *array, int *anynul, + int *status); +int CFITS_API ffgsvjj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, LONGLONG nulval, LONGLONG *array, int *anynul, + int *status); +int CFITS_API 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 CFITS_API ffgsvk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, int nulval, int *array, int *anynul, int *status); +int CFITS_API ffgsve(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, float nulval, float *array, int *anynul, int *status); +int CFITS_API ffgsvd(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, double nulval, double *array, int *anynul, + int *status); + +int CFITS_API 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 CFITS_API 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 CFITS_API 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 CFITS_API ffgsfi(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, short *array, char *flagval, int *anynul, int *status); +int CFITS_API 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 CFITS_API ffgsfj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, long *array, char *flagval, int *anynul, int *status); +int CFITS_API ffgsfujj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, ULONGLONG *array, char *flagval, int *anynul, + int *status); +int CFITS_API ffgsfjj(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, LONGLONG *array, char *flagval, int *anynul, + int *status); +int CFITS_API 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 CFITS_API ffgsfk(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, int *array, char *flagval, int *anynul, int *status); +int CFITS_API ffgsfe(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, float *array, char *flagval, int *anynul, int *status); +int CFITS_API ffgsfd(fitsfile *fptr, int colnum, int naxis, long *naxes, long *blc, + long *trc, long *inc, double *array, char *flagval, int *anynul, + int *status); + +int CFITS_API ffggpb(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned char *array, int *status); +int CFITS_API ffggpsb(fitsfile *fptr, long group, long firstelem, long nelem, + signed char *array, int *status); +int CFITS_API ffggpui(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned short *array, int *status); +int CFITS_API ffggpi(fitsfile *fptr, long group, long firstelem, long nelem, + short *array, int *status); +int CFITS_API ffggpuj(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned long *array, int *status); +int CFITS_API ffggpj(fitsfile *fptr, long group, long firstelem, long nelem, + long *array, int *status); +int CFITS_API ffggpujj(fitsfile *fptr, long group, long firstelem, long nelem, + ULONGLONG *array, int *status); +int CFITS_API ffggpjj(fitsfile *fptr, long group, long firstelem, long nelem, + LONGLONG *array, int *status); +int CFITS_API ffggpuk(fitsfile *fptr, long group, long firstelem, long nelem, + unsigned int *array, int *status); +int CFITS_API ffggpk(fitsfile *fptr, long group, long firstelem, long nelem, + int *array, int *status); +int CFITS_API ffggpe(fitsfile *fptr, long group, long firstelem, long nelem, + float *array, int *status); +int CFITS_API ffggpd(fitsfile *fptr, long group, long firstelem, long nelem, + double *array, int *status); + +/*--------------------- read column elements -------------*/ +int CFITS_API ffgcv( fitsfile *fptr, int datatype, int colnum, LONGLONG firstrow, + LONGLONG firstelem, LONGLONG nelem, void *nulval, void *array, int *anynul, + int *status); +int CFITS_API ffgcvn (fitsfile *fptr, int ncols, int *datatype, int *colnum, LONGLONG firstrow, + LONGLONG nrows, void **nulval, void **array, int *anynul, int *status); +int CFITS_API ffgcf( fitsfile *fptr, int datatype, int colnum, LONGLONG firstrow, + LONGLONG firstelem, LONGLONG nelem, void *array, char *nullarray, + int *anynul, int *status); +int CFITS_API ffgcvs(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, char *nulval, char **array, int *anynul, int *status); +int CFITS_API ffgcl (fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, char *array, int *status); +int CFITS_API ffgcvl (fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, char nulval, char *array, int *anynul, int *status); +int CFITS_API ffgcvb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned char nulval, unsigned char *array, + int *anynul, int *status); +int CFITS_API ffgcvsb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, signed char nulval, signed char *array, + int *anynul, int *status); +int CFITS_API ffgcvui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned short nulval, unsigned short *array, + int *anynul, int *status); +int CFITS_API ffgcvi(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, short nulval, short *array, int *anynul, int *status); +int CFITS_API ffgcvuj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned long nulval, unsigned long *array, int *anynul, + int *status); +int CFITS_API ffgcvj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, long nulval, long *array, int *anynul, int *status); +int CFITS_API ffgcvujj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, ULONGLONG nulval, ULONGLONG *array, int *anynul, + int *status); +int CFITS_API ffgcvjj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, LONGLONG nulval, LONGLONG *array, int *anynul, + int *status); +int CFITS_API ffgcvuk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned int nulval, unsigned int *array, int *anynul, + int *status); +int CFITS_API ffgcvk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, int nulval, int *array, int *anynul, int *status); +int CFITS_API ffgcve(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, float nulval, float *array, int *anynul, int *status); +int CFITS_API ffgcvd(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, double nulval, double *array, int *anynul, int *status); +int CFITS_API ffgcvc(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, float nulval, float *array, int *anynul, int *status); +int CFITS_API ffgcvm(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, double nulval, double *array, int *anynul, int *status); + +int CFITS_API ffgcx(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstbit, + LONGLONG nbits, char *larray, int *status); +int CFITS_API ffgcxui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG nrows, + long firstbit, int nbits, unsigned short *array, int *status); +int CFITS_API ffgcxuk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG nrows, + long firstbit, int nbits, unsigned int *array, int *status); + +int CFITS_API ffgcfs(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, char **array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfl(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, char *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned char *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfsb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, signed char *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned short *array, char *nularray, int *anynul, + int *status); +int CFITS_API ffgcfi(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, short *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfuj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned long *array, char *nularray, int *anynul, + int *status); +int CFITS_API ffgcfj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, long *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfujj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, ULONGLONG *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfjj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, LONGLONG *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfuk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned int *array, char *nularray, int *anynul, + int *status); +int CFITS_API ffgcfk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, int *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfe(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, float *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfd(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, double *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfc(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, float *array, char *nularray, int *anynul, int *status); +int CFITS_API ffgcfm(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, double *array, char *nularray, int *anynul, int *status); + +int CFITS_API ffgdes(fitsfile *fptr, int colnum, LONGLONG rownum, long *length, + long *heapaddr, int *status); +int CFITS_API ffgdesll(fitsfile *fptr, int colnum, LONGLONG rownum, LONGLONG *length, + LONGLONG *heapaddr, int *status); +int CFITS_API ffgdess(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG nrows, long *length, + long *heapaddr, int *status); +int CFITS_API ffgdessll(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG nrows, LONGLONG *length, + LONGLONG *heapaddr, int *status); +int CFITS_API ffpdes(fitsfile *fptr, int colnum, LONGLONG rownum, LONGLONG length, + LONGLONG heapaddr, int *status); +int CFITS_API fftheap(fitsfile *fptr, LONGLONG *heapsize, LONGLONG *unused, LONGLONG *overlap, + int *valid, int *status); +int CFITS_API ffcmph(fitsfile *fptr, int *status); + +int CFITS_API ffgtbb(fitsfile *fptr, LONGLONG firstrow, LONGLONG firstchar, LONGLONG nchars, + unsigned char *values, int *status); + +int CFITS_API ffgextn(fitsfile *fptr, LONGLONG offset, LONGLONG nelem, void *array, int *status); +int CFITS_API ffpextn(fitsfile *fptr, LONGLONG offset, LONGLONG nelem, void *array, int *status); + +/*------------ write primary array or image elements -------------*/ +int CFITS_API ffppx(fitsfile *fptr, int datatype, long *firstpix, LONGLONG nelem, + void *array, int *status); +int CFITS_API ffppxll(fitsfile *fptr, int datatype, LONGLONG *firstpix, LONGLONG nelem, + void *array, int *status); +int CFITS_API ffppxn(fitsfile *fptr, int datatype, long *firstpix, LONGLONG nelem, + void *array, void *nulval, int *status); +int CFITS_API ffppxnll(fitsfile *fptr, int datatype, LONGLONG *firstpix, LONGLONG nelem, + void *array, void *nulval, int *status); +int CFITS_API ffppr(fitsfile *fptr, int datatype, LONGLONG firstelem, + LONGLONG nelem, void *array, int *status); +int CFITS_API ffpprb(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, unsigned char *array, int *status); +int CFITS_API ffpprsb(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, signed char *array, int *status); +int CFITS_API ffpprui(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, unsigned short *array, int *status); +int CFITS_API ffppri(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, short *array, int *status); +int CFITS_API ffppruj(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, unsigned long *array, int *status); +int CFITS_API ffpprj(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, long *array, int *status); +int CFITS_API ffppruk(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, unsigned int *array, int *status); +int CFITS_API ffpprk(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, int *array, int *status); +int CFITS_API ffppre(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, float *array, int *status); +int CFITS_API ffpprd(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, double *array, int *status); +int CFITS_API ffpprjj(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, LONGLONG *array, int *status); +int CFITS_API ffpprujj(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, ULONGLONG *array, int *status); + +int CFITS_API ffppru(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + int *status); +int CFITS_API ffpprn(fitsfile *fptr, LONGLONG firstelem, LONGLONG nelem, int *status); + +int CFITS_API ffppn(fitsfile *fptr, int datatype, LONGLONG firstelem, LONGLONG nelem, + void *array, void *nulval, int *status); +int CFITS_API ffppnb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned char *array, unsigned char nulval, int *status); +int CFITS_API ffppnsb(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + signed char *array, signed char nulval, int *status); +int CFITS_API ffppnui(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, unsigned short *array, unsigned short nulval, + int *status); +int CFITS_API ffppni(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, short *array, short nulval, int *status); +int CFITS_API ffppnj(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, long *array, long nulval, int *status); +int CFITS_API ffppnuj(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned long *array, unsigned long nulval, int *status); +int CFITS_API ffppnuk(fitsfile *fptr, long group, LONGLONG firstelem, LONGLONG nelem, + unsigned int *array, unsigned int nulval, int *status); +int CFITS_API ffppnk(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, int *array, int nulval, int *status); +int CFITS_API ffppne(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, float *array, float nulval, int *status); +int CFITS_API ffppnd(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, double *array, double nulval, int *status); +int CFITS_API ffppnjj(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, LONGLONG *array, LONGLONG nulval, int *status); +int CFITS_API ffppnujj(fitsfile *fptr, long group, LONGLONG firstelem, + LONGLONG nelem, ULONGLONG *array, ULONGLONG nulval, int *status); + +int CFITS_API ffp2db(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, unsigned char *array, int *status); +int CFITS_API ffp2dsb(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, signed char *array, int *status); +int CFITS_API ffp2dui(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, unsigned short *array, int *status); +int CFITS_API ffp2di(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, short *array, int *status); +int CFITS_API ffp2duj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, unsigned long *array, int *status); +int CFITS_API ffp2dj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, long *array, int *status); +int CFITS_API ffp2duk(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, unsigned int *array, int *status); +int CFITS_API ffp2dk(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, int *array, int *status); +int CFITS_API ffp2de(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, float *array, int *status); +int CFITS_API ffp2dd(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, double *array, int *status); +int CFITS_API ffp2djj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG *array, int *status); +int CFITS_API ffp2dujj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG naxis1, + LONGLONG naxis2, ULONGLONG *array, int *status); + +int CFITS_API ffp3db(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, unsigned char *array, int *status); +int CFITS_API ffp3dsb(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, signed char *array, int *status); +int CFITS_API ffp3dui(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, unsigned short *array, int *status); +int CFITS_API ffp3di(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, short *array, int *status); +int CFITS_API ffp3duj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, unsigned long *array, int *status); +int CFITS_API ffp3dj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, long *array, int *status); +int CFITS_API ffp3duk(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, unsigned int *array, int *status); +int CFITS_API ffp3dk(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, int *array, int *status); +int CFITS_API ffp3de(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, float *array, int *status); +int CFITS_API ffp3dd(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, double *array, int *status); +int CFITS_API ffp3djj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, LONGLONG *array, int *status); +int CFITS_API ffp3dujj(fitsfile *fptr, long group, LONGLONG ncols, LONGLONG nrows, LONGLONG naxis1, + LONGLONG naxis2, LONGLONG naxis3, ULONGLONG *array, int *status); + +int CFITS_API ffpss(fitsfile *fptr, int datatype, + long *fpixel, long *lpixel, void *array, int *status); +int CFITS_API ffpssb(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned char *array, int *status); +int CFITS_API ffpsssb(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, signed char *array, int *status); +int CFITS_API ffpssui(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned short *array, int *status); +int CFITS_API ffpssi(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, short *array, int *status); +int CFITS_API ffpssuj(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned long *array, int *status); +int CFITS_API ffpssj(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, long *array, int *status); +int CFITS_API ffpssuk(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, unsigned int *array, int *status); +int CFITS_API ffpssk(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, int *array, int *status); +int CFITS_API ffpsse(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, float *array, int *status); +int CFITS_API ffpssd(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, double *array, int *status); +int CFITS_API ffpssjj(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, LONGLONG *array, int *status); +int CFITS_API ffpssujj(fitsfile *fptr, long group, long naxis, long *naxes, + long *fpixel, long *lpixel, ULONGLONG *array, int *status); + +int CFITS_API ffpgpb(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned char *array, int *status); +int CFITS_API ffpgpsb(fitsfile *fptr, long group, long firstelem, + long nelem, signed char *array, int *status); +int CFITS_API ffpgpui(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned short *array, int *status); +int CFITS_API ffpgpi(fitsfile *fptr, long group, long firstelem, + long nelem, short *array, int *status); +int CFITS_API ffpgpuj(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned long *array, int *status); +int CFITS_API ffpgpj(fitsfile *fptr, long group, long firstelem, + long nelem, long *array, int *status); +int CFITS_API ffpgpuk(fitsfile *fptr, long group, long firstelem, + long nelem, unsigned int *array, int *status); +int CFITS_API ffpgpk(fitsfile *fptr, long group, long firstelem, + long nelem, int *array, int *status); +int CFITS_API ffpgpe(fitsfile *fptr, long group, long firstelem, + long nelem, float *array, int *status); +int CFITS_API ffpgpd(fitsfile *fptr, long group, long firstelem, + long nelem, double *array, int *status); +int CFITS_API ffpgpjj(fitsfile *fptr, long group, long firstelem, + long nelem, LONGLONG *array, int *status); +int CFITS_API ffpgpujj(fitsfile *fptr, long group, long firstelem, + long nelem, ULONGLONG *array, int *status); + +/*--------------------- iterator functions -------------*/ +int CFITS_API fits_iter_set_by_name(iteratorCol *col, fitsfile *fptr, char *colname, + int datatype, int iotype); +int CFITS_API fits_iter_set_by_num(iteratorCol *col, fitsfile *fptr, int colnum, + int datatype, int iotype); +int CFITS_API fits_iter_set_file(iteratorCol *col, fitsfile *fptr); +int CFITS_API fits_iter_set_colname(iteratorCol *col, char *colname); +int CFITS_API fits_iter_set_colnum(iteratorCol *col, int colnum); +int CFITS_API fits_iter_set_datatype(iteratorCol *col, int datatype); +int CFITS_API fits_iter_set_iotype(iteratorCol *col, int iotype); + +CFITS_API fitsfile * fits_iter_get_file(iteratorCol *col); +char CFITS_API * fits_iter_get_colname(iteratorCol *col); +int CFITS_API fits_iter_get_colnum(iteratorCol *col); +int CFITS_API fits_iter_get_datatype(iteratorCol *col); +int CFITS_API fits_iter_get_iotype(iteratorCol *col); +void CFITS_API *fits_iter_get_array(iteratorCol *col); +long CFITS_API fits_iter_get_tlmin(iteratorCol *col); +long CFITS_API fits_iter_get_tlmax(iteratorCol *col); +long CFITS_API fits_iter_get_repeat(iteratorCol *col); +char CFITS_API *fits_iter_get_tunit(iteratorCol *col); +char CFITS_API *fits_iter_get_tdisp(iteratorCol *col); + +int CFITS_API 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 CFITS_API ffpcl(fitsfile *fptr, int datatype, int colnum, LONGLONG firstrow, + LONGLONG firstelem, LONGLONG nelem, void *array, int *status); +int CFITS_API ffpcln(fitsfile *fptr, int ncols, int *datatype, int *colnum, LONGLONG firstrow, + LONGLONG nrows, void **array, void **nulval, int *status); +int CFITS_API ffpcls(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, char **array, int *status); +int CFITS_API ffpcll(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, char *array, int *status); +int CFITS_API ffpclb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned char *array, int *status); +int CFITS_API ffpclsb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, signed char *array, int *status); +int CFITS_API ffpclui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned short *array, int *status); +int CFITS_API ffpcli(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, short *array, int *status); +int CFITS_API ffpcluj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned long *array, int *status); +int CFITS_API ffpclj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, long *array, int *status); +int CFITS_API ffpcluk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned int *array, int *status); +int CFITS_API ffpclk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, int *array, int *status); +int CFITS_API ffpcle(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, float *array, int *status); +int CFITS_API ffpcld(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, double *array, int *status); +int CFITS_API ffpclc(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, float *array, int *status); +int CFITS_API ffpclm(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, double *array, int *status); +int CFITS_API ffpclu(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, int *status); +int CFITS_API ffprwu(fitsfile *fptr, LONGLONG firstrow, LONGLONG nrows, int *status); +int CFITS_API ffpcljj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, LONGLONG *array, int *status); +int CFITS_API ffpclujj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, ULONGLONG *array, int *status); +int CFITS_API ffpclx(fitsfile *fptr, int colnum, LONGLONG frow, long fbit, long nbit, + char *larray, int *status); + +int CFITS_API ffpcn(fitsfile *fptr, int datatype, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, void *array, void *nulval, int *status); +int CFITS_API ffpcns( fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, char **array, char *nulvalue, int *status); +int CFITS_API ffpcnl( fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, char *array, char nulvalue, int *status); +int CFITS_API ffpcnb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned char *array, unsigned char nulvalue, + int *status); +int CFITS_API ffpcnsb(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, signed char *array, signed char nulvalue, + int *status); +int CFITS_API ffpcnui(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned short *array, unsigned short nulvalue, + int *status); +int CFITS_API ffpcni(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, short *array, short nulvalue, int *status); +int CFITS_API ffpcnuj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned long *array, unsigned long nulvalue, + int *status); +int CFITS_API ffpcnj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, long *array, long nulvalue, int *status); +int CFITS_API ffpcnuk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, unsigned int *array, unsigned int nulvalue, + int *status); +int CFITS_API ffpcnk(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, int *array, int nulvalue, int *status); +int CFITS_API ffpcne(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, float *array, float nulvalue, int *status); +int CFITS_API ffpcnd(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, double *array, double nulvalue, int *status); +int CFITS_API ffpcnjj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, LONGLONG *array, LONGLONG nulvalue, int *status); +int CFITS_API ffpcnujj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, ULONGLONG *array, ULONGLONG nulvalue, int *status); +int CFITS_API ffptbb(fitsfile *fptr, LONGLONG firstrow, LONGLONG firstchar, LONGLONG nchars, + unsigned char *values, int *status); + +int CFITS_API ffirow(fitsfile *fptr, LONGLONG firstrow, LONGLONG nrows, int *status); +int CFITS_API ffdrow(fitsfile *fptr, LONGLONG firstrow, LONGLONG nrows, int *status); +int CFITS_API ffdrrg(fitsfile *fptr, char *ranges, int *status); +int CFITS_API ffdrws(fitsfile *fptr, long *rownum, long nrows, int *status); +int CFITS_API ffdrwsll(fitsfile *fptr, LONGLONG *rownum, LONGLONG nrows, int *status); +int CFITS_API fficol(fitsfile *fptr, int numcol, char *ttype, char *tform, int *status); +int CFITS_API fficls(fitsfile *fptr, int firstcol, int ncols, char **ttype, + char **tform, int *status); +int CFITS_API ffmvec(fitsfile *fptr, int colnum, LONGLONG newveclen, int *status); +int CFITS_API ffdcol(fitsfile *fptr, int numcol, int *status); +int CFITS_API ffcpcl(fitsfile *infptr, fitsfile *outfptr, int incol, int outcol, + int create_col, int *status); +int CFITS_API ffccls(fitsfile *infptr, fitsfile *outfptr, int incol, int outcol, + int ncols, int create_col, int *status); +int CFITS_API ffcprw(fitsfile *infptr, fitsfile *outfptr, LONGLONG firstrow, + LONGLONG nrows, int *status); +int CFITS_API ffcpsr(fitsfile *infptr, fitsfile *outfptr, LONGLONG firstrow, + LONGLONG nrows, char *row_status, int *status); +int CFITS_API ffcpht(fitsfile *infptr, fitsfile *outfptr, LONGLONG firstrow, + LONGLONG nrows, int *status); + +/*--------------------- WCS Utilities ------------------*/ +int CFITS_API ffgics(fitsfile *fptr, double *xrval, double *yrval, double *xrpix, + double *yrpix, double *xinc, double *yinc, double *rot, + char *type, int *status); +int CFITS_API ffgicsa(fitsfile *fptr, char version, double *xrval, double *yrval, double *xrpix, + double *yrpix, double *xinc, double *yinc, double *rot, + char *type, int *status); +int CFITS_API 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 CFITS_API 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 CFITS_API 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 CFITS_API ffgiwcs(fitsfile *fptr, char **header, int *status); +int CFITS_API ffgtwcs(fitsfile *fptr, int xcol, int ycol, char **header, int *status); + +/*--------------------- lexical parsing routines ------------------*/ +int CFITS_API fftexp( fitsfile *fptr, char *expr, int maxdim, + int *datatype, long *nelem, int *naxis, + long *naxes, int *status ); + +int CFITS_API fffrow( fitsfile *infptr, char *expr, + long firstrow, long nrows, + long *n_good_rows, char *row_status, int *status); + +int CFITS_API ffffrw( fitsfile *fptr, char *expr, long *rownum, int *status); + +int CFITS_API fffrwc( fitsfile *fptr, char *expr, char *timeCol, + char *parCol, char *valCol, long ntimes, + double *times, char *time_status, int *status ); + +int CFITS_API ffsrow( fitsfile *infptr, fitsfile *outfptr, char *expr, + int *status); + +int CFITS_API ffcrow( fitsfile *fptr, int datatype, char *expr, + long firstrow, long nelements, void *nulval, + void *array, int *anynul, int *status ); + +int CFITS_API ffcalc_rng( fitsfile *infptr, char *expr, fitsfile *outfptr, + char *parName, char *parInfo, int nRngs, + long *start, long *end, int *status ); + +int CFITS_API 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 CFITS_API 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 CFITS_API 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); +CFITS_API fitsfile *ffhist3(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 *selectrow, + int *status); +int CFITS_API fits_select_image_section(fitsfile **fptr, char *outfile, + char *imagesection, int *status); +int CFITS_API fits_copy_image_section(fitsfile *infptr, fitsfile *outfile, + char *imagesection, int *status); + +int CFITS_API 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 CFITS_API fits_calc_binningd(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, + double *amin, double *amax, double *binsize, int *status); + +int CFITS_API fits_write_keys_histo(fitsfile *fptr, fitsfile *histptr, + int naxis, int *colnum, int *status); +int CFITS_API fits_rebin_wcs( fitsfile *fptr, int naxis, float *amin, float *binsize, + int *status); +int CFITS_API fits_rebin_wcsd( fitsfile *fptr, int naxis, double *amin, double *binsize, + int *status); +int CFITS_API 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); +int CFITS_API fits_make_histd(fitsfile *fptr, fitsfile *histptr, int bitpix,int naxis, + long *naxes, int *colnum, double *amin, double *amax, double *binsize, + double 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 CFITS_API fits_pixel_filter (PixelFilter * filter, int * status); + + +/*--------------------- grouping routines ------------------*/ + +int CFITS_API ffgtcr(fitsfile *fptr, char *grpname, int grouptype, int *status); +int CFITS_API ffgtis(fitsfile *fptr, char *grpname, int grouptype, int *status); +int CFITS_API ffgtch(fitsfile *gfptr, int grouptype, int *status); +int CFITS_API ffgtrm(fitsfile *gfptr, int rmopt, int *status); +int CFITS_API ffgtcp(fitsfile *infptr, fitsfile *outfptr, int cpopt, int *status); +int CFITS_API ffgtmg(fitsfile *infptr, fitsfile *outfptr, int mgopt, int *status); +int CFITS_API ffgtcm(fitsfile *gfptr, int cmopt, int *status); +int CFITS_API ffgtvf(fitsfile *gfptr, long *firstfailed, int *status); +int CFITS_API ffgtop(fitsfile *mfptr,int group,fitsfile **gfptr,int *status); +int CFITS_API ffgtam(fitsfile *gfptr, fitsfile *mfptr, int hdupos, int *status); +int CFITS_API ffgtnm(fitsfile *gfptr, long *nmembers, int *status); +int CFITS_API ffgmng(fitsfile *mfptr, long *nmembers, int *status); +int CFITS_API ffgmop(fitsfile *gfptr, long member, fitsfile **mfptr, int *status); +int CFITS_API ffgmcp(fitsfile *gfptr, fitsfile *mfptr, long member, int cpopt, + int *status); +int CFITS_API ffgmtf(fitsfile *infptr, fitsfile *outfptr, long member, int tfopt, + int *status); +int CFITS_API ffgmrm(fitsfile *fptr, long member, int rmopt, int *status); + +/*--------------------- group template parser routines ------------------*/ + +int CFITS_API fits_execute_template(fitsfile *ff, char *ngp_template, int *status); + +int CFITS_API 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 CFITS_API 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 CFITS_API 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 CFITS_API fits_set_compression_type(fitsfile *fptr, int ctype, int *status); +int CFITS_API fits_set_tile_dim(fitsfile *fptr, int ndim, long *dims, int *status); +int CFITS_API fits_set_noise_bits(fitsfile *fptr, int noisebits, int *status); +int CFITS_API fits_set_quantize_level(fitsfile *fptr, float qlevel, int *status); +int CFITS_API fits_set_hcomp_scale(fitsfile *fptr, float scale, int *status); +int CFITS_API fits_set_hcomp_smooth(fitsfile *fptr, int smooth, int *status); +int CFITS_API fits_set_quantize_method(fitsfile *fptr, int method, int *status); +int CFITS_API fits_set_quantize_dither(fitsfile *fptr, int dither, int *status); +int CFITS_API fits_set_dither_seed(fitsfile *fptr, int seed, int *status); +int CFITS_API fits_set_dither_offset(fitsfile *fptr, int offset, int *status); +int CFITS_API fits_set_lossy_int(fitsfile *fptr, int lossy_int, int *status); +int CFITS_API fits_set_huge_hdu(fitsfile *fptr, int huge, int *status); +int CFITS_API fits_set_compression_pref(fitsfile *infptr, fitsfile *outfptr, int *status); + +int CFITS_API fits_get_compression_type(fitsfile *fptr, int *ctype, int *status); +int CFITS_API fits_get_tile_dim(fitsfile *fptr, int ndim, long *dims, int *status); +int CFITS_API fits_get_quantize_level(fitsfile *fptr, float *qlevel, int *status); +int CFITS_API fits_get_noise_bits(fitsfile *fptr, int *noisebits, int *status); +int CFITS_API fits_get_hcomp_scale(fitsfile *fptr, float *scale, int *status); +int CFITS_API fits_get_hcomp_smooth(fitsfile *fptr, int *smooth, int *status); +int CFITS_API fits_get_dither_seed(fitsfile *fptr, int *seed, int *status); + +int CFITS_API fits_img_compress(fitsfile *infptr, fitsfile *outfptr, int *status); +int CFITS_API fits_compress_img(fitsfile *infptr, fitsfile *outfptr, int compress_type, + long *tilesize, int parm1, int parm2, int *status); +int CFITS_API fits_is_compressed_image(fitsfile *fptr, int *status); +int CFITS_API fits_is_reentrant(void); +int CFITS_API fits_decompress_img (fitsfile *infptr, fitsfile *outfptr, int *status); +int CFITS_API fits_img_decompress_header(fitsfile *infptr, fitsfile *outfptr, int *status); +int CFITS_API fits_img_decompress (fitsfile *infptr, fitsfile *outfptr, int *status); + +/* H-compress routines */ +int CFITS_API fits_hcompress(int *a, int nx, int ny, int scale, char *output, + long *nbytes, int *status); +int CFITS_API fits_hcompress64(LONGLONG *a, int nx, int ny, int scale, char *output, + long *nbytes, int *status); +int CFITS_API fits_hdecompress(unsigned char *input, int smooth, int *a, int *nx, + int *ny, int *scale, int *status); +int CFITS_API fits_hdecompress64(unsigned char *input, int smooth, LONGLONG *a, int *nx, + int *ny, int *scale, int *status); + +int CFITS_API fits_compress_table (fitsfile *infptr, fitsfile *outfptr, int *status); +int CFITS_API fits_uncompress_table(fitsfile *infptr, fitsfile *outfptr, int *status); + +/* curl library wrapper routines (for https access) */ +int CFITS_API fits_init_https(void); +int CFITS_API fits_cleanup_https(void); +void CFITS_API fits_verbose_https(int flag); + +void CFITS_API ffshdwn(int flag); +int CFITS_API ffgtmo(void); +int CFITS_API ffstmo(int sec, int *status); + +/* The following exclusion if __CINT__ is defined is needed for ROOT */ +#ifndef __CINT__ +#ifdef __cplusplus +} +#endif +#endif + +#endif + diff --git a/vendor/cfitsio/fitsio2.h b/vendor/cfitsio/fitsio2.h new file mode 100644 index 000000000..c083b515f --- /dev/null +++ b/vendor/cfitsio/fitsio2.h @@ -0,0 +1,1335 @@ +#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 +/* #include not needed any more */ +extern pthread_mutex_t Fitsio_Lock; +extern int Fitsio_Pthread_Status; + +#define FFLOCK1(lockname) (Fitsio_Pthread_Status = pthread_mutex_lock(&lockname)) +#define FFUNLOCK1(lockname) (Fitsio_Pthread_Status = pthread_mutex_unlock(&lockname)) +#define FFLOCK FFLOCK1(Fitsio_Lock) +#define FFUNLOCK FFUNLOCK1(Fitsio_Lock) +#define ffstrtok(str, tok, save) strtok_r(str, tok, save) + +#else +#define FFLOCK +#define FFUNLOCK +#define ffstrtok(str, tok, save) strtok(str, tok) +#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 10000 /* maximum number of FITS files that can be opened */ + /* CFITSIO will allocate (NMAXFILES * 80) bytes of memory */ + /* plus each file that is opened will use NIOBUF * 2880 bytes of memeory */ + /* where NIOBUF is defined in fitio.h and has a default value of 40 */ + +#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__) || defined(__AARCH64EL__) + /* 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__) || defined(__AARCH64EB__) /* IBM 64-bit AIX powerpc*/ + /* could also test for __ppc64__ or __PPC64 */ + +# if defined(__LITTLE_ENDIAN__) +# define BYTESWAPPED TRUE +# else +# define BYTESWAPPED FALSE +# define MACHINE NATIVE +# endif +# 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 + +#elif defined(__riscv) + +/* RISC-V is always little endian */ + +#define BYTESWAPPED TRUE + +# if __riscv_xlen == 32 +# define LONGSIZE 32 +# elif __riscv_xlen == 64 +# define LONGSIZE 64 +# else +# error "can't handle long size given by __riscv_xlen" +# 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 DULONGLONG_MAX 18446744073709551615. /* max unsigned longlong */ +#define DULONGLONG_MIN -0.49 +#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 UINT64_MAX +#define UINT64_MAX 18446744073709551615U /* max unsigned 64-bit integer */ +#endif +#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 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 ffu2c(ULONGLONG ival, char *cval, int *status); +int ffl2c(int lval, char *cval, int *status); +int ffs2c(const char *instr, char *outstr, int *status); +int ffs2c_nopad(const 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(const char *cval, long *ival, int *status); +int ffc2jj(const char *cval, LONGLONG *ival, int *status); +int ffc2ujj(const char *cval, ULONGLONG *ival, int *status); +int ffc2ll(const char *cval, int *lval, int *status); +int ffc2rr(const char *cval, float *fval, int *status); +int ffc2dd(const char *cval, double *dval, int *status); +int ffc2x(const char *cval, char *dtype, long *ival, int *lval, char *sval, + double *dval, int *status); +int ffc2xx(const char *cval, char *dtype, LONGLONG *ival, int *lval, char *sval, + double *dval, int *status); +int ffc2uxx(const char *cval, char *dtype, ULONGLONG *ival, int *lval, char *sval, + double *dval, int *status); +int ffc2s(const char *instr, char *outstr, int *status); +int ffc2i(const char *cval, long *ival, int *status); +int ffc2j(const char *cval, LONGLONG *ival, int *status); +int ffc2uj(const char *cval, ULONGLONG *ival, int *status); +int ffc2r(const char *cval, float *fval, int *status); +int ffc2d(const char *cval, double *dval, int *status); +int ffc2l(const char *cval, int *lval, int *status); +void ffxmsg(int action, char *err_message); +int ffgcnt(fitsfile *fptr, char *value, char *comm, 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, const 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); +char *fits_find_match_delim(char *, char); +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 noextsyn, + int *isopen, int *status); +int ffedit_columns(fitsfile **fptr, char *outfile, char *expr, int *status); +int fits_get_col_minmax(fitsfile *fptr, int colnum, double *datamin, + double *datamax, int *status); +/* "Extended syntax" versions of histogram binning which permit + expressions instead of just columns. The existing interfaces + still work */ +int fits_get_expr_minmax(fitsfile *fptr, char *expr, double *datamin, + double *datamax, int *datatype, int *status); +int ffbinse(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, char ***exprs, int *status); +int ffbinre(char **binspec, char *colname, char **exprbeg, char **exprend, + double *minin, double *maxin, double *binsizein, char *minname, + char *maxname, char *binname, int *status); +int ffhist2e(fitsfile **fptr, char *outfile, int imagetype, int naxis, + char colname[4][FLEN_VALUE], char *colexpr[4], + 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], char *wtexpr, + int recip, char *selectrow, int *status); +int fits_calc_binningde(fitsfile *, int, char colname[4][FLEN_VALUE], + char *colexpr[4], double *minin, double *maxin, double *binsizein, + char minname[4][FLEN_VALUE], char maxname[4][FLEN_VALUE], char binname[4][FLEN_VALUE], + int *, int *, long *, double *, double *, double *, long *, int *); +int fits_write_keys_histoe(fitsfile *fptr, fitsfile *histptr, + int naxis, int *colnum, char colname[4][FLEN_VALUE], char *colexpr[4], int *status); +int fits_make_histde(fitsfile *fptr, fitsfile *histptr, int *datatypes, int bitpix,int naxis, + long *naxes, int *colnum, char *colexpr[4], double *amin, double *amax, double *binsize, + double weight, int wtcolnum, char *wtexpr, int recip, char *selectrow, 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 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 ffgclujj(fitsfile *fptr, int colnum, LONGLONG firstrow, LONGLONG firstelem, + LONGLONG nelem, long elemincre, int nultyp, ULONGLONG nulval, + ULONGLONG *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 fffvcl(fitsfile *fptr, int *nvarcols, int *colnums, 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 fffi1u8(unsigned char *input, long ntodo, double scale, double zero, + int nullcheck, unsigned char tnull, ULONGLONG nullval, + char *nullarray, int *anynull, ULONGLONG *output, int *status); +int fffi2u8(short *input, long ntodo, double scale, double zero, + int nullcheck, short tnull, ULONGLONG nullval, char *nullarray, + int *anynull, ULONGLONG *output, int *status); +int fffi4u8(INT32BIT *input, long ntodo, double scale, double zero, + int nullcheck, INT32BIT tnull, ULONGLONG nullval, char *nullarray, + int *anynull, ULONGLONG *output, int *status); +int fffi8u8(LONGLONG *input, long ntodo, double scale, double zero, + int nullcheck, LONGLONG tnull, ULONGLONG nullval, char *nullarray, + int *anynull, ULONGLONG *output, int *status); +int fffr4u8(float *input, long ntodo, double scale, double zero, + int nullcheck, ULONGLONG nullval, char *nullarray, + int *anynull, ULONGLONG *output, int *status); +int fffr8u8(double *input, long ntodo, double scale, double zero, + int nullcheck, ULONGLONG nullval, char *nullarray, + int *anynull, ULONGLONG *output, int *status); +int fffstru8(char *input, long ntodo, double scale, double zero, + long twidth, double power, int nullcheck, char *snull, + ULONGLONG nullval, char *nullarray, int *anynull, ULONGLONG *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 ffu8fi1(ULONGLONG *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 ffu8fi2(ULONGLONG *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 ffu8fi4(ULONGLONG *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 ffi4fi8(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 ffu8fi8(ULONGLONG *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 ffu8fr4(ULONGLONG *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 ffu8fr8(ULONGLONG *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 ffu8fstr(ULONGLONG *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 */ +typedef struct ParseData_struct ParseData; +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, + ParseData *, int *status ); +void ffcprs( ParseData * ); +int ffcvtn( int inputType, void *input, char *undef, long ntodo, + int outputType, void *nulval, void *output, + int *anynull, int *status ); +int fits_parser_workfn( long totalrows, long offset, long firstrow, + long nrows, int nCols, iteratorCol *colData, + void *userPtr ); +int fits_uncompress_hkdata( ParseData *, + 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_test_overlap (int ndim, long *tfpixel, long *tlpixel, + long *fpixel, long *lpixel, long *inc, 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 dither_method, 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 dither_method, 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 fits_unset_compression_param( fitsfile *fptr, int *status); +int fits_unset_compression_request( fitsfile *fptr, int *status); +int fitsio_init_lock(void); + +/* general driver routines */ + +int urltype2driver(char *urltype, int *driver); + +void fits_dwnld_prog_bar(int flag); +int fits_net_timeout(int sec); + +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 *sizex), + 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_zuncompress_and_write(int hdl, void *buffer, long nbytes); +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); + +/* https driver I/O routines */ +int https_checkfile(char* urltype, char *infile, char *outfile); +int https_open(char *filename, int rwmode, int *driverhandle); +int https_file_open(char *filename, int rwmode, int *driverhandle); +void https_set_verbose(int flag); + +/* ftps driver I/O routines */ +int ftps_checkfile(char* urltype, char *infile, char *outfile); +int ftps_open(char *filename, int rwmode, int *handle); +int ftps_file_open(char *filename, int rwmode, int *handle); +int ftps_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 + +/* A hack for nonunix machines, which lack strcasecmp and strncasecmp */ +/* these functions are in fitscore.c */ +int fits_strcasecmp (const char *s1, const char *s2 ); +int fits_strncasecmp(const char *s1, const char *s2, size_t n); +/* "recalloc" which is a reallocator in the style of calloc */ +void *fits_recalloc(void *ptr, size_t old_num, size_t new_num, size_t size); + +/* end of the entire "ifndef _FITSIO2_H" block */ +#endif diff --git a/vendor/cfitsio/getcol.c b/vendor/cfitsio/getcol.c new file mode 100644 index 000000000..c595e6ab8 --- /dev/null +++ b/vendor/cfitsio/getcol.c @@ -0,0 +1,1221 @@ + +/* 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 +#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 == TULONGLONG) + { + if (nulval == 0) + ffgclujj(fptr, 2, 1, firstelem, nelem, 1, 1, 0, + (ULONGLONG *) array, &cdummy, anynul, status); + else + ffgclujj(fptr, 2, 1, firstelem, nelem, 1, 1, *(ULONGLONG *) nulval, + (ULONGLONG *) 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 == TULONGLONG) + { + ffgclujj(fptr, 2, 1, firstelem, nelem, 1, 2, 0, + (ULONGLONG *) 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 == TULONGLONG) + { + if (nulval == 0) + ffgsvujj(fptr, 1, naxis, naxes, blc, trc, inc, 0, + (ULONGLONG *) array, anynul, status); + else + ffgsvujj(fptr, 1, naxis, naxes, blc, trc, inc, *(ULONGLONG *) nulval, + (ULONGLONG *) 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 == TULONGLONG) + { + if (nulval == 0) + ffgpvujj(fptr, 1, firstelem, nelem, 0, + (ULONGLONG *) array, anynul, status); + else + ffgpvujj(fptr, 1, firstelem, nelem, *(ULONGLONG *) nulval, + (ULONGLONG *) 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 == TULONGLONG) + { + ffgpfujj(fptr, 1, firstelem, nelem, + (ULONGLONG *) 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 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 */ + 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 == TULONGLONG) + { + if (nulval == 0) + ffgclujj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, 0, + (ULONGLONG *) array, cdummy, anynul, status); + else + ffgclujj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, *(ULONGLONG *) + nulval, (ULONGLONG *) 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 ffgcvn( fitsfile *fptr, /* I - FITS file pointer */ + int ncols, /* I - number of columns to read */ + int *datatype, /* I - datatypes of the values */ + int *colnum, /* I - columns numbers to read (1 = 1st col) */ + LONGLONG firstrow, /* I - first row to read (1 = 1st row) */ + LONGLONG nrows, /* I - number of rows to read */ + void **nulval, /* I - array of pointers to values for undefined pixels */ + void **array, /* O - array of pointers to values that are returned */ + int *anynul, /* O - anynul[i] set to 1 if any values in column i are null; else 0 */ + int *status) /* IO - error status */ +/* + Read arrays of values from NCOLS table columns. This is an optimization + to read all columns in one pass through the table. The datatypes of the + input arrays are defined by the 3rd 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 for column i will be set equal to *(nulval[i]), unless nulval[i]=0 + in which case no checking for undefined values will be performed. + anynul[i] is returned with a value of true if any pixels in column i are undefined. +*/ +{ + LONGLONG ntotrows, ndone, nread, currow; + long nrowbuf; + LONGLONG *repeats = 0; + size_t sizes[255] = {0}; + int icol; + + sizes[TBYTE] = sizes[TSBYTE] = sizes[TLOGICAL] = sizeof(char); + sizes[TUSHORT] = sizes[TSHORT] = sizeof(short int); + sizes[TINT] = sizes[TUINT] = sizeof(int); + sizes[TLONG] = sizes[TULONG] = sizeof(long int); + sizes[TLONGLONG] = sizes[TULONGLONG] = sizeof(LONGLONG); + sizes[TFLOAT] = sizeof(float); + sizes[TDOUBLE] = sizeof(double); + sizes[TDBLCOMPLEX] = 2*sizeof(double); + + if (*status > 0) + return(*status); + + if (ncols <= 0) return (*status=0); + + repeats = malloc(sizeof(LONGLONG)*ncols); + if (repeats == 0) return (*status=MEMORY_ALLOCATION); + + fits_get_num_rowsll(fptr, &ntotrows, status); + fits_get_rowsize(fptr, &nrowbuf, status); + + /* Retrieve column repeats */ + for (icol = 0; (icol < ncols) && (icol < 1000); icol++) { + int typecode; + LONGLONG repeat, width; + fits_get_coltypell(fptr, colnum[icol], &typecode, + &repeat, &width, status); + repeats[icol] = repeat; + + if (datatype[icol] == TBIT || datatype[icol] == TSTRING || + sizes[datatype[icol]] == 0) { + ffpmsg("Cannot read from TBIT or TSTRING datatypes (ffgcvn)"); + *status = BAD_DATATYPE; + } + if (typecode < 0) { + ffpmsg("Cannot read from variable-length data (ffgcvn)"); + *status = BAD_DIMEN; + } + + if (*status) break; + } + if (*status) { + free(repeats); + return *status; + } + + /* Optimize for 1 column */ + if (ncols == 1) { + fits_read_col(fptr, datatype[0], colnum[0], firstrow, 1, + nrows*repeats[0], nulval[0], + array[0], anynul ? &(anynul[0]) : 0, status); + free(repeats); + return *status; + } + + /* Scan through file, in chunks of nrowbuf */ + currow = firstrow; + ndone = 0; + while (ndone < nrows) { + int icol; + nread = (nrows-ndone); /* Number of rows to read (not elements) */ + if (nread > nrowbuf) nread = nrowbuf; + + for (icol=0; icol 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) + { + 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 == TULONGLONG) + { + ffgclujj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, (ULONGLONG ) + nulval, (ULONGLONG *) 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, + 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, + cnulval, (char **) array, nullarray, anynul, status); + } + else + *status = BAD_DATATYPE; + + return(*status); +} + diff --git a/vendor/cfitsio/getcolb.c b/vendor/cfitsio/getcolb.c new file mode 100644 index 000000000..a9c56e9a4 --- /dev/null +++ b/vendor/cfitsio/getcolb.c @@ -0,0 +1,2046 @@ +/* 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 +#include +#include +#include +#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) + { + snprintf(msg, FLEN_ERRMSG,"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 + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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, maxelem2, hdutype, xcode, decimals; + long twidth, incre, ntodo; + long ii, xwidth; + int convert, nulcheck, readcheck = 16; /* see note below on readcheck */ + LONGLONG repeat, startpos, elemnum, readptr, tnull; + LONGLONG rowlen, rownum, remain, next, rowincre, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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 */ + + /* IMPORTANT NOTE: that the special case of using this subroutine + to read bytes from a character column are handled internally + by the call to ffgcprll() below. It will adjust the effective + *tcode, repeats, etc, to appear as a TBYTE column. */ + + /* Note that readcheck = 16 is equivalent to readcheck = 0 + and readcheck = 15 is equivalent to readcheck = -1, + but either of those settings allow TSTRINGS to be + treated as TBYTE vectors, but with full error checking */ + + ffgcprll( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero, + tform, &twidth, &tcode, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status); + maxelem = maxelem2; + + /* 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 (*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 */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX) { + maxelem = nelem; + } else { + maxelem = INT32_MAX; + } + + 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 */ + snprintf(message, FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgclb).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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 */ + memmove(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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + output[ii] = (unsigned char) ulltemp; + } + } + 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 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > UCHAR_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UCHAR_MAX; + } + else + { + output[ii] = (unsigned char) ulltemp; + } + } + } + } + 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 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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG,"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/vendor/cfitsio/getcold.c b/vendor/cfitsio/getcold.c new file mode 100644 index 000000000..c9c870e17 --- /dev/null +++ b/vendor/cfitsio/getcold.c @@ -0,0 +1,1721 @@ +/* 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 +#include +#include +#include +#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) + { + snprintf(msg, FLEN_ERRMSG,"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 + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg,FLEN_ERRMSG, "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]) + { + snprintf(msg, FLEN_ERRMSG,"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. +*/ +{ + LONGLONG 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, maxelem2; + long twidth, incre; + long ii, xwidth, ntodo; + int convert, nulcheck, readcheck = 0; + LONGLONG repeat, startpos, elemnum, readptr, tnull; + LONGLONG rowlen, rownum, remain, next, rowincre, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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 */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX/8) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/8; + } + + 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 */ + snprintf(message, FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgcld).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + output[ii] = (double) ulltemp; + } + } + else 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + output[ii] = (double) ulltemp; + } + } + } + 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] = (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 */ + { + memmove(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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message,FLEN_ERRMSG, "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/vendor/cfitsio/getcole.c b/vendor/cfitsio/getcole.c new file mode 100644 index 000000000..baebda572 --- /dev/null +++ b/vendor/cfitsio/getcole.c @@ -0,0 +1,1724 @@ +/* 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 +#include +#include +#include +#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; + LONGLONG narray, nfits, ii, jj; + 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) + { + snprintf(msg, FLEN_ERRMSG,"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 + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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. +*/ +{ + LONGLONG 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, maxelem2, 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, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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 */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX/4) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/4; + } + + 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 */ + snprintf(message, FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgcle).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + output[ii] = (float) ulltemp; + } + } + else 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + output[ii] = (float) ulltemp; + } + } + } + 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] = (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 */ + { + memmove(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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG, "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/vendor/cfitsio/getcoli.c b/vendor/cfitsio/getcoli.c new file mode 100644 index 000000000..93c9d3e91 --- /dev/null +++ b/vendor/cfitsio/getcoli.c @@ -0,0 +1,1962 @@ +/* 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 +#include +#include +#include +#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) + { + snprintf(msg,FLEN_ERRMSG, "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 + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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, maxelem2, 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, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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 */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX/2) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/2; + } + + 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 */ + snprintf(message, FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgcli).", + dtemp+1, dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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 */ + { + memmove(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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + output[ii] = (short) ulltemp; + } + } + } + else 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > SHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = SHRT_MAX; + } + else + { + output[ii] = (short) ulltemp; + } + } + } + } + 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] < 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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG,"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/vendor/cfitsio/getcolj.c b/vendor/cfitsio/getcolj.c new file mode 100644 index 000000000..a1b8d50bd --- /dev/null +++ b/vendor/cfitsio/getcolj.c @@ -0,0 +1,3855 @@ +/* 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 +#include +#include +#include +#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) + { + snprintf(msg, FLEN_ERRMSG,"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 + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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, maxelem2, 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, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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) && (LONGSIZE == 32)) /* Special Case: */ + { /* no type convertion required, so read */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX/4) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/4; + } + + 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): + if (LONGSIZE == 32) { + 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); + } else { /* case where sizeof(long) = 8 */ + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer, + status); + if (convert) + fffi4i4((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); + 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 */ + snprintf(message, FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgclj).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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; +*/ +{ + 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] = 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 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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > LONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + { + output[ii] = (long) ulltemp; + } + } + } + else 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > LONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONG_MAX; + } + else + { + output[ii] = (long) ulltemp; + } + } + } + } + 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] < 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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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 + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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, maxelem2, 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, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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 */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX/8) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/8; + } + + 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 */ + snprintf(message,FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgclj).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > LONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + output[ii] = (LONGLONG) ulltemp; + } + } + } + else 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > LONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + output[ii] = (LONGLONG) ulltemp; + } + } + } + } + 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] = 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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG, "Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG,"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/vendor/cfitsio/getcolk.c b/vendor/cfitsio/getcolk.c new file mode 100644 index 000000000..fd5b385aa --- /dev/null +++ b/vendor/cfitsio/getcolk.c @@ -0,0 +1,1955 @@ +/* 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 +#include +#include +#include +#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) + { + snprintf(msg, FLEN_ERRMSG,"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 + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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, maxelem2, 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, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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 */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX/4) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/4; + } + + 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 */ + snprintf(message, FLEN_ERRMSG, + "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) + snprintf(message, FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgclk).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message, FLEN_ERRMSG, + "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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > INT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + { + output[ii] = (int) ulltemp; + } + } + } + else 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > INT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = INT_MAX; + } + else + { + output[ii] = (int) ulltemp; + } + } + } + } + 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] < 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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG,"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/vendor/cfitsio/getcoll.c b/vendor/cfitsio/getcoll.c new file mode 100644 index 000000000..8e8cd84b0 --- /dev/null +++ b/vendor/cfitsio/getcoll.c @@ -0,0 +1,621 @@ +/* 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 +#include +#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 */ + { + if (*buffptr == 1) { + /* this is an unfortunate case where the illegal value is the same + as what we set True values to, so set the value to the character '1' + instead, which has ASCII value 49. */ + array[next] = 49; + } else { + array[next] = (char) *buffptr; + } + } + } + + if (*status > 0) /* test for error during previous read operation */ + { + dtemp = (double) next; + snprintf(message,FLEN_ERRMSG, + "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[FLEN_ERRMSG]; + + if (*status > 0 || nrows == 0) + return(*status); + + /* check input parameters */ + if (firstrow < 1) + { + snprintf(message,FLEN_ERRMSG, "Starting row number is less than 1: %ld (ffgcxui)", + (long) firstrow); + ffpmsg(message); + return(*status = BAD_ROW_NUM); + } + else if (input_first_bit < 1) + { + snprintf(message,FLEN_ERRMSG, "Starting bit number is less than 1: %ld (ffgcxui)", + input_first_bit); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + else if (input_nbits > 16) + { + snprintf(message, FLEN_ERRMSG,"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) + { + snprintf(message, FLEN_ERRMSG,"Specified column number is out of range: %d (ffgcxui)", + colnum); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG," 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[FLEN_ERRMSG]; + + if (*status > 0 || nrows == 0) + return(*status); + + /* check input parameters */ + if (firstrow < 1) + { + snprintf(message, FLEN_ERRMSG,"Starting row number is less than 1: %ld (ffgcxuk)", + (long) firstrow); + ffpmsg(message); + return(*status = BAD_ROW_NUM); + } + else if (input_first_bit < 1) + { + snprintf(message, FLEN_ERRMSG,"Starting bit number is less than 1: %ld (ffgcxuk)", + input_first_bit); + ffpmsg(message); + return(*status = BAD_ELEM_NUM); + } + else if (input_nbits > 32) + { + snprintf(message, FLEN_ERRMSG,"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) + { + snprintf(message, FLEN_ERRMSG,"Specified column number is out of range: %d (ffgcxuk)", + colnum); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG," 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/vendor/cfitsio/getcols.c b/vendor/cfitsio/getcols.c new file mode 100644 index 000000000..a2bfb123b --- /dev/null +++ b/vendor/cfitsio/getcols.c @@ -0,0 +1,992 @@ +/* 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 +#include +/* stddef.h is apparently needed to define size_t */ +#include +#include +#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; + int equivtype; + 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; + ULONGLONG *ullarray; + + 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) + { + snprintf(message, FLEN_ERRMSG,"Specified column number is out of range: %d", + colnum); + ffpmsg(message); + return(*status = BAD_COL_NUM); + } + + /* get equivalent dataype of column (only needed for TLONGLONG columns) */ + ffeqtyll(fptr, colnum, &equivtype, NULL, NULL, status); + if (equivtype < 0) equivtype = abs(equivtype); + + colptr = (fptr->Fptr)->tableptr; /* point to first column */ + colptr += (colnum - 1); /* offset to correct column structure */ + tcode = abs(colptr->tdatatype); + + intcol = 0; + 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); + + /* Special case: TDISPn='Aw' disallowed for numeric types */ + if (dispfmt[0] == 'A') { + cform[0] = 0; + + /* Special case: if the output is intended to be represented + as an integer, but we read it as a double, we need to + set intcol = 1 so it is printed as an integer */ + } else if ((dispfmt[0] == 'I') || (dispfmt[0] == 'i') || + (dispfmt[0] == 'O') || (dispfmt[0] == 'o') || + (dispfmt[0] == 'Z') || (dispfmt[0] == 'z')) { + intcol = 1; + } + } + + 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 if (intcol) + { + snprintf(tmpstr, 400,cform, (int) earray[jj]); + } + else + { + snprintf(tmpstr, 400,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 if (intcol) + { + snprintf(tmpstr, 400,cform, (int) earray[jj]); + } + else + { + snprintf(tmpstr, 400,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); + + /* Special case: TDISPn='Aw' disallowed for numeric types */ + if (dispfmt[0] == 'A') { + cform[0] = 0; + + /* Special case: if the output is intended to be represented + as an integer, but we read it as a double, we need to + set intcol = 1 so it is printed as an integer */ + } else if ((dispfmt[0] == 'I') || (dispfmt[0] == 'i') || + (dispfmt[0] == 'O') || (dispfmt[0] == 'o') || + (dispfmt[0] == 'Z') || (dispfmt[0] == 'z')) { + intcol = 1; + } + } + + 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 if (intcol) + { + snprintf(tmpstr, 400,cform, (int) darray[jj]); + } + else + { + snprintf(tmpstr, 400,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 if (intcol) + { + snprintf(tmpstr, 400,cform, (int) darray[jj]); + } + else + { + snprintf(tmpstr, 400,cform, darray[jj]); + } + + strncat(array[ii], tmpstr, dwidth); + strcat(array[ii], ")"); + jj++; + } + } + + free(darray); /* free the memory */ + } + else if (tcode == TLONGLONG && equivtype == 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) { + strncpy(tmpnull, nulval,79); + tmpnull[79]='\0'; /* In case len(nulval) >= 79 */ + nulwidth = strlen(tmpnull); + } 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 */ + snprintf(tmpstr, 400,"%20I64d", llarray[ii]); +#elif (USE_LL_SUFFIX == 1) + snprintf(tmpstr, 400,"%20lld", llarray[ii]); +#else + snprintf(tmpstr, 400,"%20ld", llarray[ii]); +#endif + *array[ii] = '\0'; + strncat(array[ii], tmpstr, 20); + } + } + + free(flgarray); + free(llarray); /* free the memory */ + + } + else if (tcode == TLONGLONG && equivtype == TULONGLONG) + { + /* allocate memory for the array of ULONGLONG values */ + ullarray = (ULONGLONG *) calloc((size_t) nelem, sizeof(ULONGLONG) ); + flgarray = (char *) calloc((size_t) nelem, sizeof(char) ); + dwidth = 20; /* max width of displayed unsigned long long integer value */ + + if (ffgcfujj(fptr, colnum, firstrow, firstelem, nelem, + ullarray, flgarray, anynul, status) > 0) + { + free(flgarray); + free(ullarray); + return(*status); + } + + /* write the formated string for each value */ + if (nulval) { + strncpy(tmpnull, nulval, 79); + tmpnull[79]='\0'; /* In case len(nulval) >= 79 */ + nulwidth = strlen(tmpnull); + } 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 */ + snprintf(tmpstr, 400, "%20I64u", ullarray[ii]); +#elif (USE_LL_SUFFIX == 1) + snprintf(tmpstr, 400, "%20llu", ullarray[ii]); +#else + snprintf(tmpstr, 400, "%20lu", ullarray[ii]); +#endif + *array[ii] = '\0'; + strncat(array[ii], tmpstr, 20); + } + } + + free(flgarray); + free(ullarray); /* 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); + + /* Special case: TDISPn='Aw' disallowed for numeric types */ + if (dispfmt[0] == 'A') { + cform[0] = 0; + + /* Special case: if the output is intended to be represented + as an integer, but we read it as a double, we need to + set intcol = 1 so it is printed as an integer */ + } else if ((dispfmt[0] == 'I') || (dispfmt[0] == 'i') || + (dispfmt[0] == 'O') || (dispfmt[0] == 'o') || + (dispfmt[0] == 'Z') || (dispfmt[0] == 'z')) { + intcol = 1; + } + } + + 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 if (scaled && tcode == TLONGLONG) + { + /* scaled long 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) { + strncpy(tmpnull, nulval,79); + tmpnull[79]='\0'; + nulwidth = strlen(tmpnull); + } 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) { + snprintf(tmpstr, 400,cform, (int) darray[ii]); + } else { + snprintf(tmpstr, 400,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) + { + snprintf(message, FLEN_ERRMSG,"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 if (scaled && tcode == TLONGLONG) + { + /* scaled long 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' */ + { + int typecode; + long int repeat = 0, rwidth = 0; + int gstatus = 0; + + /* Deal with possible vector string with repeat / width by parsing + the TFORM=rAw keyword */ + if (ffgtcl(fptr, colnum, &typecode, &repeat, &rwidth, &gstatus) == 0 && + rwidth >= 1 && rwidth < repeat) { + *width = rwidth; + + } else { + + /* Hmmm, we couldn't parse the TFORM keyword by standard, so just do + simple parsing */ + 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) + { + snprintf(message, FLEN_ERRMSG,"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; + snprintf(message,FLEN_ERRMSG, + "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/vendor/cfitsio/getcolsb.c b/vendor/cfitsio/getcolsb.c new file mode 100644 index 000000000..0b0ea307c --- /dev/null +++ b/vendor/cfitsio/getcolsb.c @@ -0,0 +1,2045 @@ +/* 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 +#include +#include +#include +#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) + { + snprintf(msg, FLEN_ERRMSG,"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 + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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[FLEN_ERRMSG]; + 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 */ + snprintf(message, FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgclsb).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > 127) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + { + output[ii] = (short) ulltemp; + } + } + } + else 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > 127) + { + *status = OVERFLOW_ERR; + output[ii] = 127; + } + else + { + output[ii] = (short) ulltemp; + } + } + } + } + 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] < -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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG,"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/vendor/cfitsio/getcolui.c b/vendor/cfitsio/getcolui.c new file mode 100644 index 000000000..9875de905 --- /dev/null +++ b/vendor/cfitsio/getcolui.c @@ -0,0 +1,1967 @@ +/* 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 +#include +#include +#include +#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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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, maxelem2, hdutype, xcode, decimals; + long twidth, incre; + long ii, xwidth, ntodo; + int nulcheck; + LONGLONG repeat, startpos, elemnum, readptr, tnull; + LONGLONG rowlen, rownum, remain, next, rowincre, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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 */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX/2) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/2; + } + } + + /*---------------------------------------------------------------------*/ + /* 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 */ + snprintf(message, FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgclui).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > USHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + output[ii] = (unsigned short) ulltemp; + + } + } + 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 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > USHRT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = USHRT_MAX; + } + else + { + output[ii] = (unsigned short) ulltemp; + } + } + } + } + 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 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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message,FLEN_ERRMSG, "Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG,"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/vendor/cfitsio/getcoluj.c b/vendor/cfitsio/getcoluj.c new file mode 100644 index 000000000..c67e8d3f4 --- /dev/null +++ b/vendor/cfitsio/getcoluj.c @@ -0,0 +1,3895 @@ +/* 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 +#include +#include +#include +#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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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, maxelem2, hdutype, xcode, decimals; + long twidth, incre; + long ii, xwidth, ntodo; + int nulcheck; + LONGLONG repeat, startpos, elemnum, readptr, tnull; + LONGLONG rowlen, rownum, remain, next, rowincre, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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) && (LONGSIZE == 32)) /* Special Case: */ + { /* no type convertion required, so read */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX/4) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/4; + } + } + + /*---------------------------------------------------------------------*/ + /* 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): + if (LONGSIZE == 32) { + 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); + } else { /* case where sizeof(long) = 8 */ + ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer, + status); + fffi4u4((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); + 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 */ + snprintf(message,FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgcluj).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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; +*/ +{ + 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 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 == 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 long) 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 < 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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > ULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + output[ii] = (unsigned long) ulltemp; + } + } + 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 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > ULONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = ULONG_MAX; + } + else + { + output[ii] = (unsigned long) ulltemp; + } + } + } + } + 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 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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG,"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); +} + +/* ======================================================================== */ +/* the following routines support the 'long long' data type */ +/* ======================================================================== */ + +/*--------------------------------------------------------------------------*/ +int ffgpvujj(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 */ + ULONGLONG nulval, /* I - value for undefined pixels */ + ULONGLONG *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; + ULONGLONG 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, TULONGLONG, 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); + + ffgclujj(fptr, 2, row, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgpfujj(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 */ + ULONGLONG *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; + ULONGLONG dummy = 0; + + if (fits_is_compressed_image(fptr, status)) + { + /* this is a compressed image in a binary table */ + + fits_read_compressed_pixels(fptr, TULONGLONG, 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); + + ffgclujj(fptr, 2, row, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg2dujj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + ULONGLONG 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 */ + ULONGLONG *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 */ + + ffg3dujj(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array, + anynul, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffg3dujj(fitsfile *fptr, /* I - FITS file pointer */ + long group, /* I - group to read (1 = 1st group) */ + ULONGLONG 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 */ + ULONGLONG *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]; + ULONGLONG 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, TULONGLONG, 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 */ + ffgclujj(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 (ffgclujj(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 ffgsvujj(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 */ + ULONGLONG nulval,/* I - value to set undefined pixels */ + ULONGLONG *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; + ULONGLONG nullvalue; + + if (naxis < 1 || naxis > 9) + { + snprintf(msg, FLEN_ERRMSG, "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, TULONGLONG, 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 + { + snprintf(msg, FLEN_ERRMSG,"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 ( ffgclujj(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 ffgsfujj(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 */ + ULONGLONG *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; + ULONGLONG nulval = 0; + int hdutype, anyf; + char msg[FLEN_ERRMSG]; + int nullcheck = 2; + + if (naxis < 1 || naxis > 9) + { + snprintf(msg, FLEN_ERRMSG,"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, TULONGLONG, 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]) + { + snprintf(msg, FLEN_ERRMSG,"ffgsvujj: 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 ( ffgclujj(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 ffggpujj(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 */ + ULONGLONG *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; + ULONGLONG 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); + + ffgclujj(fptr, 1, row, firstelem, nelem, 1, 1, dummy, + array, &cdummy, &idummy, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcvujj(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 */ + ULONGLONG nulval, /* I - value for null pixels */ + ULONGLONG *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; + + ffgclujj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval, + array, &cdummy, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgcfujj(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 */ + ULONGLONG *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. +*/ +{ + ULONGLONG dummy = 0; + + ffgclujj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy, + array, nularray, anynul, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgclujj( 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 */ + ULONGLONG nulval, /* I - value for null pixels if nultyp = 1 */ + ULONGLONG *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, maxelem2, 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, maxelem; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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; + + convert = 1; + + /*---------------------------------------------------------------------*/ + /* 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); + fffi8u8((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); + fffi4u8((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); + fffi1u8((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); + fffi2u8((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); + fffr4u8((float *) buffer, ntodo, scale, zero, nulcheck, + nulval, &nularray[next], anynul, + &array[next], status); + break; + case (TDOUBLE): + ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status); + fffr8u8((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); + + fffstru8((char *) buffer, ntodo, scale, zero, twidth, power, + nulcheck, snull, nulval, &nularray[next], anynul, + &array[next], status); + break; + + default: /* error trap for invalid column format */ + snprintf(message, 81, + "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) + snprintf(message, 81, + "Error reading elements %.0f thru %.0f from column %d (ffgclj).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message, 81, + "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 fffi1u8(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 */ + ULONGLONG 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 */ + ULONGLONG *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] = (ULONGLONG) input[ii]; /* copy input to output */ + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) 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] = (ULONGLONG) 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 < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi2u8(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 */ + ULONGLONG 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 */ + ULONGLONG *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] = (ULONGLONG) 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 fffi4u8(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 */ + ULONGLONG 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 */ + ULONGLONG *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] = (ULONGLONG) input[ii]; /* copy input to output */ + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_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 if (input[ii] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else + { + output[ii] = (ULONGLONG) 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 < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffi8u8(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 */ + ULONGLONG 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 */ + ULONGLONG *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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + output[ii] = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + } + } + 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] = input[ii]; /* copy input to output */ + } + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) dvalue; + } + } + } + else /* must check for null values */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise 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] = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + } + } + } + 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] = input[ii]; /* copy input to output */ + } + } + } + } + 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 < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr4u8(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 */ + ULONGLONG 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 */ + ULONGLONG *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] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) 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] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) 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 < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffr8u8(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 */ + ULONGLONG 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 */ + ULONGLONG *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] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) input[ii]; + } + } + else /* must scale the data */ + { + for (ii = 0; ii < ntodo; ii++) + { + dvalue = input[ii] * scale + zero; + + if (dvalue < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) 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] < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (input[ii] > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) 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 < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (zero > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) zero; + } + } + else + { + dvalue = input[ii] * scale + zero; + + if (dvalue < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) dvalue; + } + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffstru8(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 */ + ULONGLONG 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 */ + ULONGLONG *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); + snprintf(message, 81, "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 < 0) + { + *status = OVERFLOW_ERR; + output[ii] = 0; + } + else if (dvalue > DULONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT64_MAX; + } + else + output[ii] = (ULONGLONG) dvalue; + } + /* restore the char that was overwritten by the null */ + *tpos = tempstore; + } + return(*status); +} diff --git a/vendor/cfitsio/getcoluk.c b/vendor/cfitsio/getcoluk.c new file mode 100644 index 000000000..185f8c093 --- /dev/null +++ b/vendor/cfitsio/getcoluk.c @@ -0,0 +1,1975 @@ +/* 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 +#include +#include +#include +#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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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) + { + snprintf(msg, FLEN_ERRMSG,"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]) + { + snprintf(msg, FLEN_ERRMSG,"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, maxelem2, hdutype, xcode, decimals; + long twidth, incre; + long ii, xwidth, ntodo; + int nulcheck; + LONGLONG repeat, startpos, elemnum, readptr, tnull; + LONGLONG rowlen, rownum, remain, next, rowincre, maxelem; + char tform[20]; + char message[FLEN_ERRMSG]; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 ) + return(*status); + maxelem = maxelem2; + + 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 */ + /* data directly into output buffer. */ + + if (nelem < (LONGLONG)INT32_MAX/4) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/4; + } + } + + /*---------------------------------------------------------------------*/ + /* 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 */ + snprintf(message, FLEN_ERRMSG, + "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) + snprintf(message,FLEN_ERRMSG, + "Error reading elements %.0f thru %.0f from column %d (ffgcluk).", + dtemp+1., dtemp+ntodo, colnum); + else + snprintf(message,FLEN_ERRMSG, + "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; + ULONGLONG ulltemp; + + if (nullcheck == 0) /* no null checking required */ + { + if (scale == 1. && zero == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > UINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + output[ii] = (unsigned int) ulltemp; + } + } + 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 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 == 9223372036854775808.) + { + /* The column we read contains unsigned long long values. */ + /* Instead of adding 9223372036854775808, it is more efficient */ + /* and more precise 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 + { + ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000); + + if (ulltemp > UINT_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = UINT_MAX; + } + else + { + output[ii] = (unsigned int) ulltemp; + } + } + } + } + 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 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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table"); + ffpmsg(message); + snprintf(message, FLEN_ERRMSG,"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/vendor/cfitsio/getkey.c b/vendor/cfitsio/getkey.c new file mode 100644 index 000000000..f7cc5f306 --- /dev/null +++ b/vendor/cfitsio/getkey.c @@ -0,0 +1,3539 @@ +/* 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 +#include +#include +#include +/* stddef.h is apparently needed to define size_t */ +#include +#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); + + if (nexist) + *nexist = (int) (( ((fptr->Fptr)->headend) - ((fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) ) / 80); + + if (position) + *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); + snprintf(message, FLEN_ERRMSG,"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. +*/ +{ + LONGLONG longval; + ULONGLONG ulongval; + 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 (ffgkyjj(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 (ffgkyjj(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 (ffgkyjj(fptr, keyname, &longval, comm, status) <= 0) + { + if (longval > (unsigned short) USHRT_MAX || longval < 0) + *status = NUM_OVERFLOW; + else + *(unsigned short *) value = (unsigned short) longval; + } + } + else if (datatype == TSHORT) + { + if (ffgkyjj(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 (ffgkyjj(fptr, keyname, &longval, comm, status) <= 0) + { + if (longval > (unsigned int) UINT_MAX || longval < 0) + *status = NUM_OVERFLOW; + else + *(unsigned int *) value = longval; + } + } + else if (datatype == TINT) + { + if (ffgkyjj(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 (ffgkyujj(fptr, keyname, &ulongval, comm, status) <= 0) + { + if (ulongval > ULONG_MAX) + *status = NUM_OVERFLOW; + else + *(unsigned long *) value = ulongval; + } + } + else if (datatype == TLONG) + { + if (ffgkyjj(fptr, keyname, &longval, comm, status) <= 0) + { + if (longval > LONG_MAX || longval < LONG_MIN) + *status = NUM_OVERFLOW; + else + *(int *) value = longval; + } + ffgkyj(fptr, keyname, (long *) value, comm, status); + } + else if (datatype == TULONGLONG) + { + ffgkyujj(fptr, keyname, (ULONGLONG *) 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, namelength; + + namelength = FLEN_KEYWORD - 1; + *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 < namelength; ii++) + { + /* look for string terminator, or a blank */ + if (*(card+ii) != ' ' && *(card+ii) != '=' && *(card+ii) !='\0') + { + *(name+ii) = *(card+ii); + } + else + { + name[ii] = '\0'; + *length = ii; + return(*status); + } + } + + /* if we got here, keyword is namelength characters long */ + name[namelength] = '\0'; + *length = namelength; + } + + 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 ffgksl( fitsfile *fptr, /* I - FITS file pointer */ + const char *keyname, /* I - name of keyword to read */ + int *length, /* O - length of the string value */ + int *status) /* IO - error status */ +/* + Get the length of the keyword value string. + This routine explicitly supports the CONTINUE convention for long string values. +*/ +{ + char valstring[FLEN_VALUE], value[FLEN_VALUE]; + int position, contin, len; + + if (*status > 0) + return(*status); + + ffgkey(fptr, keyname, valstring, NULL, status); /* read the keyword */ + + if (*status > 0) + return(*status); + + ffghps(fptr, NULL, &position, status); /* save the current header position */ + + if (!valstring[0]) { /* null value string? */ + *length = 0; + } else { + ffc2s(valstring, value, status); /* in case string contains "/" char */ + *length = strlen(value); + + /* If last character is a & then value may be continued on next keyword */ + contin = 1; + while (contin) + { + len = strlen(value); + + if (len && *(value+len-1) == '&') /* is last char an anpersand? */ + { + ffgcnt(fptr, value, NULL, status); + if (*value) /* a null valstring indicates no continuation */ + { + *length += strlen(value) - 1; + } + else + { + contin = 0; + } + } + else + { + contin = 0; + } + } + } + + ffmaky(fptr, position - 1, status); /* reset header pointer to the keyword */ + /* since in many cases the program will read */ + /* the string value after getting the length */ + + 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 (may be NULL) */ + int *status) /* IO - error status */ +/* + This is the original routine for reading long string keywords that use + the CONTINUE keyword convention. In 2016 a new routine called + ffgsky / fits_read_string_key was added, which may provide a more + convenient user interface for most applications. + + 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], nextcomm[FLEN_COMMENT]; + int contin, commspace = 0; + 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 (comm) + { + /* remaining space in comment string */ + commspace = FLEN_COMMENT - strlen(comm) - 2; + } + + 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 ampersand? */ + { + ffgcnt(fptr, valstring, nextcomm, 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; + /* Without this, for case of a last CONTINUE statement ending + with a '&', nextcomm would retain the same string from + from the previous loop iteration and the comment + would get concantenated twice. */ + nextcomm[0] = 0; + } + + /* concantenate comment strings (if any) */ + if ((commspace > 0) && (*nextcomm != 0)) + { + strcat(comm, " "); + strncat(comm, nextcomm, commspace); + commspace = FLEN_COMMENT - strlen(comm) - 2; + } + } + else + { + contin = 0; + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffgsky( fitsfile *fptr, /* I - FITS file pointer */ + const char *keyname, /* I - name of keyword to read */ + int firstchar, /* I - first character of string to return */ + int maxchar, /* I - maximum length of string to return */ + /* (string will be null terminated) */ + char *value, /* O - pointer to keyword value */ + int *valuelen, /* O - total length of the keyword value string */ + /* The returned 'value' string may only */ + /* contain a piece of the total string, depending */ + /* on the value of firstchar and maxchar */ + char *comm, /* O - keyword comment (may be NULL) */ + int *status) /* IO - error status */ +/* + Read and return the value of the specified string-valued keyword. + + This new routine was added in 2016 to provide a more convenient user + interface than the older ffgkls routine. + + Read a string keyword, returning up to 'naxchars' characters of the value + starting with the 'firstchar' character. + The input 'value' string must be allocated at least 1 char bigger to + allow for the terminating null character. + + This routine may be used to read continued string keywords that use + the CONTINUE keyword convention, as well as normal string keywords + that are contained within a single header record. + + This routine differs from the ffkls routine in that it does not + internally allocate memory for the returned value string, and consequently + the calling routine does not need to call fffree to free the memory. +*/ +{ + char valstring[FLEN_VALUE], nextcomm[FLEN_COMMENT]; + char *tempstring; + int contin, commspace = 0; + size_t len; + + if (*status > 0) + return(*status); + + tempstring = NULL; /* initialize in case of error */ + *value = '\0'; + if (valuelen) *valuelen = 0; + + ffgkey(fptr, keyname, valstring, comm, status); /* read the keyword */ + + if (*status > 0) + return(*status); + + if (comm) + { + /* remaining space in comment string */ + commspace = FLEN_COMMENT - strlen(comm) - 2; + } + + if (!valstring[0]) /* null value string? */ + { + tempstring = (char *) malloc(1); /* allocate and return a null string */ + *tempstring = '\0'; + } + else + { + /* allocate space, plus 1 for null */ + tempstring = (char *) malloc(strlen(valstring) + 1); + + ffc2s(valstring, tempstring, status); /* convert string to value */ + len = strlen(tempstring); + + /* If last character is a & then value may be continued on next keyword */ + contin = 1; + while (contin && *status <= 0) + { + if (len && *(tempstring+len-1) == '&') /* is last char an anpersand? */ + { + ffgcnt(fptr, valstring, nextcomm, status); + if (*valstring) /* a null valstring indicates no continuation */ + { + *(tempstring+len-1) = '\0'; /* erase the trailing & char */ + len += strlen(valstring) - 1; + tempstring = (char *) realloc(tempstring, len + 1); /* increase size */ + strcat(tempstring, valstring); /* append the continued chars */ + } + else + { + contin = 0; + /* Without this, for case of a last CONTINUE statement ending + with a '&', nextcomm would retain the same string from + from the previous loop iteration and the comment + would get concantenated twice. */ + nextcomm[0] = 0; + } + + /* concantenate comment strings (if any) */ + if ((commspace > 0) && (*nextcomm != 0)) + { + strcat(comm, " "); + strncat(comm, nextcomm, commspace); + commspace = FLEN_COMMENT - strlen(comm) - 2; + } + } + else + { + contin = 0; + } + } + } + + if (tempstring) + { + len = strlen(tempstring); + if (firstchar <= len) + strncat(value, tempstring + (firstchar - 1), maxchar); + free(tempstring); + if (valuelen) *valuelen = len; /* total length of the keyword value */ + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fffree( void *value, /* I - pointer to keyword value */ + int *status) /* IO - error status */ +/* + Free the memory that was previously allocated by CFITSIO, + such as by ffgkls or fits_hdr2str +*/ +{ + 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 */ + char *comm, /* O - continued comment string */ + 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]; + + 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 & comment */ + 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 (LONGLONG) 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 ffgkyujj( fitsfile *fptr, /* I - FITS file pointer */ + const char *keyname, /* I - name of keyword to read */ + ULONGLONG *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 (ULONGLONG) 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 */ + ffc2uj(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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG, "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[FLEN_ERRMSG]; + 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 */ + { + snprintf(message, FLEN_ERRMSG, "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 */ + { + snprintf(sbuff, FLEN_CARD, "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], *equalssign; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, FLEN_KEYWORD - 1); + + lenroot = strlen(keyroot); + + if (lenroot == 0) /* root must be at least 1 char 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'; + equalssign = strchr(card, '='); + if (equalssign == 0) continue; /* keyword has no value */ + + if (equalssign - card - lenroot > 7) + { + return (*status=BAD_KEYCHAR); + } + strncat(keyindex, &card[lenroot], equalssign - card - 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], *equalssign; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, FLEN_KEYWORD - 1); + + lenroot = strlen(keyroot); + + if (lenroot == 0) /* root must be at least 1 char 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'; + equalssign = strchr(card, '='); + if (equalssign == 0) continue; /* keyword has no value */ + + if (equalssign - card - lenroot > 7) + { + return (*status=BAD_KEYCHAR); + } + strncat(keyindex, &card[lenroot], equalssign - card - 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], *equalssign; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, FLEN_KEYWORD - 1); + + lenroot = strlen(keyroot); + + if (lenroot == 0) /* root must be at least 1 char 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'; + equalssign = strchr(card, '='); + if (equalssign == 0) continue; /* keyword has no value */ + + if (equalssign - card - lenroot > 7) + { + return (*status=BAD_KEYCHAR); + } + strncat(keyindex, &card[lenroot], equalssign - card - 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], *equalssign; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, FLEN_KEYWORD - 1); + + lenroot = strlen(keyroot); + + if (lenroot == 0) /* root must be at least 1 char 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'; + equalssign = strchr(card, '='); + if (equalssign == 0) continue; /* keyword has no value */ + + if (equalssign - card - lenroot > 7) + { + return (*status=BAD_KEYCHAR); + } + strncat(keyindex, &card[lenroot], equalssign - card - 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], *equalssign; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, FLEN_KEYWORD - 1); + + lenroot = strlen(keyroot); + + if (lenroot == 0) /* root must be at least 1 char 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'; + equalssign = strchr(card, '='); + if (equalssign == 0) continue; /* keyword has no value */ + + if (equalssign - card - lenroot > 7) + { + return (*status=BAD_KEYCHAR); + } + strncat(keyindex, &card[lenroot], equalssign - card - 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], *equalssign; + + if (*status > 0) + return(*status); + + *nfound = 0; + nend = nstart + nmax - 1; + + keyroot[0] = '\0'; + strncat(keyroot, keyname, FLEN_KEYWORD - 1); + + lenroot = strlen(keyroot); + + if (lenroot == 0) /* root must be at least 1 char 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'; + equalssign = strchr(card, '='); + if (equalssign == 0) continue; /* keyword has no value */ + + if (equalssign - card - lenroot > 7) + { + return (*status=BAD_KEYCHAR); + } + strncat(keyindex, &card[lenroot], equalssign - card - 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. + If colnum = 0, then the validity checking is disabled. +*/ +{ + long dimsize, totalpix = 1; + char *loc, *lastloc, message[FLEN_ERRMSG]; + tcolumn *colptr = 0; + + if (*status > 0) + return(*status); + + if (colnum != 0) { + 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 */ + + return(*status); + } + } + + *naxis = 0; + + loc = strchr(tdimstr, '(' ); /* find the opening quote */ + if (!loc) + { + snprintf(message, FLEN_ERRMSG, "Illegal dimensions format: %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 dimension 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) + { + snprintf(message, FLEN_ERRMSG, "Illegal dimensions format: %s", tdimstr); + return(*status = BAD_TDIM); + } + + if (colnum != 0) { + if ((colptr->tdatatype > 0) && ((long) colptr->trepeat != totalpix)) + { + snprintf(message, FLEN_ERRMSG, + "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[FLEN_ERRMSG]; + 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) + { + snprintf(message, FLEN_ERRMSG, "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) + { + snprintf(message, FLEN_ERRMSG, "Illegal TDIM keyword value: %s", tdimstr); + return(*status = BAD_TDIM); + } + + if ((colptr->tdatatype > 0) && (colptr->trepeat != totalpix)) + { + snprintf(message, FLEN_ERRMSG, + "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[FLEN_ERRMSG]; + 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") ) ) + { + snprintf(message, FLEN_ERRMSG, + "This is not a TABLE extension: %s", value); + ffpmsg(message); + return(*status = NOT_ATABLE); + } + } + + else /* error: 1st keyword of extension != XTENSION */ + { + snprintf(message, FLEN_ERRMSG, + "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) + { + snprintf(message, FLEN_ERRMSG, "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[FLEN_ERRMSG]; + 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") ) ) + { + snprintf(message, FLEN_ERRMSG, + "This is not a TABLE extension: %s", value); + ffpmsg(message); + return(*status = NOT_ATABLE); + } + } + + else /* error: 1st keyword of extension != XTENSION */ + { + snprintf(message, FLEN_ERRMSG, + "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) + { + snprintf(message, FLEN_ERRMSG, "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[FLEN_ERRMSG]; + 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") + ) ) + { + snprintf(message, FLEN_ERRMSG, + "This is not a BINTABLE extension: %s", value); + ffpmsg(message); + return(*status = NOT_BTABLE); + } + } + + else /* error: 1st keyword of extension != XTENSION */ + { + snprintf(message, FLEN_ERRMSG, + "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[FLEN_ERRMSG]; + 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") + ) ) + { + snprintf(message, FLEN_ERRMSG, + "This is not a BINTABLE extension: %s", value); + ffpmsg(message); + return(*status = NOT_BTABLE); + } + } + + else /* error: 1st keyword of extension != XTENSION */ + { + snprintf(message, FLEN_ERRMSG, + "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 + { + snprintf(message, FLEN_ERRMSG, + "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 */ + snprintf(message, FLEN_ERRMSG, + "This is not an IMAGE extension: %s", value); + ffpmsg(message); + } + } + + else /* error: 1st keyword of extension != XTENSION */ + { + snprintf(message, FLEN_ERRMSG, + "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")) + { + snprintf(message, FLEN_ERRMSG, + "Second keyword of the extension is not BITPIX: %s", name); + ffpmsg(message); + return(*status = NO_BITPIX); + } + + if (ffc2ii(value, &longbitpix, status) > 0) + { + snprintf(message, FLEN_ERRMSG, + "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) + { + snprintf(message, FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG,"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 */ + { + snprintf(message, FLEN_ERRMSG, + "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; + + snprintf(message, FLEN_ERRMSG, + "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; + + snprintf(message, FLEN_ERRMSG, + "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; + + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message, FLEN_ERRMSG, + "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; + + snprintf(message, FLEN_ERRMSG, + "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) + { + snprintf(message, FLEN_ERRMSG, + "ffgtkn found unexpected keyword or value for keyword no. %d.", + numkey); + ffpmsg(message); + + snprintf(message, FLEN_ERRMSG, + " Expected positive integer keyword %s, but instead", name); + ffpmsg(message); + + snprintf(message, FLEN_ERRMSG, + " 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) + { + snprintf(message, FLEN_ERRMSG, + "ffgtknjj found unexpected keyword or value for keyword no. %d.", + numkey); + ffpmsg(message); + + snprintf(message, FLEN_ERRMSG, + " Expected positive integer keyword %s, but instead", name); + ffpmsg(message); + + snprintf(message, FLEN_ERRMSG, + " 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) + { + snprintf(message, FLEN_ERRMSG, + "fftkyn found unexpected keyword or value for keyword no. %d.", + numkey); + ffpmsg(message); + + snprintf(message, FLEN_ERRMSG, + " Expected keyword %s with value %s, but", name, value); + ffpmsg(message); + + snprintf(message, FLEN_ERRMSG, + " 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 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/vendor/cfitsio/group.c b/vendor/cfitsio/group.c new file mode 100644 index 000000000..af2f07710 --- /dev/null +++ b/vendor/cfitsio/group.c @@ -0,0 +1,6736 @@ +/* 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 +#include +#include + +#if defined(WIN32) || defined(__WIN32__) +#include /* defines the getcwd function on Windows PCs */ +#endif + +#if defined(unix) || defined(__unix__) || defined(__unix) || defined(HAVE_UNISTD_H) +#include /* 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(fits_strcasecmp(ttype[i],"MEMBER_POSITION") == 0 || + fits_strcasecmp(ttype[i],"MEMBER_VERSION") == 0) + { + snprintf(keyword,FLEN_KEYWORD,"TFORM%d",i+1); + *status = fits_read_key_str(fptr,keyword,keyvalue,comment, + status); + + snprintf(keyword,FLEN_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(fits_strcasecmp(ttype[i],"MEMBER_POSITION") == 0 || + fits_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); + + snprintf(keyword,FLEN_KEYWORD,"TFORM%d",colnum); + + *status = fits_read_key_str(gfptr,keyword,keyvalue,comment, + status); + + snprintf(keyword,FLEN_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(fits_strcasecmp(ttype[i],"MEMBER_XTENSION") == 0 || + fits_strcasecmp(ttype[i],"MEMBER_NAME") == 0 || + fits_strcasecmp(ttype[i],"MEMBER_URI_TYPE") == 0 || + fits_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(fits_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; + snprintf(errstr,FLEN_VALUE,"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; + snprintf(errstr,FLEN_VALUE, + "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; + snprintf(comment,FLEN_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 + */ + + snprintf(keyword,FLEN_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; + snprintf(comment,FLEN_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 */ + + snprintf(keyword,FLEN_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; + + snprintf(comment,FLEN_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(fits_strcasecmp(groupAccess1,"file://") && + fits_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(fits_strcasecmp(memberAccess1,"file://") == 0) + { + if(*memberFileName == '/') + { + strcpy(memberLocation,memberFileName); + } + else + { + strcpy(memberLocation,cwd); + if (strlen(memberLocation)+strlen(memberFileName)+1 > + FLEN_FILENAME-1) + { + ffpmsg("member path and filename is too long (ffgtam)"); + *status = URL_PARSE_ERROR; + continue; + } + 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(fits_strcasecmp(groupAccess1,"file://") == 0) + { + if(*groupFileName == '/') + { + strcpy(groupLocation,groupFileName); + } + else + { + strcpy(groupLocation,cwd); + if (strlen(groupLocation)+strlen(groupFileName)+1 > + FLEN_FILENAME-1) + { + ffpmsg("group path and filename is too long (ffgtam)"); + *status = URL_PARSE_ERROR; + continue; + } + + 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(fits_strcasecmp(groupAccess1,"file://") == 0 && + fits_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) + { + snprintf(keyword,FLEN_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 */ + + snprintf(keyword,FLEN_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,FLEN_FILENAME,groupLocation,status); + + if(groupLocation[0] != '/') + { + strcpy(tmp, cwd); + if (strlen(tmp)+strlen(groupLocation)+1 > + FLEN_FILENAME-1) + { + ffpmsg("path and group location is too long (ffgtam)"); + *status = URL_PARSE_ERROR; + continue; + } + 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,FLEN_FILENAME,groupLocation,status); + + if(groupLocation[0] != '/') + { + strcpy(tmp, cwd); + if (strlen(tmp)+strlen(groupLocation)+1 > + FLEN_FILENAME-1) + { + ffpmsg("path and group location is too long (ffgtam)"); + *status = URL_PARSE_ERROR; + continue; + } + 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 */ + + snprintf(keyword,FLEN_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 */ + + snprintf(keyword,FLEN_KEYWORD,"GRPID%d",(int)ngroups); + fits_insert_key_lng(tmpfptr,keyword,groupExtver, + "EXTVER of Group containing this HDU",status); + + snprintf(keyword,FLEN_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(fits_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) + { + snprintf(keyword,FLEN_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 */ + + snprintf(newKeyword,FLEN_KEYWORD,"GRPID%d",newIndex); + fits_modify_name(mfptr,keyword,newKeyword,status); + + /* If present, update the GRPLCn keyword index */ + + snprintf(keyword,FLEN_KEYWORD,"GRPLC%d",index); + snprintf(newKeyword,FLEN_KEYWORD,"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; + + /* verify the column formats */ + + *status = ffvcfm(gfptr,xtensionCol,extnameCol,extverCol,positionCol, + locationCol,uriCol,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(fits_strcasecmp(xtension,"PRIMARY") == 0) hdutype = IMAGE_HDU; + else if(fits_strcasecmp(xtension,"IMAGE") == 0) hdutype = IMAGE_HDU; + else if(fits_strcasecmp(xtension,"TABLE") == 0) hdutype = ASCII_TBL; + else if(fits_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(fits_strcasecmp(uri,"URL") != 0) + { + *status = FILE_NOT_OPENED; + snprintf(card,FLEN_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,"/"); + if (strlen(cwd)+strlen(grpLocation1)+1 > + FLEN_FILENAME-1) + { + ffpmsg("cwd and group location1 is too long (ffgmop)"); + *status = URL_PARSE_ERROR; + continue; + } + 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); + if (strlen(cwd)+strlen(grpLocation2)+1 > + FLEN_FILENAME-1) + { + ffpmsg("cwd and group location2 is too long (ffgmop)"); + *status = URL_PARSE_ERROR; + continue; + } + 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(fits_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(fits_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); + if (strlen(grpLocation3)+strlen(grpLocation1)+1 > + FLEN_FILENAME-1) + { + ffpmsg("group locations are too long (ffgmrm)"); + *status = URL_PARSE_ERROR; + continue; + } + strcat(grpLocation3,"/"); + strcat(grpLocation3,grpLocation1); + fits_clean_url(grpLocation3,grpLocation1,status); + } + + if(*grpLocation2 != 0 && *grpLocation2 != '/' && + !fits_is_url_absolute(grpLocation2)) + { + strcpy(grpLocation3,cwd); + if (strlen(grpLocation3)+strlen(grpLocation2)+1 > + FLEN_FILENAME-1) + { + ffpmsg("group locations are too long (ffgmrm)"); + *status = URL_PARSE_ERROR; + continue; + } + 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 */ + + snprintf(keyword,FLEN_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 + */ + + snprintf(keyword,FLEN_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 + */ + + snprintf(card,FLEN_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'; + } + + if (strlen(grpLocation3)+strlen(grplc)+1 > + FLEN_FILENAME-1) + { + ffpmsg("group locations are too long (ffgmrm)"); + *status = URL_PARSE_ERROR; + continue; + } + 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) + { + snprintf(keyword,FLEN_KEYWORD,"GRPID%d",found); + *status = fits_delete_key(mfptr,keyword,status); + + snprintf(keyword,FLEN_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(fits_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 ffvcfm(fitsfile *gfptr, int xtensionCol, int extnameCol, int extverCol, + int positionCol, int locationCol, int uriCol, int *status) +{ +/* + Perform validation on column formats to ensure this matches the grouping + format the get functions expect. Particularly want to check widths of + string columns. +*/ + + int typecode=0; + long repeat=0, width=0; + + if (*status != 0) return (*status); + + do { + if (xtensionCol) + { + fits_get_coltype(gfptr, xtensionCol, &typecode, &repeat, &width, status); + if (*status || typecode != TSTRING || repeat != width || repeat > 8) + { + if (*status==0) *status=NOT_GROUP_TABLE; + ffpmsg("Wrong format for Grouping xtension col. (ffvcfm)"); + continue; + } + } + if (extnameCol) + { + fits_get_coltype(gfptr, extnameCol, &typecode, &repeat, &width, status); + if (*status || typecode != TSTRING || repeat != width || repeat > 32) + { + if (*status==0) *status=NOT_GROUP_TABLE; + ffpmsg("Wrong format for Grouping name col. (ffvcfm)"); + continue; + } + } + if (extverCol) + { + fits_get_coltype(gfptr, extverCol, &typecode, &repeat, &width, status); + if (*status || typecode != TINT32BIT || repeat > 1) + { + if (*status==0) *status=NOT_GROUP_TABLE; + ffpmsg("Wrong format for Grouping version col. (ffvcfm)"); + continue; + } + } + if (positionCol) + { + fits_get_coltype(gfptr, positionCol, &typecode, &repeat, &width, status); + if (*status || typecode != TINT32BIT || repeat > 1) + { + if (*status==0) *status=NOT_GROUP_TABLE; + ffpmsg("Wrong format for Grouping position col. (ffvcfm)"); + continue; + } + } + if (locationCol) + { + fits_get_coltype(gfptr, locationCol, &typecode, &repeat, &width, status); + if (*status || typecode != TSTRING || repeat != width || repeat > 256) + { + if (*status==0) *status=NOT_GROUP_TABLE; + ffpmsg("Wrong format for Grouping location col. (ffvcfm)"); + continue; + } + } + if (uriCol) + { + fits_get_coltype(gfptr, uriCol, &typecode, &repeat, &width, status); + if (*status || typecode != TSTRING || repeat != width || repeat > 3) + { + if (*status==0) *status=NOT_GROUP_TABLE; + ffpmsg("Wrong format for Grouping URI col. (ffvcfm)"); + continue; + } + } + } while (0); + 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; + snprintf(card,FLEN_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) + { + snprintf(card,FLEN_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) + { + snprintf(keyword,FLEN_KEYWORD,"GRPID%d",(int)index); + fits_delete_key(mfptr,keyword,status); + + snprintf(keyword,FLEN_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,FLEN_FILENAME,tmpLocation,status); + + if(*tmpLocation != '/') + { + fits_get_cwd(cwd,status); + if (strlen(cwd)+strlen(tmpLocation)+1 > + FLEN_FILENAME-1) + { + ffpmsg("cwd and location are too long (ffgmf)"); + return (*status = URL_PARSE_ERROR); + } + 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(fits_strcasecmp(tmpPtr[0],xtension) != 0) continue; + } + + if(extnameCol != 0) + { + fits_read_col_str(gfptr,extnameCol,i,1,1,nstr,tmpPtr,&dummy,status); + if(fits_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 ==> ignore 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); + if (strlen(cwd)+strlen(mbrLocation1)+1 > + FLEN_FILENAME-1) + { + ffpmsg("cwd and member locations are too long (ffgmf)"); + *status = URL_PARSE_ERROR; + continue; + } + 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); + if (strlen(cwd)+strlen(mbrLocation2)+1 > + FLEN_FILENAME-1) + { + ffpmsg("cwd and member locations are too long (ffgmf)"); + *status = URL_PARSE_ERROR; + continue; + } + 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); + if (strlen(cwd)+strlen(grpLocation1)+1 > + FLEN_FILENAME-1) + { + ffpmsg("cwd and group locations are too long (ffgmf)"); + *status = URL_PARSE_ERROR; + continue; + } + 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); + if (strlen(cwd)+strlen(grpLocation2)+1 > + FLEN_FILENAME-1) + { + ffpmsg("cwd and group locations are too long (ffgmf)"); + *status = URL_PARSE_ERROR; + continue; + } + 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(fits_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(fits_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(fits_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) + { + snprintf(keyword,FLEN_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(fits_strcasecmp(keyvalue,"MEMBER_XTENSION") != 0 && + fits_strcasecmp(keyvalue,"MEMBER_NAME") != 0 && + fits_strcasecmp(keyvalue,"MEMBER_VERSION") != 0 && + fits_strcasecmp(keyvalue,"MEMBER_POSITION") != 0 && + fits_strcasecmp(keyvalue,"MEMBER_LOCATION") != 0 && + fits_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 */ + int maxlength, /* I max number of chars that can be written + to output, including terminating NULL */ + 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,maxlength,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, *saveptr; +#elif defined(VMS) || defined(vms) || defined(__vms) + int i; + char *tmpStr, *saveptr; +#elif defined(macintosh) + char *tmpStr, *saveptr; +#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 = ffstrtok(buff,"/",&saveptr), outpath[0] = 0; + tmpStr != NULL; tmpStr = ffstrtok(NULL,"/",&saveptr)) + { + 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 = ffstrtok(buff,"/",&saveptr), outpath[0] = 0; + tmpStr != NULL; tmpStr = ffstrtok(NULL,"/",&saveptr)) + { + + if(fits_strcasecmp(tmpStr,"FILE:") == 0) + { + /* the next token should contain the DECnet machine name */ + + tmpStr = ffstrtok(NULL,"/",&saveptr); + 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 = ffstrtok(buff,"/",&saveptr), outpath[0] = 0; + tmpStr != NULL; tmpStr = ffstrtok(NULL,"/",&saveptr)) + { + 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 + */ + + if (!getcwd(buff,FLEN_FILENAME)) + { + cwd[0]=0; + ffpmsg("Path and file name too long (fits_get_cwd)"); + return (*status=URL_PARSE_ERROR); + } + +#endif + + /* + convert the cwd string to a URL standard path string + */ + + fits_path2url(buff,FLEN_FILENAME,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(fits_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(fits_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(fits_strcasecmp(tmpStr3,"memkeep://") == 0) + { + strcpy(tmpStr3,"mem://"); + *tmpStr4 = 0; + *tmpStr2 = 0; + tmpIOstate = 1; + } + + /* file residing in shared memory */ + + else if(fits_strcasecmp(tmpStr3,"shmem://") == 0) + { + *tmpStr4 = 0; + *tmpStr2 = 0; + tmpIOstate = 1; + } + + /* file accessed via the ROOT network protocol */ + + else if(fits_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(fits_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(fits_strcasecmp(tmpStr3,"httpfile://") == 0) + { + strcpy(tmpStr1,outfile); + strcpy(tmpStr3,"file://"); + strcpy(tmpStr4,"http://"); + tmpIOstate = 1; + } + + /* FTP accessd file written locally to disk */ + + else if(fits_strcasecmp(tmpStr3,"ftpfile://") == 0) + { + strcpy(tmpStr1,outfile); + strcpy(tmpStr3,"file://"); + strcpy(tmpStr4,"ftp://"); + tmpIOstate = 1; + } + + /* file from STDIN written to disk */ + + else if(fits_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(fits_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(fits_strcasecmp(tmpStr3,"http://") == 0) + { + *tmpStr1 = 0; + strcpy(tmpStr3,"mem://"); + strcpy(tmpStr4,"http://"); + tmpIOstate = 0; + } + + /* HTTP accessed compressed file transferred into memory */ + + else if(fits_strcasecmp(tmpStr3,"httpcompress://") == 0) + { + *tmpStr1 = 0; + strcpy(tmpStr3,"mem://"); + strcpy(tmpStr4,"http://"); + tmpIOstate = 0; + } + + /* FTP accessed file transferred into memory */ + + else if(fits_strcasecmp(tmpStr3,"ftp://") == 0) + { + *tmpStr1 = 0; + strcpy(tmpStr3,"mem://"); + strcpy(tmpStr4,"ftp://"); + tmpIOstate = 0; + } + + /* FTP accessed compressed file transferred into memory */ + + else if(fits_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(fits_strcasecmp(tmpStr3,"stdin://") == 0) + { + *status = URL_PARSE_ERROR; + ffpmsg("cannot make valid URL from stdin:// (fits_get_url)"); + *tmpStr1 = *tmpStr2 = 0; + } + + else if(fits_strcasecmp(tmpStr3,"stdout://") == 0) + { + *status = URL_PARSE_ERROR; + ffpmsg("cannot make valid URL from stdout:// (fits_get_url)"); + *tmpStr1 = *tmpStr2 = 0; + } + + else if(fits_strcasecmp(tmpStr3,"irafmem://") == 0) + { + *status = URL_PARSE_ERROR; + ffpmsg("cannot make valid 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,FLEN_FILENAME-i,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,FLEN_FILENAME-i,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; + char *saveptr; + + 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 = ffstrtok(inURL, "/",&saveptr); /* 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 = ffstrtok(NULL, "/",&saveptr); /* 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); + if (strlen(outURL) + strlen(tmp) + 1 > FLEN_FILENAME-1) + { + outURL[0]=0; + ffpmsg("outURL is too long (fits_clean_url)"); + *status = URL_PARSE_ERROR; + delete_grp_stack(&mystack); + return *status; + } + 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] == '/') + { + if (strlen(relURL)+3 > FLEN_FILENAME-1) + { + *status = URL_PARSE_ERROR; + ffpmsg("relURL too long (fits_url2relurl)"); + return (*status); + } + strcat(relURL,"../"); + } + + /* copy all remaining characters of absURL to the output relURL */ + + if (strlen(relURL) + strlen(absURL+abscount) > FLEN_FILENAME-1) + { + *status = URL_PARSE_ERROR; + ffpmsg("relURL too long (fits_url2relurl)"); + return (*status); + } + 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 + */ + + if (strlen(refURL) > FLEN_FILENAME-1) + { + absURL[0]=0; + ffpmsg("ref URL is too long (fits_relurl2url)"); + *status = URL_PARSE_ERROR; + continue; + } + 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(fits_strncasecmp(tmpStr,"MEM:",4) == 0 || + fits_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; + + if (strlen(tmpStr)+strlen(relURL) > FLEN_FILENAME-1) + { + absURL[0]=0; + ffpmsg("rel + ref URL is too long (fits_relurl2url)"); + *status = URL_PARSE_ERROR; + continue; + } + 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) + { + if (strlen(absURL) + 1 > FLEN_FILENAME-1) + { + absURL[0]=0; + ffpmsg("abs URL is too long (fits_relurl2url)"); + *status = URL_PARSE_ERROR; + return (*status); + } + 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 + */ + + if (strlen(tmpStr)+strlen(relURL) > FLEN_FILENAME-1) + { + absURL[0]=0; + ffpmsg("rel + ref URL is too long (fits_relurl2url)"); + *status = URL_PARSE_ERROR; + continue; + } + 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 */ + int maxlength, /* I max number of chars that may be copied + to outpath, including terminating NULL. */ + 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 outpath length, as specified by the maxlength argument, + should be at least as large as inpath and preferably larger (to hold + any characters that need encoding). If more than maxlength chars are + required for outpath, including the terminating NULL, outpath will + be set to size 0 and an error status will be returned. + + This function was adopted from code in the libwww.a library available + via the W3 consortium + */ +{ + unsigned char a; + + char *p; + char *q; + char *hex = "0123456789ABCDEF"; + int iout=0; + +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 && (iout < maxlength-1) ; p++) + { + a = (unsigned char)*p; + + /* if the charcter requires encoding then process it */ + + if(!( a>=32 && a<128 && (isAcceptable[a-32]))) + { + if (iout+2 < maxlength-1) + { + /* 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]; + iout += 3; + } + else + { + ffpmsg("URL input is too long to encode (fits_encode_url)"); + *status = URL_PARSE_ERROR; + outpath[0] = 0; + return (*status); + } + } + /* else just copy the character as is */ + else + { + *q++ = *p; + iout++; + } + } + + /* null terminate the outpath string */ + + if (*p && (iout == maxlength-1)) + { + ffpmsg("URL input is too long to encode (fits_encode_url)"); + *status = URL_PARSE_ERROR; + outpath[0] = 0; + return (*status); + } + *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 + */ + +{ + 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/vendor/cfitsio/group.h b/vendor/cfitsio/group.h new file mode 100644 index 000000000..8b1aec652 --- /dev/null +++ b/vendor/cfitsio/group.h @@ -0,0 +1,68 @@ +#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 ffvcfm(fitsfile *gfptr, int xtensionCol, int extnameCol, int extverCol, + int positionCol, int locationCol, int uriCol, 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, int maxlength, 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, int maxlength, char *outpath, int *status); + +int fits_unencode_url(char *inpath, char *outpath, int *status); + +int fits_is_url_absolute(char *url); + diff --git a/vendor/cfitsio/grparser.c b/vendor/cfitsio/grparser.c new file mode 100644 index 000000000..0816fdb0c --- /dev/null +++ b/vendor/cfitsio/grparser.c @@ -0,0 +1,1355 @@ +/* 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 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 +#include + +#ifdef sparc +#include +#include +#endif + +#include +#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 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[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 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( fits_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 ((!fits_strcasecmp("HISTORY", cl->name)) + || (!fits_strcasecmp("COMMENT", cl->name)) + || (!fits_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 (!fits_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]; + char *saveptr; + + 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 = ffstrtok(envfiles, ":",&saveptr); NULL != p2; p2 = ffstrtok(NULL, ":",&saveptr)) + { + 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 ((!fits_strcasecmp("T", ngp_curline.value)) || (!fits_strcasecmp("F", ngp_curline.value))) + { ngp_linkey.type = NGP_TTYPE_BOOL; + ngp_linkey.value.b = (fits_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; itokcnt; 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; + } + snprintf(buf,200, "%-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; itokcnt; 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; jtok[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++; + } + snprintf(ngp_linkey.name + l - 1, NGP_MAX_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=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 + { snprintf(grnm, NGP_MAX_STRING,"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++; + } + snprintf(ngp_linkey.name + l - 1, NGP_MAX_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); + + /* This function uses many global variables (local to this file) and + therefore is not thread-safe. */ + FFLOCK; + + if ((NULL == ff) || (NULL == ngp_template)) + { *status = NGP_NUL_PTR; + FFUNLOCK; + 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; + FFUNLOCK; + 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) /* error here means file is corrupted */ + { + FFUNLOCK; + return(*status); + } + 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) { + FFUNLOCK; + return(*status); + } + if (NGP_OK != (*status = ngp_include_file(ngp_template))) { + FFUNLOCK; + 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 + { snprintf(grnm,NGP_MAX_STRING, "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; + FFUNLOCK; + return(r); + } diff --git a/vendor/cfitsio/grparser.h b/vendor/cfitsio/grparser.h new file mode 100644 index 000000000..2a924b6fb --- /dev/null +++ b/vendor/cfitsio/grparser.h @@ -0,0 +1,183 @@ +/* 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_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/vendor/cfitsio/histo.c b/vendor/cfitsio/histo.c new file mode 100644 index 000000000..a81f80620 --- /dev/null +++ b/vendor/cfitsio/histo.c @@ -0,0 +1,3252 @@ +/* Globally defined histogram parameters */ +#include +#include +#include +#include +#include "fitsio2.h" +#include "eval_defs.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; + double amin1, amin2, amin3, amin4; + double maxbin1, maxbin2, maxbin3, maxbin4; + double binsize1, binsize2, binsize3, binsize4; + long incr[5]; + int wtrecip, wtcolnum; + char *wtexpr; + double weight; + char *rowselector; + char *rowselector_cur; + long repeat; + int startCols[5]; + int numIterCols; + iteratorCol *iterCols; + ParseData *parsers; + parseInfo *infos; +} histType; + +/*--------------------------------------------------------------------------*/ +int ffbinse(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? */ + char ***exprs, /* returned with expressions (or 0) */ + int *status) +{ +/* + Parse the extended 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 + bin x(expr), y(expr)=min:max:size, ... + + most other reasonable combinations are supported. The (expr) is an + optional expression that will be calculated on the fly instead of + a table column name. The name is still used for the output pixel + array metadata. + + If expr == 0, then expressions are forbidden. The caller does not + expect expressions. + + If exprs is non-zero, then upon return an array of expressions is + passed back to the caller. Storage may be allocated by this routine, + If *exprs is non-zero upon return, the caller is responsible to + free(*exprs). Upon return, the contains of exprs is, + (*exprs)[0] = expression for column 1 (or 0 if none) + (*exprs)[1] = expression for column 2 (or 0 if none) + (*exprs)[2] = expression for column 3 (or 0 if none) + (*exprs)[3] = expression for column 4 (or 0 if none) + (*exprs)[4] = expression for weighting (or 0 if none) + + If the user specifies a column name and not an expression for bin + axis i, then the corresponding (*exprs)[i] will be a null pointer. + + To be recognized as an expression, the weighting expression must be + enclosed in parentheses. + + Expressions are never allowed using the bin (xcol,ycol) notation. + +*/ + int ii, slen, defaulttype; + char *ptr, tmpname[FLEN_VALUE], *file_expr = NULL; + double dummy; + char *exprbeg[5] = {0}, *exprend[5] = {0}; + int has_exprs = 0; + + if (exprs) (*exprs) = 0; /* initialized output */ + + 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 */ + /* Note that the extended syntax is not allowed here */ + 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 */ + { + exprbeg[ii] = exprend[ii] = 0; + ffbinre(&ptr, colname[ii], &(exprbeg[ii]), &(exprend[ii]), + &minin[ii], &maxin[ii], &binsizein[ii], minname[ii], + maxname[ii], binname[ii], status); + /* Check for expressions */ + if (exprbeg[ii]) has_exprs = 1; + + 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 */ + + exprbeg[4] = exprend[4] = 0; + ffbinre(&ptr, wtname, &(exprbeg[4]), &(exprend[4]), + &dummy, &dummy, wt, tmpname, + tmpname, tmpname, status); + if (exprbeg[4]) has_exprs = 1; + + 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) || + (defaulttype && exprbeg[4])) { + *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 ); + + /* If we found expressions, this is where we accumulate them into + something to be returned to the caller. The start and end of + each expression will be found in exprbeg[] and exprend[], with + the 5th entry being the weight expression if any */ + if (has_exprs) { + size_t nchars = 0; + char *ptr; + for (ii = 0; ii <= 4; ii++) { + nchars += (exprend[ii] - exprbeg[ii]) + 1; /* null terminator */ + } + /* Allocate storage for 5 pointers plus the characters. Caller + is responsible to free(*exprs) which will free both the 5-array + and the character string data. */ + ptr = malloc( sizeof(char *) * 5 + nchars * sizeof(char) ); + if (!ptr) { + ffpmsg("ffbinse: memory allocation failure"); + return(*status = MEMORY_ALLOCATION); + } + + (*exprs) = (char **) ptr; /* Pointer array portion */ + ptr = (char *) (&((*exprs)[5])); /* String portion starts after the pointer array */ + for (ii = 0; ii <= 4; ii++) { + (*exprs)[ii] = ptr; + nchars = (exprend[ii]-exprbeg[ii]); + strncpy(ptr, exprbeg[ii], nchars); + ptr += nchars; + ptr[0] = 0; /* Ensure null terminator */ + ptr ++; /* Advance to next string position */ + } + } + + return(*status); +} + +/*--------------------------------------------------------------------------*/ +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 non-extended expression, but otherwise the same as ffbinse() */ + + return ffbinse(binspec, + imagetype, histaxis, colname, + minin, maxin, binsizein, + minname, maxname, binname, + wt, wtname, recip, + 0, /* No exprs pointer */ + status); + +} + + +/*--------------------------------------------------------------------------*/ +int ffbinre(char **ptr, + char *colname, + char **exprbeg, char **exprend, + 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. + + This is the "extended" binning syntax that allows for an expression + of the form XCOL(expr). The expression must be enclosed in parentheses. + + The start and end of the expression are returned in *exprbeg and *exprend. + If exprbeg and exprend are null pointers then the expression is forbidden. +*/ +{ + int slen, isanumber=0; + char *token=0; + + if (*status > 0) + return(*status); + + slen = fits_get_token2(ptr, " ,=:;(", &token, &isanumber, status); /* get 1st token */ + + if ((*status) || (slen == 0 && (**ptr == '\0' || **ptr == ',' || **ptr == ';')) ) + return(*status); /* a null range string */ + + if (!isanumber && **ptr != ':') + { + /* this looks like the column name */ + + /* Check for case where col name string is empty but '=' + is still there (indicating a following specification string). + Musn't enter this block as token would not have been allocated. */ + if (token) + { + if (strlen(token) > FLEN_VALUE-1) + { + ffpmsg("column name too long (ffbinr)"); + free(token); + return(*status=PARSE_SYNTAX_ERR); + } + if (token[0] == '#' && isdigit((int) token[1]) ) + { + /* omit the leading '#' in the column number */ + strcpy(colname, token+1); + } + else + strcpy(colname, token); + free(token); + token=0; + } + while (**ptr == ' ') /* skip over blanks */ + (*ptr)++; + + /* An optional expression of the form XCOL(expr) is allowed here, but only + if exprbeg and exprend are non-null */ + if (**ptr == '(' && exprbeg && exprend) { + *exprbeg = *ptr; + if ((*exprend = fits_find_match_delim(*ptr+1,')')) == 0) { /* find ')' */ + ffpmsg("bin expression syntax error (ffbinr)"); + return(*status=PARSE_SYNTAX_ERR); + } + *ptr = *exprend; /* Advance pointer past delimeter */ + } + while (**ptr == ' ') (*ptr)++; /* skip over more possible blanks */ + + if (**ptr != '=') + return(*status); /* reached the end */ + + (*ptr)++; /* skip over the = sign */ + + while (**ptr == ' ') /* skip over blanks */ + (*ptr)++; + + /* get specification info */ + slen = fits_get_token2(ptr, " ,:;", &token, &isanumber, status); + if (*status) + return(*status); + } + + if (**ptr != ':') + { + /* This is the first token, and since it is not followed by + a ':' this must be the binsize token. Or it could be empty. */ + if (token) + { + if (!isanumber) + { + if (strlen(token) > FLEN_VALUE-1) + { + ffpmsg("binname too long (ffbinr)"); + free(token); + return(*status=PARSE_SYNTAX_ERR); + } + strcpy(binname, token); + } + else + *binsizein = strtod(token, NULL); + + free(token); + } + + return(*status); /* reached the end */ + } + else + { + /* the token contains the min value */ + if (slen) + { + if (!isanumber) + { + if (strlen(token) > FLEN_VALUE-1) + { + ffpmsg("minname too long (ffbinr)"); + free(token); + return(*status=PARSE_SYNTAX_ERR); + } + strcpy(minname, token); + } + else + *minin = strtod(token, NULL); + free(token); + token=0; + } + } + + (*ptr)++; /* skip the colon between the min and max values */ + slen = fits_get_token2(ptr, " ,:;", &token, &isanumber, status); /* get token */ + if (*status) + return(*status); + + /* the token contains the max value */ + if (slen) + { + if (!isanumber) + { + if (strlen(token) > FLEN_VALUE-1) + { + ffpmsg("maxname too long (ffbinr)"); + free(token); + return(*status=PARSE_SYNTAX_ERR); + } + strcpy(maxname, token); + } + else + *maxin = strtod(token, NULL); + free(token); + token=0; + } + + if (**ptr != ':') + { + free(token); + return(*status); /* reached the end; no binsize token */ + } + + (*ptr)++; /* skip the colon between the max and binsize values */ + slen = fits_get_token2(ptr, " ,:;", &token, &isanumber, status); /* get token */ + if (*status) + return(*status); + + /* the token contains the binsize value */ + if (slen) + { + if (!isanumber) + { + if (strlen(token) > FLEN_VALUE-1) + { + ffpmsg("binname too long (ffbinr)"); + free(token); + return(*status=PARSE_SYNTAX_ERR); + } + strcpy(binname, token); + } + else + *binsizein = strtod(token, NULL); + free(token); + } + + 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. + + This is the non-extended version of the parser which disallows + binning expressions. Only column names are allowed. +*/ +{ + return ffbinre(ptr, colname, 0, 0, + minin, maxin, binsizein, + minname, maxname, binname, + status); +} + +/*--------------------------------------------------------------------------*/ +int ffhist2e(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 */ + char *colexpr[4], /* I - optionally, expression intead of colum */ + 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*/ + char *wtexpr, /* I - optionally, weight expression */ + 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]; + double amin[4], amax[4], binsize[4], weight; + int numIterCols = 0; + int datatypes[4], wtdatatype = 0; + long *repeat, wtrepeat = 0; + char errmsg[FLEN_ERRMSG]; + long vectorRepeat; + + if (*status > 0) + return(*status); + + if (naxis > 4) + { + ffpmsg("histogram has more than 4 dimensions"); + *status = BAD_DIMEN; + goto cleanup; + } + + /* 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 { + *status = BAD_DATATYPE; + goto cleanup; + } + + /* Calculate the binning parameters: */ + /* columm numbers, axes length, min values, max values, and binsizes. */ + + if (fits_calc_binningde( + *fptr, naxis, colname, colexpr, + minin, maxin, binsizein, minname, maxname, binname, + colnum, datatypes, haxes, amin, amax, binsize, + &vectorRepeat, status) > 0) + { + ffpmsg("failed to determine binning parameters"); + goto cleanup; + } + + /* get the histogramming weighting factor, if any */ + if (*wtcol) + { + /* first, look for a keyword with the weight value */ + if (ffgky(*fptr, TDOUBLE, wtcol, &weight, NULL, status) == 0) + { + /* Data type if keyword was found */ + wtdatatype = TDOUBLE; + wtrepeat = 1; + } + else + { + /* 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); + goto cleanup; + } + + /* get the datatype of the column */ + fits_get_eqcoltype(*fptr, wtcolnum, &wtdatatype, + &wtrepeat, NULL, status); + + weight = DOUBLENULLVALUE; + } + } + else if (wtexpr && wtexpr[0]) /* A weighting expression - always TDOUBLE */ + { + /* Initialize the parser so that we can determine the datatype + of the returned type as well as the vector dimensions. The + parsers is kept allocated so we can assemble an iterator that + uses it below. + */ + int naxis1; + long int nelem, naxes[MAXDIMS]; + ParseData lParse; + + ffiprs( *fptr, 0, wtexpr, MAXDIMS, &wtdatatype, &nelem, &naxis1, + naxes, &lParse, status ); + ffcprs( &lParse ); + if (nelem < 0) nelem = 1; /* If it's a constant expression */ + + weight = DOUBLENULLVALUE; + wtrepeat = nelem; + wtdatatype = wtdatatype; + + } + else + { + weight = (double) weightin; + wtrepeat = vectorRepeat; + wtdatatype = TDOUBLE; + } + + /* Make sure weighting column is not an un-binnable data type */ + if (wtdatatype < 0 || wtdatatype == TSTRING || wtdatatype == TBIT || + wtdatatype == TLOGICAL) { + ffpmsg("Invalid datatype for bin weighting factor"); + *status = BAD_DATATYPE; + goto cleanup; + } + + /* And dimensions of weighting must agree with input column data */ + if (wtrepeat != vectorRepeat) { + ffpmsg("Vector dimensions of weighting do not agree with binning columns"); + *status = BAD_DIMEN; + goto cleanup; + } + + if (weight <= 0. && weight != DOUBLENULLVALUE) + { + ffpmsg("Illegal histogramming weighting factor <= 0."); + *status = URL_PARSE_ERROR; + goto cleanup; + } + + if (recip && weight != DOUBLENULLVALUE) { + /* take reciprocal of weight */ + weight = (double) (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"); + goto cleanup; + } + + /* create output FITS image HDU */ + if (ffcrim(histptr, bitpix, naxis, haxes, status) > 0) + { + ffpmsg("failed to create output histogram FITS image"); + goto cleanup; + } + + /* 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"); + goto cleanup; + } + + /* if the table columns have no WCS keywords, then write default keywords */ + fits_write_keys_histoe(*fptr, histptr, naxis, colnum, colname, colexpr, status); + + /* update the WCS keywords for the ref. pixel location, and pixel size */ + fits_rebin_wcsd(histptr, naxis, amin, binsize, status); + + /* now compute the output image by binning the column values */ + if (fits_make_histde(*fptr, histptr, datatypes, bitpix, naxis, haxes, + colnum, colexpr, amin, amax, binsize, + weight, wtcolnum, wtexpr, recip, + selectrow, status) > 0) + { + ffpmsg("failed to calculate new histogram values"); + goto cleanup; + } + + /* finally, close the original file and return ptr to the new image */ + ffclos(*fptr, status); + *fptr = histptr; + + cleanup: + 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) +{ + /* Non-extended-syntax version of ffhist2e() */ + + return ffhist2e(fptr, outfile, imagetype, naxis, colname, 0, + minin, maxin, binsizein, + minname, maxname, binname, + weightin, wtcol, 0, recip, selectrow, status); +} + + +/*--------------------------------------------------------------------------*/ + +/* ffhist3: same as ffhist2, but does not close the original file */ +/* and/or replace the original file pointer */ +fitsfile *ffhist3(fitsfile *fptr, /* I - ptr to table with X and Y cols*/ + 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]; + double amin[4], amax[4], binsize[4], weight; + + if (*status > 0) + return(NULL); + + if (naxis > 4) + { + ffpmsg("histogram has more than 4 dimensions"); + *status = BAD_DIMEN; + return(NULL); + } + + /* 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{ + *status = BAD_DATATYPE; + return(NULL); + } + + /* Calculate the binning parameters: */ + /* columm numbers, axes length, min values, max values, and binsizes. */ + + if (fits_calc_binningd( + fptr, naxis, colname, minin, maxin, binsizein, minname, maxname, binname, + colnum, haxes, amin, amax, binsize, status) > 0) + { + ffpmsg("failed to determine binning parameters"); + return(NULL); + } + + /* get the histogramming weighting factor, if any */ + if (*wtcol) + { + /* first, look for a keyword with the weight value */ + if (fits_read_key(fptr, TDOUBLE, 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(NULL); + } + + weight = DOUBLENULLVALUE; + } + } + else + weight = (double) weightin; + + if (weight <= 0. && weight != DOUBLENULLVALUE) + { + ffpmsg("Illegal histogramming weighting factor <= 0."); + *status = URL_PARSE_ERROR; + return(NULL); + } + + if (recip && weight != DOUBLENULLVALUE) + /* take reciprocal of weight */ + weight = (double) (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(NULL); + } + + /* create output FITS image HDU */ + if (ffcrim(histptr, bitpix, naxis, haxes, status) > 0) + { + ffpmsg("failed to create output histogram FITS image"); + return(NULL); + } + + /* copy header keywords, converting pixel list WCS keywords to image WCS */ + if (fits_copy_pixlist2image(fptr, histptr, 9, naxis, colnum, status) > 0) + { + ffpmsg("failed to copy pixel list keywords to new histogram header"); + return(NULL); + } + + /* 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_wcsd(histptr, naxis, amin, binsize, status); + + /* now compute the output image by binning the column values */ + if (fits_make_histd(fptr, histptr, bitpix, naxis, haxes, colnum, amin, amax, + binsize, weight, wtcolnum, recip, selectrow, status) > 0) + { + ffpmsg("failed to calculate new histogram values"); + return(NULL); + } + + return(histptr); +} +/*--------------------------------------------------------------------------*/ +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 */ + + double amin[4], amax[4], binsize[4], maxbin[4]; + double datamin = DOUBLENULLVALUE, datamax = DOUBLENULLVALUE; + 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: "); + strncat(errmsg, colname[ii], FLEN_ERRMSG-strlen(errmsg)-1); + 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: "); + strncat(errmsg, colname[ii],FLEN_ERRMSG-strlen(errmsg)-1); + ffpmsg(errmsg); + return(*status = BAD_DATATYPE); + } + + /* get the datatype of the column */ + fits_get_eqcoltype(*fptr, histData.hcolnum[ii], &datatype, + NULL, NULL, status); + + if (datatype < 0 || datatype == TSTRING) + { + strcpy(errmsg, "Inappropriate datatype; can't bin this column: "); + strncat(errmsg, colname[ii],FLEN_ERRMSG-strlen(errmsg)-1); + 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, TDOUBLE, 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: "); + strncat(errmsg, colname[ii],FLEN_ERRMSG-strlen(errmsg)-1); + ffpmsg(errmsg); + return(*status); + } + } + } + else + { + amin[ii] = (double) minin[ii]; + } + + if (maxin[ii] == DOUBLENULLVALUE) + { + ffkeyn("TLMAX", histData.hcolnum[ii], keyname, status); + if (ffgky(*fptr, TDOUBLE, keyname, &amax[ii], NULL, status) > 0) + { + *status = 0; + if(datamax != DOUBLENULLVALUE) /* 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: "); + strncat(errmsg, colname[ii],FLEN_ERRMSG-strlen(errmsg)-1); + 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] = (double) 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] = (double) -binsizein[ii]; /* reverse the sign of binsize */ + else + binsize[ii] = (double) 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 && (double) imin == amin[ii] && + (double) imax == amax[ii] && + (double) 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] = (double) (haxes[ii] + 1.); /* add 1. instead of .5 to avoid roundoff */ + + if (amin[ii] < amax[ii]) + { + amin[ii] = (double) (amin[ii] - 0.5); + amax[ii] = (double) (amax[ii] + 0.5); + } + else + { + amin[ii] = (double) (amin[ii] + 0.5); + amax[ii] = (double) (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, TDOUBLE, 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 = DOUBLENULLVALUE; + } + } + else + histData.weight = (double) weightin; + + if (histData.weight <= 0. && histData.weight != DOUBLENULLVALUE) + { + ffpmsg("Illegal histogramming weighting factor <= 0."); + return(*status = URL_PARSE_ERROR); + } + + if (recip && histData.weight != DOUBLENULLVALUE) + /* take reciprocal of weight */ + histData.weight = (double) (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); +} +/*--------------------------------------------------------------------------*/ +/* Single-precision version */ +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) +{ + double amind[4], amaxd[4], binsized[4]; + + fits_calc_binningd(fptr, naxis, colname, minin, maxin, binsizein, minname, maxname, binname, + colnum, haxes, amind, amaxd, binsized, status); + + /* Copy double precision values into single precision */ + if (*status == 0) { + int i, naxis1 = 4; + if (naxis < naxis1) naxis1 = naxis; + for (i=0; i 0) + return(*status); + + /* Initialize the number of iterator columns required */ + if (repeat) (*repeat) = 0; + + 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' && + (colexpr == 0 || colexpr[ii] == 0 || colexpr[ii][0] == '\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 */ + colnum[ii] = 0; + if (colexpr == 0 || colexpr[ii] == 0 || colexpr[ii][0] == '\0') + { + if (ffgcno(fptr, CASEINSEN, colname[ii], colnum+ii, status) > 0) + { + strcpy(errmsg, "column for histogram axis doesn't exist: "); + strncat(errmsg, colname[ii],FLEN_ERRMSG-strlen(errmsg)-1); + ffpmsg(errmsg); + return(*status); + } + + /* ================================================================ */ + /* check tha column is not a vector or a string */ + + /* get the datatype of the column */ + fits_get_eqcoltype(fptr, colnum[ii], &datatype, + &repeat1, NULL, status); + + ncols = 1; /* Require only one iterator column, the actual column */ + + } else { /* column expression: use parse to determine datatype and dimensions */ + + long nelem, naxes[MAXDIMS]; + int naxis; + ParseData lParse; + + /* Initialize the parser so that we can determine the datatype + of the returned type as well as the vector dimensions */ + if ( ffiprs( fptr, 0, colexpr[ii], MAXDIMS, &datatype, &nelem, &naxis, + naxes, &lParse, status ) ) { + snprintf(errmsg, FLEN_ERRMSG, + "Parser error of binning expression: %s", + colexpr[ii]); + ffpmsg(errmsg); + return *status; + } + if (nelem < 0) nelem = 1; /* If it's a constant expression */ + + repeat1 = nelem; + + /* We require lParse.nCols columns to be read from input, + plus one for the Temporary calculator result */ + ncols = lParse.nCols + 1; + ffcprs( &lParse ); + } + + /* Not sure why this repeat limitation is here -- CM + The iterator system can handle vector columns just fine +` */ + if (datatype < 0 || datatype == TSTRING) + { + strcpy(errmsg, "Inappropriate datatype; can't bin this column: "); + strncat(errmsg, colname[ii],FLEN_ERRMSG-strlen(errmsg)-1); + ffpmsg(errmsg); + return(*status = BAD_DATATYPE); + } + + /* Store repeat value for future use */ + if (repeat) { + if (ii == 0) { + *repeat = repeat1; /* First time around save the repeat value */ + + } else if (*repeat != repeat1) { /* later dimensions, keep same dims */ + + strcpy(errmsg, "Vector repeat of input columns do not agree"); + ffpmsg(errmsg); + return (*status = BAD_DIMEN); + } + } + + if (datatypes) datatypes[ii] = datatype; + + /* ================================================================ */ + /* get the minimum value */ + + datamin = DOUBLENULLVALUE; + datamax = DOUBLENULLVALUE; + + 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] = (double) minin[ii]; + } + else if (colexpr == 0 || colexpr[ii] == 0 || colexpr[ii][0] == '\0') + { + ffkeyn("TLMIN", colnum[ii], keyname, status); + if (ffgky(fptr, TDOUBLE, 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: "); + strncat(errmsg, colname[ii],FLEN_ERRMSG-strlen(errmsg)-1); + ffpmsg(errmsg); + return(*status); + } + } + } else { /* it's an expression */ + if (fits_get_expr_minmax(fptr, colexpr[ii], amin+ii, &datamax, 0, status) > 0) + { + strcpy(errmsg, "Error calculating datamin and datamax for expression: "); + ffpmsg(errmsg); + ffpmsg(colexpr[ii]); + return(*status); + } + if (amin[ii] == DOUBLENULLVALUE) amin[ii] = 0.0; + + } + + /* ================================================================ */ + /* 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] = (double) maxin[ii]; + } + else if (colexpr == 0 || colexpr[ii] == 0 || colexpr[ii][0] == '\0') + { + ffkeyn("TLMAX", colnum[ii], keyname, status); + if (ffgky(fptr, TDOUBLE, keyname, &amax[ii], NULL, status) > 0) + { + *status = 0; + if(datamax != DOUBLENULLVALUE) /* 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: "); + strncat(errmsg, colname[ii],FLEN_ERRMSG-strlen(errmsg)-1); + 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 { /* it's an expression */ + + if (fits_get_expr_minmax(fptr, colexpr[ii], &datamin, &amax[ii], 0, status) > 0) + { + strcpy(errmsg, "Error calculating datamin and datamax for expression: "); + ffpmsg(errmsg); + ffpmsg(colexpr[ii]); + return(*status); + } + if (amax[ii] == DOUBLENULLVALUE) amin[ii] = 1.0; + use_datamax = 1; + } + + + /* ================================================================ */ + /* 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] = (double) binsizein[ii]; + } + else + { + tstatus = 0; + + if (colexpr == 0 || colexpr[ii] == 0 || colexpr[ii][0] == '\0') + { + ffkeyn("TDBIN", colnum[ii], keyname, &tstatus); + ffgky(fptr, TDOUBLE, keyname, binsizein + ii, NULL, &tstatus); + } + + if (tstatus || + colexpr && colexpr[ii] && colexpr[ii][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 && (double) imin == amin[ii] && + (double) imax == amax[ii] && + (double) 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] = (double) (amin[ii] - 0.5); + amax[ii] = (double) (amax[ii] + 0.5); + } + else + { + amin[ii] = (double) (amin[ii] + 0.5); + amax[ii] = (double) (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); +} + +/* Double precision version, with non-extended syntax */ +int fits_calc_binningd( + 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 */ + double *amin, /* O - lower bound of the histogram axes */ + double *amax, /* O - upper bound of the histogram axes */ + double *binsize, /* O - width of histogram bins/pixels on each axis */ + int *status) +/* + Calculate the actual binning parameters, non-extended-syntax version +*/ +{ + return fits_calc_binningde(fptr, naxis, colname, 0, + minin, maxin, binsizein, + minname, maxname, binname, + colnum, 0, haxes, amin, amax, binsize, 0, + status); +} + + +/*--------------------------------------------------------------------------*/ +int fits_write_keys_histoe( + 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) */ + char colname[4][FLEN_VALUE], /* I - if expression, then column name to use */ + char *colexpr[4], /* I - if expression, then column name to use */ + 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; + + if (colexpr && colexpr[ii] && colexpr[ii][0] && colname[ii]) + { + /* Column expression: we need to put the column name from the binning expression */ + ffkeyn("CTYPE", ii + 1, keyname, &tstatus); + ffpky(histptr, TSTRING, keyname, colname[ii], "Coordinate Type", &tstatus); + } + else + { + /* Column name */ + 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_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) +{ + return fits_write_keys_histoe(fptr, histptr, naxis, colnum, 0, 0, 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) +{ + double amind[4], binsized[4]; + + /* Copy single precision values into double precision */ + if (*status == 0) { + int i, naxis1 = 4; + if (naxis < naxis1) naxis1 = naxis; + for (i=0; i 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); +} +/*--------------------------------------------------------------------------*/ +/* Single-precision version */ +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) +{ + double amind[4], amaxd[4], binsized[4], weightd; + + /* Copy single precision values into double precision */ + if (*status == 0) { + int i, naxis1 = 4; + if (naxis < naxis1) naxis1 = naxis; + for (i=0; i 0) + return(*status); + + /* Make sure the parser information is initialized because we will + use this to determine what needs to be deallocated at the end */ + memset(infos, 0, sizeof(infos)); + memset(parsers, 0, sizeof(parsers)); + memset(&histData, 0, sizeof(histData)); + + 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); + + /* Resolve the conflict between wtexpr, wtcolnum, and weight */ + if ( ((wtcolnum > 0) || (wtexpr && wtexpr[0])) && weight == 0 ) weight = DOUBLENULLVALUE; + histData.weight = weight; + histData.wtcolnum = wtcolnum; + histData.wtexpr = wtexpr; + histData.wtrecip = recip; + histData.tblptr = fptr; + histData.himagetype = imagetype; + histData.haxis = naxis; + histData.rowselector = selectrow; + + /* Now make iterator columns for input, as well as any calculated values */ + numAllocCols = 5; + iterCols = fits_recalloc(0, 0, numAllocCols, sizeof(iteratorCol)); + if (!iterCols) { + ffpmsg("memory allocation failure (fits_make_histde)"); + *status = MEMORY_ALLOCATION; + goto cleanup; + } + + /* We fill the iterCols in order, starting from column 1 through 4, and + then moving on to the weighting column */ + for (ii = 0; ii < 5; ii++) histData.startCols[ii] = -1; + startCol = 0; + + /* Loop through each axis and recheck the binning parameters */ + for (ii = 0; ii < naxis; ii++) + { + long colrepeat = 0; + int datatype; + histData.startCols[ii] = startCol; + + taxes[ii] = (double) 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 and repeat */ + if (! (colexpr && colexpr[ii] && colexpr[ii][0]) ) { + fits_get_eqcoltype(fptr, colnum[ii], &datatype, &colrepeat, NULL, status); + } + + /* If caller specified datatype, use that */ + if (datatypes && datatypes[ii]) { + datatype = datatypes[ii]; + } + + if (datatype <= TLONG && (double) imin == tmin[ii] && + (double) imax == tmax[ii] && + (double) 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]; + } + + /* This is a column expression. Here is where we allocate the + parser for it during the actual evaluation. */ + if (colexpr && colexpr[ii] && colexpr[ii][0]) { + int datatype, naxis1; + long nelem, naxes[MAXDIMS]; + int jj; + + /* Initialize the parser for this binning expression */ + ffiprs( fptr, 0, colexpr[ii], MAXDIMS, &datatype, &nelem, &naxis1, + naxes, &(parsers[ii]), status ); + if (*status) goto cleanup; + if (nelem < 0) nelem = 1; /* If it's a constant expression */ + + colrepeat = nelem; + + /* Set up the parser data for evaluation to a TemporaryCol */ + fits_get_num_rows(fptr, &nrows, status); + if (fits_parser_set_temporary_col(&(parsers[ii]), &(infos[ii]), nrows, + (void *) &(double_nulval), status)) goto cleanup; + + /* Copy iterator columns from the parser to the master iterator columns */ + iterCols = fits_recalloc(iterCols, numAllocCols, numAllocCols+parsers[ii].nCols, + sizeof(iteratorCol)); + if (!iterCols) { + *status = MEMORY_ALLOCATION; + goto cleanup; + } + numAllocCols += parsers[ii].nCols; + for (jj = 0; jj < parsers[ii].nCols; jj++) iterCols[startCol++] = parsers[ii].colData[jj]; + + } else { + + /* Just a "regular" column name, we already have enough allocated for these */ + fits_iter_set_by_num(&(iterCols[startCol]), fptr, colnum[ii], TDOUBLE, InputCol); + startCol ++; + } + + /* Check that all the vector dimensions agree */ + if (repeat == 0) { + repeat = colrepeat; + } else { + if (repeat != colrepeat) { + ffpmsg("vector dimensions of binning values do not agree"); + *status = BAD_DIMEN; + goto cleanup; + } + } + + } /* End of loop over columns */ + + /* Now initialize the iterator column data for the weighting */ + if (wtexpr && wtexpr[0] && weight == DOUBLENULLVALUE) { + int wtdatatype, wtnaxis; + long wtnaxes[MAXDIMS]; + int jj; + + histData.startCols[4] = startCol; + ffiprs( fptr, 0, wtexpr, MAXDIMS, &wtdatatype, &wtrepeat, &wtnaxis, + wtnaxes, &(parsers[4]), status ); + if (*status) goto cleanup; + if (wtrepeat < 0) wtrepeat = 1; /* If it's a constant expression */ + + /* Set up the parser data for evaluation to a TemporaryCol */ + /* It's a weighting expression, set that up and ... */ + fits_get_num_rows(fptr, &nrows, status); + if (fits_parser_set_temporary_col(&(parsers[4]), &(infos[4]), nrows, + (void *) &(double_nulval), status)) goto cleanup; + + /* Copy iterator columns from the parser to the master iterator columns */ + iterCols = fits_recalloc(iterCols, numAllocCols, numAllocCols+parsers[4].nCols, + sizeof(iteratorCol)); + if (!iterCols) { + *status = MEMORY_ALLOCATION; + goto cleanup; + } + numAllocCols += parsers[ii].nCols; + for (jj = 0; jj < parsers[4].nCols; jj++) iterCols[startCol++] = parsers[4].colData[jj]; + + } else if (weight == DOUBLENULLVALUE) { + int wtdatatype; + + /* It's a "regular" weighting column */ + fits_get_eqcoltype(fptr, wtcolnum, &wtdatatype, &wtrepeat, NULL, status); + + histData.startCols[4] = startCol; + fits_iter_set_by_num(&(iterCols[startCol]), fptr, wtcolnum, TDOUBLE, InputCol); + startCol ++; + } else { + + /* In case of explicit numerical value, we can just use that number + in the vector expression, so the vector repeat of the weighting can + be set to that of the input */ + wtrepeat = repeat; + } + + /* Vector dimension of weighting must agree with binning */ + if (wtrepeat != 0 && repeat != 0 && wtrepeat != repeat) { + ffpmsg("vector dimensions of weights do not agree with bins"); + *status = BAD_DIMEN; + goto cleanup; + } + + /* We now know he number of iterator columns */ + numIterCols = startCol; + + /* Fill in iterator information for the parser*/ + histData.numIterCols = numIterCols; + histData.iterCols = iterCols; + histData.parsers = parsers; + histData.infos = infos; + histData.repeat = repeat; + + /* 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]; + histData.incr[0] = 1; + + 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]; + histData.incr[1] = histData.incr[0] * histData.haxis1; + + 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]; + histData.incr[2] = histData.incr[1] * histData.haxis2; + + 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]; + histData.incr[3] = histData.incr[2] * histData.haxis3; + } + } + } + + /* 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); + + cleanup: + /* Free any allocated memory ... */ + if (iterCols) free(iterCols); + /* ... and parsers */ + for (ii = 0; ii <= 4; ii ++) { + if (parsers[ii].nCols > 0) ffcprs(&(parsers[ii])); + } + return(*status); +} + +/* Double-precision version, non-extended syntax */ +int fits_make_histd(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) */ + double *amin, /* I - minimum histogram value, for each axis */ + double *amax, /* I - maximum histogram value, for each axis */ + double *binsize, /* I - bin size along each axis */ + double 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) +{ + return fits_make_histde(histptr, 0, 0, bitpix, naxis, naxes, + colnum, 0, + amin, amax, binsize, + weight, wtcolnum, 0, recip, + selectrow, status); +} + +/*--------------------------------------------------------------------------*/ +int fits_get_col_minmax(fitsfile *fptr, int colnum, double *datamin, + double *datamax, int *status) +/* + Simple utility routine to compute the min and max value in a column +*/ +{ + int anynul; + long nrows, ntodo, firstrow, ii; + double array[1000], nulval; + + ffgky(fptr, TLONG, "NAXIS2", &nrows, NULL, status); /* no. of rows */ + + firstrow = 1; + nulval = DOUBLENULLVALUE; + *datamin = 9.0E36; + *datamax = -9.0E36; + + while(nrows) + { + ntodo = minvalue(nrows, 100); + ffgcv(fptr, TDOUBLE, 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); +} + +struct histo_minmax_workfn_struct { + parseInfo *Info; + double datamin, datamax; + long ntotal, ngood; +}; + +/*---------------------------------------------------------------------------*/ +static int histo_minmax_expr_workfn( 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 evaluates a parser result and computes */ +/* min max value */ +/*---------------------------------------------------------------------------*/ +{ + int status = 0; + long i; + double *data; + double nulval; + struct histo_minmax_workfn_struct *wf = ((struct histo_minmax_workfn_struct *)userPtr); + struct ParseStatusVariables *pv = &(wf->Info->parseVariables); + iteratorCol *outcol = &(colData[nCols-1]); + + /* Call calculator work function. Result is put in final column of colData as a TemporaryCol */ + status = fits_parser_workfn(totalrows, offset, firstrow, nrows, + nCols, colData, (void *) wf->Info); + + /* The result of the calculation is in pv->Data, and null value in pv->Null */ + data = (double *)(outcol->array); + nulval = *((double *)(wf->Info->nullPtr)); + + for (i = 1; i<=(nrows*pv->repeat); i++ ) { + /* Note that data[0] == 0 indicates no null values at all!!! */ + if (data[0] == 0 || data[i] != nulval) { + if (data[i] < wf->datamin || wf->datamin == DOUBLENULLVALUE) wf->datamin = data[i]; + if (data[i] > wf->datamax || wf->datamax == DOUBLENULLVALUE) wf->datamax = data[i]; + wf->ngood ++; + } + wf->ntotal ++; + } + + return status; +} + + +/*--------------------------------------------------------------------------*/ +int fits_get_expr_minmax(fitsfile *fptr, char *expr, double *datamin, + double *datamax, int *datatype, int *status) +/* + Simple utility routine to compute the min and max value in an expression +*/ +{ + parseInfo Info; + ParseData lParse; + struct histo_minmax_workfn_struct minmaxWorkFn; + int naxis, constant, typecode, newNullKwd=0; + long nelem, naxes[MAXDIMS], repeat, width, nrows; + int col_cnt, colNo; + Node *result; + char card[81], tform[16], nullKwd[9], tdimKwd[9]; + double double_nulval = DOUBLENULLVALUE; + + if( *status ) return( *status ); + + memset(&minmaxWorkFn, 0, sizeof(minmaxWorkFn)); + memset(&Info, 0, sizeof(Info)); + memset(&lParse, 0, sizeof(lParse)); + if (datatype) *datatype = 0; + + ffgky(fptr, TLONG, "NAXIS2", &nrows, NULL, status); /* no. of rows */ + + if( ffiprs( fptr, 0, expr, MAXDIMS, &Info.datatype, &nelem, &naxis, + naxes, &lParse, status ) ) { + + ffcprs(&lParse); + return( *status ); + } + + if (datatype) *datatype = Info.datatype; + + if( nelem<0 ) { /* Constant already computed */ + result = lParse.Nodes + lParse.resultNode; + switch( Info.datatype ) { + case TDOUBLE: *datamin = *datamax = result->value.data.dbl; break; + case TLONG: *datamin = *datamax = (double) result->value.data.lng; break; + case TLOGICAL:*datamin = *datamax = (double) ((result->value.data.log == 1)?1:0); break; + case TBIT: *datamin = *datamax = (double) ((result->value.data.str[0])?1:0); break; + } + ffcprs(&lParse); + return( *status ); + } + + Info.parseData = &lParse; + + /* Add a temporary column which contains the expression value */ + if ( fits_parser_set_temporary_col( &lParse, &Info, nrows, &double_nulval, status) ) { + ffcprs(&lParse); + return( *status ); + } + + /* Initialize the work function computing min/max */ + minmaxWorkFn.Info = &Info; + minmaxWorkFn.datamin = minmaxWorkFn.datamax = DOUBLENULLVALUE; + minmaxWorkFn.ntotal = minmaxWorkFn.ngood = 0; + + if( ffiter( lParse.nCols, lParse.colData, 0, 0, + histo_minmax_expr_workfn, (void*)&minmaxWorkFn, status ) == -1 ) + *status = 0; /* -1 indicates exitted without error before end... OK */ + + if (datamin) *datamin = minmaxWorkFn.datamin; + if (datamax) *datamax = minmaxWorkFn.datamax; + + ffcprs(&lParse); + 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; + 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; + } + + /* 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 */ + fits_iterate_data(histData->numIterCols, histData->iterCols, + offset, rows_per_loop, + ffcalchist, (void*)histData, &status); + + 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; + double pix, axisbin; + char *rowselect; + histType *histData = (histType*)userPointer; + double *colptr[MAXDIMS] = {0}; + int status = 0; + long irow; + + if (firstrow == 1) { + histData->rowselector_cur = histData->rowselector; + } + rowselect = histData->rowselector_cur; + + for (ii=0; ii<=4; ii++) { + int startCol = histData->startCols[ii]; + iteratorCol *outcol = 0; + /* Call calculator work function. Result is put in final column of colData as a TemporaryCol */ + colptr[ii] = 0; + + /* Do not process unspecified axes (but do process weight column) */ + if ( (ii >= histData->haxis && ii != 4) || histData->startCols[ii] < 0) continue; + + /* We have a parser for this, evaluate it */ + if (histData->parsers[ii].nCols > 0) { + struct ParseStatusVariables *pv = &(histData->infos[ii].parseVariables); + iteratorCol *colData = &(histData->iterCols[startCol]); + int nCols = histData->parsers[ii].nCols; + + status = fits_parser_workfn(totalrows, offset, firstrow, nrows, + nCols, colData, (void *) &(histData->infos[ii])); + if (status) return status; + /* Output column is last iterator column, which better be a TemporaryCol */ + outcol = &(colData[nCols-1]); + + } else { + outcol = &(histData->iterCols[startCol]); + } + + if (outcol) { + /* Note that the 0th array element returned by the iterator is + actually the null value! This is actually rather a big + undocumented "feature" of the iterator. However, "ii" below + starts at a value of 1 which skips over the null value */ + colptr[ii] = ((double *) fits_iter_get_array(outcol)); + } + } + + /* Main loop over rows */ + /* irow = row counter (1 .. nrows) */ + /* elem = counter of element (1 .. histData->repeat) for each row */ + /* ii = counts up from 1 (see note below) used to index colptr[]'s */ + + /* Note that ii starts at 1 because position [0] in the + column data arrays is for the "null" value! */ + for (ii = 1, irow = 1; irow <= nrows; irow++) + { + long elem; + 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 */ + + ii += histData->repeat; /* skip this portion of data */ + continue; + } + } + + + /* Loop over elements in each row, increment ii after each element */ + + for (elem = 1; elem <= histData->repeat; elem++, ii++) { + if (colptr[0][ii] == DOUBLENULLVALUE) /* test for null value */ + continue; + if (colptr[4] && colptr[4][ii] == DOUBLENULLVALUE) /* and null weight */ + continue; + + pix = (colptr[0][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 (colptr[1][ii] == DOUBLENULLVALUE) + continue; + + axisbin = (colptr[1][ii] - histData->amin2) / histData->binsize2; + iaxisbin = (long) axisbin; + + if (axisbin < 0. || iaxisbin >= histData->haxis2 || axisbin > histData->maxbin2) + continue; + + ipix += (iaxisbin * histData->incr[1]); + + if (histData->haxis > 2) + { + if (colptr[2][ii] == DOUBLENULLVALUE) + continue; + + axisbin = (colptr[2][ii] - histData->amin3) / histData->binsize3; + iaxisbin = (long) axisbin; + if (axisbin < 0. || iaxisbin >= histData->haxis3 || axisbin > histData->maxbin3) + continue; + + ipix += (iaxisbin * histData->incr[2]); + + if (histData->haxis > 3) + { + if (colptr[3][ii] == DOUBLENULLVALUE) + continue; + + axisbin = (colptr[3][ii] - histData->amin4) / histData->binsize4; + iaxisbin = (long) axisbin; + if (axisbin < 0. || iaxisbin >= histData->haxis4 || axisbin > histData->maxbin4) + continue; + + ipix += (iaxisbin * histData->incr[3]); + + } /* end of haxis > 3 case */ + } /* end of haxis > 2 case */ + } /* end of haxis > 1 case */ + + /* increment the histogram pixel */ + if (histData->weight != DOUBLENULLVALUE) /* constant weight factor */ + { /* Note that if wtrecip == 1, the reciprocal was precomputed above */ + 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./colptr[4][ii]); + else if (histData->himagetype == TSHORT) + histData->hist.i[ipix] += (short) (1./colptr[4][ii]); + else if (histData->himagetype == TFLOAT) + histData->hist.r[ipix] += (float) (1./colptr[4][ii]); + else if (histData->himagetype == TDOUBLE) + histData->hist.d[ipix] += 1./colptr[4][ii]; + else if (histData->himagetype == TBYTE) + histData->hist.b[ipix] += (char) (1./colptr[4][ii]); + } + else /* no weights */ + { + if (histData->himagetype == TINT) + histData->hist.j[ipix] += (int) colptr[4][ii]; + else if (histData->himagetype == TSHORT) + histData->hist.i[ipix] += (short) colptr[4][ii]; + else if (histData->himagetype == TFLOAT) + histData->hist.r[ipix] += colptr[4][ii]; + else if (histData->himagetype == TDOUBLE) + histData->hist.d[ipix] += colptr[4][ii]; + else if (histData->himagetype == TBYTE) + histData->hist.b[ipix] += (char) colptr[4][ii]; + } + + } /* end of loop over elements per row */ + + } /* end of main loop over all rows */ + + histData->rowselector_cur = rowselect; /* Save row pointer for next go-round */ + return(status); +} + diff --git a/vendor/cfitsio/imcompress.c b/vendor/cfitsio/imcompress.c new file mode 100644 index 000000000..ce3ab0fb9 --- /dev/null +++ b/vendor/cfitsio/imcompress.c @@ -0,0 +1,9955 @@ +# include +# include +# include +# include +# include +# include +# include "fitsio2.h" + +#define NULL_VALUE -2147483647 /* value used to represent undefined pixels */ +#define ZERO_VALUE -2147483646 /* value used to represent zero-valued 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][30]; + +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 dither_method, /* I - which subtractive dither method to use */ + 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 dither_method, /* I - which subtractive dither method to use */ + 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 dither_method, /* I - which subtractive dither method to use */ + 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 dither_method, /* I - which subtractive dither method to use */ + 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 dither_method, /* I - which subtractive dither method to use */ + 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 dither_method, /* I - which subtractive dither method to use */ + 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_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_int_to_longlong_inplace(int *intarray, long length, int *status); +static int fits_short_to_int_inplace(short *intarray, long length, int shift, int *status); +static int fits_ushort_to_int_inplace(unsigned short *intarray, long length, int shift, int *status); +static int fits_sbyte_to_int_inplace(signed char *intarray, long length, int *status); +static int fits_ubyte_to_int_inplace(unsigned char *intarray, long length, int *status); + +static int fits_calc_tile_rows(long *tlpixel, long *tfpixel, int ndim, long *trowsize, long *ntrows, int *status); + +/* only used for diagnoitic purposes */ +/* int fits_get_case(int *c1, int*c2, int*c3); */ +/*---------------------------------------------------------------------------*/ +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. +*/ + + if (ctype != RICE_1 && + ctype != GZIP_1 && + ctype != GZIP_2 && + ctype != PLIO_1 && + ctype != HCOMPRESS_1 && + ctype != BZIP2_1 && + ctype != NOCOMPRESS && + ctype != 0) + { + ffpmsg("unknown compression algorithm (fits_set_compression_type)"); + *status = DATA_COMPRESSION_ERR; + } else { + (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; + ffpmsg("illegal number of tile dimensions (fits_set_tile_dim)"); + 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)->request_quantize_level = NO_QUANTIZE; + } else { + + (fptr->Fptr)->request_quantize_level = qlevel; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_set_quantize_method(fitsfile *fptr, /* I - FITS file pointer */ + int method, /* quantization method */ + 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 + use the default SUBTRACTIVE_DITHER_1 (which is equivalent to dither = 1). + A value of 2 means use SUBTRACTIVE_DITHER_2. +*/ + + if (method < -1 || method > 2) + { + ffpmsg("illegal dithering value (fits_set_quantize_method)"); + *status = DATA_COMPRESSION_ERR; + } else { + + if (method == 0) method = 1; + (fptr->Fptr)->request_quantize_method = method; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_set_quantize_dither(fitsfile *fptr, /* I - FITS file pointer */ + int dither, /* dither type */ + int *status) /* IO - error status */ +{ +/* + the name of this routine has changed. This is kept here only for backwards + compatibility for any software that may be calling the old routine. +*/ + + fits_set_quantize_method(fptr, dither, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_set_dither_seed(fitsfile *fptr, /* I - FITS file pointer */ + int seed, /* random dithering seed 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 (seed > 10000) { + ffpmsg("illegal dithering seed value (fits_set_dither_seed)"); + *status = DATA_COMPRESSION_ERR; + } else { + (fptr->Fptr)->request_dither_seed = seed; + } + + 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 */ +{ +/* + The name of this routine has changed. This is kept just for + backwards compatibility with any software that calls the old name +*/ + + fits_set_dither_seed(fptr, offset, status); + 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; + ffpmsg("illegal number of noise bits (fits_set_noise_bits)"); + 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. +*/ + (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. +*/ + + (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_set_huge_hdu(fitsfile *fptr, /* I - FITS file pointer */ + int huge, /* I - True (!= 0) or False (0) */ + int *status) /* IO - error status */ +{ +/* + This routine specifies whether the HDU that is being compressed is so large + (i.e., > 4 GB) that the 'Q' type variable length array columns should be used + rather than the normal 'P' type. The allows the heap pointers to be stored + as 64-bit quantities, rather than just 32-bits. +*/ + + (fptr->Fptr)->request_huge_hdu = huge; + 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; + + if (*ctype != RICE_1 && + *ctype != GZIP_1 && + *ctype != GZIP_2 && + *ctype != PLIO_1 && + *ctype != HCOMPRESS_1 && + *ctype != BZIP2_1 && + *ctype != NOCOMPRESS && + *ctype != 0 ) + + { + ffpmsg("unknown compression algorithm (fits_get_compression_type)"); + *status = DATA_COMPRESSION_ERR; + } + + 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; + ffpmsg("illegal number of tile dimensions (fits_get_tile_dim)"); + return(*status); + } + + for (ii = 0; ii < ndim; ii++) + { + dims[ii] = (fptr->Fptr)->request_tilesize[ii]; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_unset_compression_param( + fitsfile *fptr, + int *status) +{ + int ii; + + (fptr->Fptr)->compress_type = 0; + (fptr->Fptr)->quantize_level = 0; + (fptr->Fptr)->quantize_method = 0; + (fptr->Fptr)->dither_seed = 0; + (fptr->Fptr)->hcomp_scale = 0; + + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + (fptr->Fptr)->tilesize[ii] = 0; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_unset_compression_request( + fitsfile *fptr, + int *status) +{ + int ii; + + (fptr->Fptr)->request_compress_type = 0; + (fptr->Fptr)->request_quantize_level = 0; + (fptr->Fptr)->request_quantize_method = 0; + (fptr->Fptr)->request_dither_seed = 0; + (fptr->Fptr)->request_hcomp_scale = 0; + (fptr->Fptr)->request_lossy_int_compress = 0; + (fptr->Fptr)->request_huge_hdu = 0; + + for (ii = 0; ii < MAX_COMPRESS_DIM; ii++) + { + (fptr->Fptr)->request_tilesize[ii] = 0; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_set_compression_pref( + fitsfile *infptr, + fitsfile *outfptr, + int *status) +{ +/* + Set the preference for various compression options, based + on keywords in the input file that + provide guidance about how the HDU should be compressed when written + to the output file. +*/ + + int ii, naxis, nkeys, comptype; + int ivalue; + long tiledim[6]= {1,1,1,1,1,1}; + char card[FLEN_CARD], value[FLEN_VALUE]; + double qvalue; + float hscale; + LONGLONG datastart, dataend; + if (*status > 0) + return(*status); + + /* check the size of the HDU that is to be compressed */ + fits_get_hduaddrll(infptr, NULL, &datastart, &dataend, status); + if ( (LONGLONG)(dataend - datastart) > UINT32_MAX) { + /* use 64-bit '1Q' variable length columns instead of '1P' columns */ + /* for large files, in case the heap size becomes larger than 2**32 bytes*/ + fits_set_huge_hdu(outfptr, 1, status); + } + + fits_get_hdrspace(infptr, &nkeys, NULL, status); + + /* look for a image compression directive keywords (begin with 'FZ') */ + for (ii = 2; ii <= nkeys; ii++) { + + fits_read_record(infptr, ii, card, status); + + if (!strncmp(card, "FZ", 2) ){ + + /* get the keyword value string */ + fits_parse_value(card, value, NULL, status); + + if (!strncmp(card+2, "ALGOR", 5) ) { + + /* set the desired compression algorithm */ + /* allowed values: RICE_1, GZIP_1, GZIP_2, PLIO_1, */ + /* HCOMPRESS_1, BZIP2_1, and NOCOMPRESS */ + + if (!fits_strncasecmp(value, "'RICE_1", 7) ) { + comptype = RICE_1; + } else if (!fits_strncasecmp(value, "'GZIP_1", 7) ) { + comptype = GZIP_1; + } else if (!fits_strncasecmp(value, "'GZIP_2", 7) ) { + comptype = GZIP_2; + } else if (!fits_strncasecmp(value, "'PLIO_1", 7) ) { + comptype = PLIO_1; + } else if (!fits_strncasecmp(value, "'HCOMPRESS_1", 12) ) { + comptype = HCOMPRESS_1; + } else if (!fits_strncasecmp(value, "'NONE", 5) ) { + comptype = NOCOMPRESS; + } else { + ffpmsg("Unknown FZALGOR keyword compression algorithm:"); + ffpmsg(value); + return(*status = DATA_COMPRESSION_ERR); + } + + fits_set_compression_type (outfptr, comptype, status); + + } else if (!strncmp(card+2, "TILE ", 6) ) { + + if (!fits_strncasecmp(value, "'row", 4) ) { + tiledim[0] = -1; + } else if (!fits_strncasecmp(value, "'whole", 6) ) { + tiledim[0] = -1; + tiledim[1] = -1; + tiledim[2] = -1; + } else { + ffdtdm(infptr, value, 0,6, &naxis, tiledim, status); + } + + /* set the desired tile size */ + fits_set_tile_dim (outfptr, 6, tiledim, status); + + } else if (!strncmp(card+2, "QVALUE", 6) ) { + + /* set the desired Q quantization value */ + qvalue = atof(value); + fits_set_quantize_level (outfptr, (float) qvalue, status); + + } else if (!strncmp(card+2, "QMETHD", 6) ) { + + if (!fits_strncasecmp(value, "'no_dither", 10) ) { + ivalue = -1; /* just quantize, with no dithering */ + } else if (!fits_strncasecmp(value, "'subtractive_dither_1", 21) ) { + ivalue = SUBTRACTIVE_DITHER_1; /* use subtractive dithering */ + } else if (!fits_strncasecmp(value, "'subtractive_dither_2", 21) ) { + ivalue = SUBTRACTIVE_DITHER_2; /* dither, except preserve zero-valued pixels */ + } else { + ffpmsg("Unknown value for FZQUANT keyword: (set_compression_pref)"); + ffpmsg(value); + return(*status = DATA_COMPRESSION_ERR); + } + + fits_set_quantize_method(outfptr, ivalue, status); + + } else if (!strncmp(card+2, "DTHRSD", 6) ) { + + if (!fits_strncasecmp(value, "'checksum", 9) ) { + ivalue = -1; /* use checksum of first tile */ + } else if (!fits_strncasecmp(value, "'clock", 6) ) { + ivalue = 0; /* set dithering seed based on system clock */ + } else { /* read integer value */ + if (*value == '\'') + ivalue = (int) atol(value+1); /* allow for leading quote character */ + else + ivalue = (int) atol(value); + + if (ivalue < 1 || ivalue > 10000) { + ffpmsg("Invalid value for FZDTHRSD keyword: (set_compression_pref)"); + ffpmsg(value); + return(*status = DATA_COMPRESSION_ERR); + } + } + + /* set the desired dithering */ + fits_set_dither_seed(outfptr, ivalue, status); + + } else if (!strncmp(card+2, "I2F", 3) ) { + + /* set whether to convert integers to float then use lossy compression */ + if (!fits_strcasecmp(value, "t") ) { + fits_set_lossy_int (outfptr, 1, status); + } else if (!fits_strcasecmp(value, "f") ) { + fits_set_lossy_int (outfptr, 0, status); + } else { + ffpmsg("Unknown value for FZI2F keyword: (set_compression_pref)"); + ffpmsg(value); + return(*status = DATA_COMPRESSION_ERR); + } + + } else if (!strncmp(card+2, "HSCALE ", 6) ) { + + /* set the desired Hcompress scale value */ + hscale = (float) atof(value); + fits_set_hcomp_scale (outfptr, hscale, status); + } + } + } + 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)->request_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)->request_quantize_level == NO_QUANTIZE) { + *qlevel = 0; + } else { + *qlevel = (fptr->Fptr)->request_quantize_level; + } + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_get_dither_seed(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_seed; + 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]; +/* int c1, c2, c3; */ + + 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); + } + + /* create a new empty HDU in the output file now, before setting the */ + /* compression preferences. This HDU will become a binary table that */ + /* contains the compressed image. If necessary, create a dummy primary */ + /* array, which much precede the binary table extension. */ + + ffcrhd(outfptr, status); /* this does nothing if the output file is empty */ + + if ((outfptr->Fptr)->curhdu == 0) /* have to create dummy primary array */ + { + ffcrim(outfptr, 16, 0, NULL, status); + ffcrhd(outfptr, status); + } else { + /* unset any compress parameter preferences that may have been + set when closing the previous HDU in the output file */ + fits_unset_compression_param(outfptr, status); + } + + /* set any compress parameter preferences as given in the input file */ + fits_set_compression_pref(infptr, outfptr, status); + + /* special case: the quantization level is not given by a keyword in */ + /* the HDU header, so we have to explicitly copy the requested value */ + /* to the actual value */ +/* do this in imcomp_get_compressed_image_par, instead + if ( (outfptr->Fptr)->request_quantize_level != 0.) + (outfptr->Fptr)->quantize_level = (outfptr->Fptr)->request_quantize_level; +*/ + /* 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); + + /* unset any previously set compress parameter preferences */ + fits_unset_compression_request(outfptr, status); + +/* + fits_get_case(&c1, &c2, &c3); + printf("c1, c2, c3 = %d, %d, %d\n", c1, c2, c3); +*/ + + 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, ndiv, addToDim, 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 */ + int is_primary=0; /* Is this attempting to write to the primary? */ + int nQualifyDims=0; /* For Hcompress, number of image dimensions with required pixels. */ + int noHigherDims=1; /* Set to true if all tile dims other than x are size 1. */ + int firstDim=-1, secondDim=-1; /* Indices of first and second tiles dimensions + with width > 1 */ + + if (*status > 0) + return(*status); + + /* check for special case of losslessly compressing floating point */ + /* images. Only compression algorithm that supports this is GZIP */ + if ( (inbitpix < 0) && ((outfptr->Fptr)->request_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); + } + } + + /* set default compression parameter values, if undefined */ + + if ( (outfptr->Fptr)->request_compress_type == 0) { + /* use RICE_1 by default */ + (outfptr->Fptr)->request_compress_type = RICE_1; + } + + if (inbitpix < 0 && (outfptr->Fptr)->request_quantize_level != NO_QUANTIZE) { + /* set defaults for quantizing floating point images */ + if ( (outfptr->Fptr)->request_quantize_method == 0) { + /* set default dithering method */ + (outfptr->Fptr)->request_quantize_method = SUBTRACTIVE_DITHER_1; + } + + if ( (outfptr->Fptr)->request_quantize_level == 0) { + if ((outfptr->Fptr)->request_quantize_method == NO_DITHER) { + /* must use finer quantization if no dithering is done */ + (outfptr->Fptr)->request_quantize_level = 16; + } else { + (outfptr->Fptr)->request_quantize_level = 4; + } + } + } + + /* special case: the quantization level is not given by a keyword in */ + /* the HDU header, so we have to explicitly copy the requested value */ + /* to the actual value */ +/* do this in imcomp_get_compressed_image_par, instead + if ( (outfptr->Fptr)->request_quantize_level != 0.) + (outfptr->Fptr)->quantize_level = (outfptr->Fptr)->request_quantize_level; +*/ + /* 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) { + + /* Tiles must ultimately have 2 (and only 2) dimensions, each with + at least 4 pixels. First catch the case where the image + itself won't allow this. */ + if (naxis < 2 ) { + ffpmsg("Hcompress cannot be used with 1-dimensional images (imcomp_init_table)"); + return(*status = DATA_COMPRESSION_ERR); + } + for (ii=0; ii= 4) + ++nQualifyDims; + } + if (nQualifyDims < 2) + { + ffpmsg("Hcompress minimum image dimension is 4 pixels (imcomp_init_table)"); + return(*status = DATA_COMPRESSION_ERR); + } + + /* Handle 2 special cases for backwards compatibility. + 1) If both X and Y tile dims are set to full size, ignore + any other requested dimensions and just set their sizes to 1. + 2) If X is full size and all the rest are size 1, attempt to + find a reasonable size for Y. All other 1-D tile specifications + will be rejected. */ + for (ii=1; ii 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] <= 0) + actual_tilesize[0] = naxes[0]; + for (ii=1; ii 1) + { + if (firstDim < 0) + firstDim = ii; + else if (secondDim < 0) + secondDim = ii; + else + { + ffpmsg("Hcompress tiles can only have 2 dimensions (imcomp_init_table)"); + return(*status = DATA_COMPRESSION_ERR); + } + } + } + if (firstDim < 0 || secondDim < 0) + { + ffpmsg("Hcompress tiles must have 2 dimensions (imcomp_init_table)"); + return(*status = DATA_COMPRESSION_ERR); + } + + if (actual_tilesize[firstDim] < 4 || actual_tilesize[secondDim] < 4) + { + 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[firstDim] % (actual_tilesize[firstDim]); /* 1st dimension */ + if (remain > 0 && remain < 4) { + ndiv = naxes[firstDim]/actual_tilesize[firstDim]; /* integer truncation is intentional */ + addToDim = ceil((double)remain/ndiv); + (actual_tilesize[firstDim]) += addToDim; /* increase tile size */ + + remain = naxes[firstDim] % (actual_tilesize[firstDim]); + 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[secondDim] % (actual_tilesize[secondDim]); /* 2nd dimension */ + if (remain > 0 && remain < 4) { + ndiv = naxes[secondDim]/actual_tilesize[secondDim]; /* integer truncation is intentional */ + addToDim = ceil((double)remain/ndiv); + (actual_tilesize[secondDim]) += addToDim; /* increase tile size */ + + remain = naxes[secondDim] % (actual_tilesize[secondDim]); + 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 (ii == 0) { /* first axis is different */ + if (actual_tilesize[ii] <= 0) { + actual_tilesize[ii] = naxes[ii]; + } + } else { + if (actual_tilesize[ii] < 0) { + actual_tilesize[ii] = naxes[ii]; /* negative value maean use whole length */ + } else if (actual_tilesize[ii] == 0) { + actual_tilesize[ii] = 1; /* zero value means use default value = 1 */ + } + } + } + + /* ---- set up array of TFORM strings -------------------------------*/ + if ( (outfptr->Fptr)->request_huge_hdu != 0) { + strcpy(tf0, "1QB"); + } else { + 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)->request_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 */ + if ( (outfptr->Fptr)->request_huge_hdu != 0) { + strcpy(tform[0], "1QI"); + } else { + 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); + } + + /* If attempting to write compressed image to primary, the + call to ffcrtb will increment Fptr->curhdu to 1. Therefore + we need to test now for setting is_primary */ + is_primary = (outfptr->Fptr->curhdu == 0); + /* 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 */ + + if (is_primary) + ffpkyl (outfptr, "ZSIMPLE", 1, + "file does conform to FITS standard", status); + 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++) + { + snprintf (keyname, FLEN_KEYWORD,"ZNAXIS%d", ii+1); + ffpkyj (outfptr, keyname, naxes[ii], + "length of original image axis", status); + } + } + + for (ii = 0; ii < naxis; ii++) + { + snprintf (keyname, FLEN_KEYWORD,"ZTILE%d", ii+1); + ffpkyj (outfptr, keyname, actual_tilesize[ii], + "size of tiles to be compressed", status); + } + + if (bitpix < 0) { + + if ((outfptr->Fptr)->request_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_method = -1, use dithering by default */ + /* when quantizing floating point images. */ + + if ( (outfptr->Fptr)->request_quantize_method == 0) + (outfptr->Fptr)->request_quantize_method = SUBTRACTIVE_DITHER_1; + + /* HCompress must not use SUBTRACTIVE_DITHER_2. If user is requesting + this, assign SUBTRACTIVE_DITHER_1 instead. */ + if ((outfptr->Fptr)->request_quantize_method == SUBTRACTIVE_DITHER_2 + && !(strcmp(zcmptype,"HCOMPRESS_1"))) { + (outfptr->Fptr)->request_quantize_method = SUBTRACTIVE_DITHER_1; + fprintf(stderr,"Warning: CFITSIO does not allow subtractive_dither_2 when using Hcompress algorithm.\nWill use subtractive_dither_1 instead.\n"); + } + + if ((outfptr->Fptr)->request_quantize_method == 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_seed), + "dithering offset when quantizing floats", status); + + } else if ((outfptr->Fptr)->request_quantize_method == SUBTRACTIVE_DITHER_2) { + ffpkys(outfptr, "ZQUANTIZ", "SUBTRACTIVE_DITHER_2", + "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_seed), + "dithering offset when quantizing floats", status); + + if (!strcmp(zcmptype, "RICE_1")) { + /* when using this new dithering method, change the compression type */ + /* to an alias, so that old versions of funpack will not be able to */ + /* created a corrupted uncompressed image. */ + /* ******* can remove this cludge after about June 2015, after most old versions of fpack are gone */ + strcpy(zcmptype, "RICE_ONE"); + } + + } else if ((outfptr->Fptr)->request_quantize_method == NO_DITHER) { + ffpkys(outfptr, "ZQUANTIZ", "NO_DITHER", + "No dithering during quantization", 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, trowsize, ntrows; + 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 + */ + + /* Collapse sizes of higher dimension tiles into 2 dimensional + equivalents needed by the quantizing algorithms for + floating point types */ + fits_calc_tile_rows(lpixel, fpixel, naxis, &trowsize, + &ntrows, status); + + if (anynul && datatype == TFLOAT) { + imcomp_compress_tile(outfptr, row, datatype, tiledata, tilelen, + trowsize, ntrows, 1, &fltnull, status); + } else if (anynul && datatype == TDOUBLE) { + imcomp_compress_tile(outfptr, row, datatype, tiledata, tilelen, + trowsize, ntrows, 1, &dblnull, status); + } else { + imcomp_compress_tile(outfptr, row, datatype, tiledata, tilelen, + trowsize, ntrows, 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 */ + int tilecol; + 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)) { + switch (datatype) { + case TFLOAT: + case TDOUBLE: + case TCOMPLEX: + case TDBLCOMPLEX: + ffpmsg("Lossless compression of floating point images must use GZIP (imcomp_compress_tile)"); + return(*status = DATA_COMPRESSION_ERR); + default: + break; + } + } + } + + /* free the previously saved tile if the input tile is for the same row */ + if ((outfptr->Fptr)->tilerow) { /* has the tile cache been allocated? */ + + /* calculate the column bin of the compressed tile */ + tilecol = (row - 1) % ((long)(((outfptr->Fptr)->znaxis[0] - 1) / ((outfptr->Fptr)->tilesize[0])) + 1); + + if ((outfptr->Fptr)->tilerow[tilecol] == row) { + if (((outfptr->Fptr)->tiledata)[tilecol]) { + free(((outfptr->Fptr)->tiledata)[tilecol]); + } + + if (((outfptr->Fptr)->tilenullarray)[tilecol]) { + free(((outfptr->Fptr)->tilenullarray)[tilecol]); + } + + ((outfptr->Fptr)->tiledata)[tilecol] = 0; + ((outfptr->Fptr)->tilenullarray)[tilecol] = 0; + (outfptr->Fptr)->tilerow[tilecol] = 0; + (outfptr->Fptr)->tiledatasize[tilecol] = 0; + (outfptr->Fptr)->tiletype[tilecol] = 0; + (outfptr->Fptr)->tileanynull[tilecol] = 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 */ + + fits_int_to_longlong_inplace(idata, tilelen, status); + lldata = (LONGLONG *) idata; + + 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) { + if ( (outfptr->Fptr)->request_huge_hdu != 0) { + fits_insert_col(outfptr, 999, "GZIP_COMPRESSED_DATA", "1QB", status); + } else { + 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 = (size_t) (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 { /* datatype == TDOUBLE */ + + /* allocate buffer for the compressed tile bytes */ + /* make it 10% larger than the original uncompressed data */ + clen = (size_t) (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, "1QE"); + } 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 */ + /* have to convert sbuff to an I*4 array, in place */ + /* sbuff must have been allocated large enough to do this */ + fits_short_to_int_inplace(sbuff, tilelen, 0, status); + } + } 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 { + /* have to convert sbuff to an I*4 array, in place */ + /* sbuff must have been allocated large enough to do this */ + fits_short_to_int_inplace(sbuff, tilelen, 32768, status); + } + } 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 */ + /* have to convert sbuff to an I*4 array, in place */ + /* sbuff must have been allocated large enough to do this */ + fits_short_to_int_inplace(sbuff, tilelen, 0, status); + } + } + } + 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 unsigned 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 HCOMPRESS we need to simply subtract 32768 */ + /* for PLIO, have to convert usbuff to an I*4 array, in place */ + /* usbuff must have been allocated large enough to do this */ + + if ((outfptr->Fptr)->compress_type == HCOMPRESS_1) { + fits_ushort_to_int_inplace(usbuff, tilelen, -32768, status); + } else { + fits_ushort_to_int_inplace(usbuff, tilelen, 0, status); + } + } + } + + 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 tile array in place to 4 or 8-byte ints for compression, */ + /* If needed, do null value substitution. */ + + 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 unsigned integer tile array in place to 4 or 8-byte ints for compression, */ + /* If needed, do null value substitution. */ + + + int *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 unsigned integer*1 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 */ + /* have to convert usbbuff to an I*4 array, in place */ + /* usbbuff must have been allocated large enough to do this */ + fits_ubyte_to_int_inplace(usbbuff, tilelen, status); + } + } + + 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*1 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 */ + /* have to convert sbbuff to an I*4 array, in place */ + /* sbbuff must have been allocated large enough to do this */ + fits_sbyte_to_int_inplace(sbbuff, tilelen, status); + } + } + + 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 float 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 *idata; + long irow, ii; + float floatnull; + unsigned char *usbbuff; + unsigned long dithersum; + int iminval = 0, imaxval = 0; /* min and max quantized integers */ + + /* datatype of input array is double. We only support writing this datatype + to a FITS image with BITPIX = -64 or -32, except we also support the special case where + BITPIX = 32 and BZERO = 0 and BSCALE = 1. */ + + if ((zbitpix != LONG_IMG && zbitpix != DOUBLE_IMG && zbitpix != FLOAT_IMG) || scale != 1.0 || zero != 0.) { + ffpmsg("Implicit datatype conversion is not supported when writing to compressed images"); + return(*status = DATA_COMPRESSION_ERR); + } + + *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_method == SUBTRACTIVE_DITHER_1 || + (outfptr->Fptr)->quantize_method == SUBTRACTIVE_DITHER_2) { + + /* see if the dithering offset value needs to be initialized */ + if ((outfptr->Fptr)->request_dither_seed == 0 && (outfptr->Fptr)->dither_seed == 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 seed */ + /* 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_seed = + (( (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_seed), + NULL, status); + + } else if ((outfptr->Fptr)->request_dither_seed < 0 && (outfptr->Fptr)->dither_seed < 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_seed = ((int) (dithersum % 10000)) + 1; + + /* update the header keyword with this new value */ + fits_update_key(outfptr, TINT, "ZDITHER0", &((outfptr->Fptr)->dither_seed), + NULL, status); + } + + /* subtract 1 to convert from 1-based to 0-based element number */ + irow = row + (outfptr->Fptr)->dither_seed - 1; /* dither the quantized values */ + + } else if ((outfptr->Fptr)->quantize_method == -1) { + irow = 0; /* do not dither the quantized values */ + } else { + ffpmsg("Unknown dithering method."); + ffpmsg("May need to install a newer version of CFITSIO."); + return(*status = DATA_COMPRESSION_ERR); + } + + *flag = fits_quantize_float (irow, (float *) tiledata, tilenx, tileny, + nullcheck, floatnull, (outfptr->Fptr)->quantize_level, + (outfptr->Fptr)->quantize_method, 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 double tile array in place to 4-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 *idata; + long irow, ii; + double doublenull; + unsigned char *usbbuff; + unsigned long dithersum; + int iminval = 0, imaxval = 0; /* min and max quantized integers */ + + /* datatype of input array is double. We only support writing this datatype + to a FITS image with BITPIX = -64 or -32, except we also support the special case where + BITPIX = 32 and BZERO = 0 and BSCALE = 1. */ + + if ((zbitpix != LONG_IMG && zbitpix != DOUBLE_IMG && zbitpix != FLOAT_IMG) || scale != 1.0 || zero != 0.) { + ffpmsg("Implicit datatype conversion is not supported when writing to compressed images"); + return(*status = DATA_COMPRESSION_ERR); + } + + *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_method == SUBTRACTIVE_DITHER_1 || + (outfptr->Fptr)->quantize_method == SUBTRACTIVE_DITHER_2) { + + /* see if the dithering offset value needs to be initialized (see above) */ + if ((outfptr->Fptr)->request_dither_seed == 0 && (outfptr->Fptr)->dither_seed == 0) { + + (outfptr->Fptr)->dither_seed = + (( (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_seed), + NULL, status); + + } else if ((outfptr->Fptr)->request_dither_seed < 0 && (outfptr->Fptr)->dither_seed < 0) { + + usbbuff = (unsigned char *) tiledata; + dithersum = 0; + for (ii = 0; ii < 8 * tilelen; ii++) { + dithersum += usbbuff[ii]; + } + (outfptr->Fptr)->dither_seed = ((int) (dithersum % 10000)) + 1; + + /* update the header keyword with this new value */ + fits_update_key(outfptr, TINT, "ZDITHER0", &((outfptr->Fptr)->dither_seed), + NULL, status); + } + + irow = row + (outfptr->Fptr)->dither_seed - 1; /* dither the quantized values */ + + } else if ((outfptr->Fptr)->quantize_method == -1) { + irow = 0; /* do not dither the quantized values */ + } else { + ffpmsg("Unknown subtractive dithering method."); + ffpmsg("May need to install a newer version of CFITSIO."); + return(*status = DATA_COMPRESSION_ERR); + } + + *flag = fits_quantize_double (irow, (double *) tiledata, tilenx, tileny, + nullcheck, doublenull, (outfptr->Fptr)->quantize_level, + (outfptr->Fptr)->quantize_method, 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 tiledim[MAX_COMPRESS_DIM]; + long naxis[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 i5, i4, i3, i2, i1, i0, irow, trowsize, ntrows; + int ii, ndim, 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); + + /* Collapse sizes of higher dimension tiles into 2 dimensional + equivalents needed by the quantizing algorithms for + floating point types */ + fits_calc_tile_rows(tlpixel, tfpixel, ndim, &trowsize, + &ntrows, status); + + /* compress the tile again, and write it back to the FITS file */ + imcomp_compress_tile (fptr, irow, datatype, buffer, + thistilesize[0], + trowsize, + ntrows, + 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, 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. +*/ +{ + long 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]; + long i5, i4, i3, i2, i1, i0, irow; + int ii, ndim, pixlen, tilenul=0; + 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]); +*/ + /* test if there are any intersecting pixels in this tile and the output image */ + if (imcomp_test_overlap(ndim, tfpixel, tlpixel, + fpixel, lpixel, inc, status)) { + /* 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. +*/ +{ + long 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]; + long i5, i4, i3, i2, i1, i0, irow; + int ii, ndim, tilenul; + void *buffer; + char *bnullarray = 0, *cnull; + 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); + } + + cnull = (char *) nullval; /* used to test if the nullval = 0 */ + + /* get temporary space for uncompressing one image tile */ + /* If nullval == 0, then this means that the */ + /* calling routine does not want to check for null pixels in the array */ + if (datatype == TSHORT) + { + buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (short)); + if (cnull) { + if (cnull[0] == 0 && cnull[1] == 0 ) { + nullcheck = 0; + } + } + } + else if (datatype == TINT) + { + buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (int)); + if (cnull) { + if (cnull[0] == 0 && cnull[1] == 0 && cnull[2] == 0 && cnull[3] == 0 ) { + nullcheck = 0; + } + } + } + else if (datatype == TLONG) + { + buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (long)); + if (cnull) { + if (cnull[0] == 0 && cnull[1] == 0 && cnull[2] == 0 && cnull[3] == 0 ) { + nullcheck = 0; + } + } + } + else if (datatype == TFLOAT) + { + buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (float)); + if (cnull) { + if (cnull[0] == 0 && cnull[1] == 0 && cnull[2] == 0 && cnull[3] == 0 ) { + nullcheck = 0; + } + } + } + else if (datatype == TDOUBLE) + { + buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (double)); + if (cnull) { + if (cnull[0] == 0 && cnull[1] == 0 && cnull[2] == 0 && cnull[3] == 0 && + cnull[4] == 0 && cnull[5] == 0 && cnull[6] == 0 && cnull[7] == 0 ) { + nullcheck = 0; + } + } + } + else if (datatype == TUSHORT) + { + buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (unsigned short)); + if (cnull) { + if (cnull[0] == 0 && cnull[1] == 0 ){ + nullcheck = 0; + } + } + } + else if (datatype == TUINT) + { + buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (unsigned int)); + if (cnull) { + if (cnull[0] == 0 && cnull[1] == 0 && cnull[2] == 0 && cnull[3] == 0 ){ + nullcheck = 0; + } + } + } + else if (datatype == TULONG) + { + buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (unsigned long)); + if (cnull) { + if (cnull[0] == 0 && cnull[1] == 0 && cnull[2] == 0 && cnull[3] == 0 ){ + nullcheck = 0; + } + } + } + else if (datatype == TBYTE || datatype == TSBYTE) + { + buffer = malloc ((fptr->Fptr)->maxtilelen * sizeof (char)); + if (cnull) { + if (cnull[0] == 0){ + nullcheck = 0; + } + } + } + else + { + ffpmsg("unsupported datatype for uncompressing image"); + return(*status = BAD_DATATYPE); + } + + 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, tstatus2, doffset, oldFormat=0, colNum=0; + 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") || !FSTRCMP(value, "RICE_ONE") ) + (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); + } + + if (ffgky (infptr, TINT, "ZBITPIX", &(infptr->Fptr)->zbitpix, + NULL, status) > 0) + { + ffpmsg("required ZBITPIX compression keyword not found"); + return(*status); + } + + /* If ZZERO and ZSCALE columns don't exist for floating-point types, + assume there is NO quantization. Treat exactly as if it had ZQUANTIZ='NONE'. + This is true regardless of whether or not file has a ZQUANTIZ keyword. */ + tstatus=0; + tstatus2=0; + if ((infptr->Fptr->zbitpix < 0) && + (fits_get_colnum(infptr,CASEINSEN,"ZZERO",&colNum,&tstatus) + == COL_NOT_FOUND) && + (fits_get_colnum(infptr,CASEINSEN,"ZSCALE",&colNum,&tstatus2) + == COL_NOT_FOUND)) { + (infptr->Fptr)->quantize_level = NO_QUANTIZE; + } + else { + /* 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_method = 0; + (infptr->Fptr)->quantize_level = 0; + } else { + + if (!FSTRCMP(value, "NONE") ) { + (infptr->Fptr)->quantize_level = NO_QUANTIZE; + } else if (!FSTRCMP(value, "SUBTRACTIVE_DITHER_1") ) + (infptr->Fptr)->quantize_method = SUBTRACTIVE_DITHER_1; + else if (!FSTRCMP(value, "SUBTRACTIVE_DITHER_2") ) + (infptr->Fptr)->quantize_method = SUBTRACTIVE_DITHER_2; + else if (!FSTRCMP(value, "NO_DITHER") ) + (infptr->Fptr)->quantize_method = NO_DITHER; + else + (infptr->Fptr)->quantize_method = 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_seed = 1; + } else { + (infptr->Fptr)->dither_seed = doffset; + } + + 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 */ + snprintf (keyword, FLEN_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 */ + snprintf (keyword, FLEN_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; + /* First check for very old files, where ZVAL2 wasn't yet designated + for bytepix */ + if (!ffgky(infptr, TSTRING, "ZNAME2", value, NULL, &tstatus) + && !FSTRCMP(value, "NOISEBIT")) + { + oldFormat = 1; + } + + tstatus = 0; + if (oldFormat || 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; + } + + /* special case: the quantization level is not given by a keyword in */ + /* the HDU header, so we have to explicitly copy the requested value */ + /* to the actual value */ + if ( (infptr->Fptr)->request_quantize_level != 0.) + (infptr->Fptr)->quantize_level = (infptr->Fptr)->request_quantize_level; + + 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); + + /* write some associated HISTORY keywords */ + fits_parse_value(card, card2, NULL, status); + if (fits_strncasecmp(card2, "'NONE", 5) ) { + /* the value is not 'NONE' */ + fits_write_history(outfptr, + "Image was compressed by CFITSIO using scaled integer quantization:", status); + snprintf(card2, FLEN_CARD," q = %f / quantized level scaling parameter", + (outfptr->Fptr)->request_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", "-" }, + {"THEAP", "-" }, + {"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 = 0; /* 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, ntilebins, tilecol = 0; + float fnulval=0; + float *tempfloat = 0; + double *tempdouble = 0; + double dnulval=0; + double bscale, bzero, actual_bzero, dummy = 0; /* scaling parameters */ + long tilesize; /* number of bytes */ + int smooth, nx, ny, scale; /* hcompress parameters */ + LONGLONG nelemll = 0, offset = 0; + + if (*status > 0) + return(*status); + + + /* **************************************************************** */ + /* allocate pointers to array of cached uncompressed tiles, if not already done */ + if ((infptr->Fptr)->tilerow == 0) { + + /* calculate number of column bins of compressed tile */ + ntilebins = (((infptr->Fptr)->znaxis[0] - 1) / ((infptr->Fptr)->tilesize[0])) + 1; + + if ((infptr->Fptr)->znaxis[0] != (infptr->Fptr)->tilesize[0] || + (infptr->Fptr)->tilesize[1] != 1 ) { /* don't cache the tile if only single row of the image */ + + (infptr->Fptr)->tilerow = (int *) calloc (ntilebins, sizeof(int)); + (infptr->Fptr)->tiledata = (void**) calloc (ntilebins, sizeof(void*)); + (infptr->Fptr)->tilenullarray = (void **) calloc (ntilebins, sizeof(char*)); + (infptr->Fptr)->tiledatasize = (long *) calloc (ntilebins, sizeof(long)); + (infptr->Fptr)->tiletype = (int *) calloc (ntilebins, sizeof(int)); + (infptr->Fptr)->tileanynull = (int *) calloc (ntilebins, sizeof(int)); + } + } + + /* **************************************************************** */ + /* check if this tile was cached; if so, just copy it out */ + if ((infptr->Fptr)->tilerow) { + /* calculate the column bin of the compressed tile */ + tilecol = (nrow - 1) % ((long)(((infptr->Fptr)->znaxis[0] - 1) / ((infptr->Fptr)->tilesize[0])) + 1); + + if (nrow == (infptr->Fptr)->tilerow[tilecol] && datatype == (infptr->Fptr)->tiletype[tilecol] ) { + + memcpy(buffer, ((infptr->Fptr)->tiledata)[tilecol], (infptr->Fptr)->tiledatasize[tilecol]); + + if (nullcheck == 2) + memcpy(bnullarray, (infptr->Fptr)->tilenullarray[tilecol], tilelen); + + *anynul = (infptr->Fptr)->tileanynull[tilecol]; + + return(*status); + } + } + + /* **************************************************************** */ + /* get length of the compressed byte stream */ + ffgdesll (infptr, (infptr->Fptr)->cn_compressed, nrow, &nelemll, &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 (nelemll == 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 */ + ffgdesll (infptr, (infptr->Fptr)->cn_uncompressed, nrow, &nelemll, + &offset, status); + + if (nelemll == 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, (long) nelemll, 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, (long) nelemll, 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 */ + + ffgdesll (infptr, (infptr->Fptr)->cn_gzip_data, nrow, &nelemll, + &offset, status); + + if (nelemll == 0 && offset == 0) /* this should never happen */ + return (*status = NO_COMPRESSED_TILE); + + /* allocate memory for the compressed tile of data */ + cbuf = (unsigned char *) malloc ((long) nelemll); + 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, (long) nelemll, &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); + } + + /* Do not allow image float/doubles into int arrays */ + if (datatype != TFLOAT && datatype != TDOUBLE) + { + ffpmsg("attempting to read compressed float or double image into incompatible data type"); + free(cbuf); + return (*status = DATA_DECOMPRESSION_ERR); + } + + if (datatype == TFLOAT && (infptr->Fptr)->zbitpix == DOUBLE_IMG) + { + tempdouble = (double*)malloc(idatalen); + if (tempdouble == NULL) { + ffpmsg("Memory allocation failure for tempdouble. (imcomp_decompress_tile)"); + free (cbuf); + return (*status = MEMORY_ALLOCATION); + } + + /* uncompress the data into temp buffer */ + if (uncompress2mem_from_mem ((char *)cbuf, (long) nelemll, + (char **) &tempdouble, &idatalen, NULL, &tilebytesize, status)) { + ffpmsg("failed to gunzip the image tile"); + free (tempdouble); + free (cbuf); + return (*status); + } + } + else 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, (long) nelemll, + (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, (long) nelemll, + (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 + if (tempdouble) + ffswap8((double *) tempdouble, tilelen); + else + ffswap8((double *) buffer, tilelen); +#endif + if (datatype == TFLOAT) { + if (nulval) { + fnulval = *(float *) nulval; + } + + fffr8r4((double *) tempdouble, (long) tilelen, 1., 0., nullcheck, + fnulval, bnullarray, anynul, + (float *) buffer, status); + free(tempdouble); + tempdouble=0; + } 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 ((long) nelemll * sizeof (short)); + } else { + cbuf = (unsigned char *) malloc ((long) nelemll); + } + 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, (long) nelemll, &snull, (short *) cbuf, NULL, status); + } else { + fits_read_col(infptr, TBYTE, (infptr->Fptr)->cn_compressed, nrow, + 1, (long) nelemll, &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, (long) nelemll, (unsigned char *)idata, + tilelen, blocksize); + tiledatatype = TBYTE; + } else if ((infptr->Fptr)->rice_bytepix == 2 ) { + *status = fits_rdecomp_short (cbuf, (long) nelemll, (unsigned short *)idata, + tilelen, blocksize); + tiledatatype = TSHORT; + } else { + *status = fits_rdecomp (cbuf, (long) nelemll, (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, (long) nelemll, + (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) nelemll, 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 && actual_bzero == 32768.) { + /* special case where unsigned 16-bit integers have been */ + /* offset by +32768 when using PLIO */ + fffi4i2(idata, tilelen, bscale, bzero - 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); + + /* + Hcompress is a special case: ignore any numerical overflow + errors that may have occurred during the integer*4 to integer*2 + convertion. Overflows can happen when a lossy Hcompress algorithm + is invoked (with a non-zero scale factor). The fffi4i2 routine + clips the returned values to be within the legal I*2 range, so + all we need to is to reset the error status to zero. + */ + + if ((infptr->Fptr)->compress_type == HCOMPRESS_1) { + if ((*status == NUM_OVERFLOW) || (*status == OVERFLOW_ERR)) + *status = 0; + } + } + } 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) + if ((infptr->Fptr)->compress_type == PLIO_1 && actual_bzero == 32768.) { + /* special case where unsigned 16-bit integers have been */ + /* offset by +32768 when using PLIO */ + fffi4int(idata, (long) tilelen, bscale, bzero - 32768., nullcheck, tnull, + *(int *) nulval, bnullarray, anynul, + (int *) buffer, status); + } else { + 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) + if ((infptr->Fptr)->compress_type == PLIO_1 && actual_bzero == 32768.) { + /* special case where unsigned 16-bit integers have been */ + /* offset by +32768 when using PLIO */ + fffi4i4(idata, tilelen, bscale, bzero - 32768., nullcheck, tnull, + *(long *) nulval, bnullarray, anynul, + (long *) buffer, status); + } else { + 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_method == SUBTRACTIVE_DITHER_1 || + (infptr->Fptr)->quantize_method == SUBTRACTIVE_DITHER_2) { + + /* use the new dithering algorithm (introduced in July 2009) */ + + if (tiledatatype == TINT) + unquantize_i4r4(nrow + (infptr->Fptr)->dither_seed - 1, idata, + tilelen, bscale, bzero, (infptr->Fptr)->quantize_method, nullcheck, tnull, + fnulval, bnullarray, anynul, + (float *) buffer, status); + else if (tiledatatype == TSHORT) + unquantize_i2r4(nrow + (infptr->Fptr)->dither_seed - 1, (short *)idata, + tilelen, bscale, bzero, (infptr->Fptr)->quantize_method, nullcheck, (short) tnull, + fnulval, bnullarray, anynul, + (float *) buffer, status); + else if (tiledatatype == TBYTE) + unquantize_i1r4(nrow + (infptr->Fptr)->dither_seed - 1, (unsigned char *)idata, + tilelen, bscale, bzero, (infptr->Fptr)->quantize_method, nullcheck, (unsigned char) tnull, + fnulval, bnullarray, anynul, + (float *) buffer, status); + + } else { /* use the old "round to nearest level" quantization algorithm */ + + if (tiledatatype == TINT) + if ((infptr->Fptr)->compress_type == PLIO_1 && actual_bzero == 32768.) { + /* special case where unsigned 16-bit integers have been */ + /* offset by +32768 when using PLIO */ + fffi4r4(idata, tilelen, bscale, bzero - 32768., nullcheck, tnull, + fnulval, bnullarray, anynul, + (float *) buffer, status); + } else { + 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_method == SUBTRACTIVE_DITHER_1 || + (infptr->Fptr)->quantize_method == SUBTRACTIVE_DITHER_2) { + + /* use the new dithering algorithm (introduced in July 2009) */ + if (tiledatatype == TINT) + unquantize_i4r8(nrow + (infptr->Fptr)->dither_seed - 1, idata, + tilelen, bscale, bzero, (infptr->Fptr)->quantize_method, nullcheck, tnull, + dnulval, bnullarray, anynul, + (double *) buffer, status); + else if (tiledatatype == TSHORT) + unquantize_i2r8(nrow + (infptr->Fptr)->dither_seed - 1, (short *)idata, + tilelen, bscale, bzero, (infptr->Fptr)->quantize_method, nullcheck, (short) tnull, + dnulval, bnullarray, anynul, + (double *) buffer, status); + else if (tiledatatype == TBYTE) + unquantize_i1r8(nrow + (infptr->Fptr)->dither_seed - 1, (unsigned char *)idata, + tilelen, bscale, bzero, (infptr->Fptr)->quantize_method, nullcheck, (unsigned char) tnull, + dnulval, bnullarray, anynul, + (double *) buffer, status); + + } else { /* use the old "round to nearest level" quantization algorithm */ + + if (tiledatatype == TINT) { + if ((infptr->Fptr)->compress_type == PLIO_1 && actual_bzero == 32768.) { + /* special case where unsigned 16-bit integers have been */ + /* offset by +32768 when using PLIO */ + fffi4r8(idata, tilelen, bscale, bzero - 32768., nullcheck, tnull, + dnulval, bnullarray, anynul, + (double *) buffer, status); + } else { + 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) + if ((infptr->Fptr)->compress_type == PLIO_1 && actual_bzero == 32768.) { + /* special case where unsigned 16-bit integers have been */ + /* offset by +32768 when using PLIO */ + fffi4u2(idata, tilelen, bscale, bzero - 32768., nullcheck, tnull, + *(unsigned short *) nulval, bnullarray, anynul, + (unsigned short *) buffer, status); + } else { + 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) + if ((infptr->Fptr)->compress_type == PLIO_1 && actual_bzero == 32768.) { + /* special case where unsigned 16-bit integers have been */ + /* offset by +32768 when using PLIO */ + fffi4uint(idata, tilelen, bscale, bzero - 32768., nullcheck, tnull, + *(unsigned int *) nulval, bnullarray, anynul, + (unsigned int *) buffer, status); + } else { + 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) + if ((infptr->Fptr)->compress_type == PLIO_1 && actual_bzero == 32768.) { + /* special case where unsigned 16-bit integers have been */ + /* offset by +32768 when using PLIO */ + fffi4u4(idata, tilelen, bscale, bzero - 32768., nullcheck, tnull, + *(unsigned long *) nulval, bnullarray, anynul, + (unsigned long *) buffer, status); + } else { + 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)->tilerow) { /* make sure cache has been allocated */ + 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[tilecol] || + datatype != (infptr->Fptr)->tiletype[tilecol] ) { + + if (((infptr->Fptr)->tiledata)[tilecol]) { + free(((infptr->Fptr)->tiledata)[tilecol]); + } + + if (((infptr->Fptr)->tilenullarray)[tilecol]) { + free(((infptr->Fptr)->tilenullarray)[tilecol]); + } + + ((infptr->Fptr)->tilenullarray)[tilecol] = 0; + ((infptr->Fptr)->tilerow)[tilecol] = 0; + ((infptr->Fptr)->tiledatasize)[tilecol] = 0; + ((infptr->Fptr)->tiletype)[tilecol] = 0; + + /* allocate new array(s) */ + ((infptr->Fptr)->tiledata)[tilecol] = malloc(tilesize); + + if (((infptr->Fptr)->tiledata)[tilecol] == 0) + return (*status); + + if (nullcheck == 2) { /* also need array of null pixel flags */ + (infptr->Fptr)->tilenullarray[tilecol] = malloc(tilelen); + if ((infptr->Fptr)->tilenullarray[tilecol] == 0) + return (*status); + } + + (infptr->Fptr)->tiledatasize[tilecol] = tilesize; + (infptr->Fptr)->tiletype[tilecol] = datatype; + } + + /* copy the tile array(s) into cache buffer */ + memcpy((infptr->Fptr)->tiledata[tilecol], buffer, tilesize); + + if (nullcheck == 2) { + if ((infptr->Fptr)->tilenullarray == 0) { + (infptr->Fptr)->tilenullarray[tilecol] = malloc(tilelen); + } + memcpy((infptr->Fptr)->tilenullarray[tilecol], bnullarray, tilelen); + } + + (infptr->Fptr)->tilerow[tilecol] = nrow; + (infptr->Fptr)->tileanynull[tilecol] = *anynul; + } + } + return (*status); +} +/*--------------------------------------------------------------------------*/ +int imcomp_test_overlap ( + 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 */ + 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 *status) + +/* + test if there are any intersecting pixels between this tile and the section + of the image defined by fixel, lpixel, ininc. +*/ +{ + 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 */ + int ii; + long tf, tl; + + if (*status > 0) + return(*status); + + + /* ------------------------------------------------------------ */ + /* 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(0); /* 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) { + *status = NEG_AXIS; + return(0); + } + + /* calc dimensions of the tile */ + tiledim[ii] = tlpixel[ii] - tfpixel[ii] + 1; + if (tiledim[ii] < 1) { + *status = NEG_AXIS; + return(0); + } + + 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(0); /* no overlapping pixels */ + } + + while ((tl-(fpixel[ii] - 1)) % labs(inc[ii])) + { + tl--; + if (tf > tl) + return(0); /* 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(0); /* no overlapping pixels */ + } + + if (ii > 0) + imgdim[ii] *= imgdim[ii - 1]; /* product of dimensions */ + } + + return(1); /* there appears to be intersecting pixels */ +} +/*--------------------------------------------------------------------------*/ +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 dither_method, /* I - dithering method to use */ + 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++) + { +/* + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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); + } + } + } + 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 + { +/* + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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 dither_method, /* I - dithering method to use */ + 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++) + { +/* + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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); + } + } + } + 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 + { +/* + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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 dither_method, /* I - dithering method to use */ + 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++) + { + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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); + } + } + } + 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 + { + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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 dither_method, /* I - dithering method to use */ + 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++) + { +/* + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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); + } + } + } + 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 + { +/* + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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 dither_method, /* I - dithering method to use */ + 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++) + { +/* + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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); + } + } + } + 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 + { +/* if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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 dither_method, /* I - dithering method to use */ + 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++) + { + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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); + } + } + } + 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 + { + if (dither_method == SUBTRACTIVE_DITHER_2 && input[ii] == ZERO_VALUE) + output[ii] = 0.0; + 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); +} + +/* ======================================================================= */ +/* TABLE COMPRESSION ROUTINES */ +/* =-====================================================================== */ + +/*--------------------------------------------------------------------------*/ +int fits_compress_table(fitsfile *infptr, fitsfile *outfptr, int *status) + +/* + Compress the input FITS Binary Table. + + First divide the table into equal sized chunks (analogous to image tiles) where all + the contain the same number of rows (except perhaps for the last chunk + which may contain fewer rows). The chunks should not be too large to copy into memory + (currently, about 100 MB max seems a reasonable size). + + Then, on a chunk by piece basis, do the following: + + 1. Transpose the table from its original row-major order, into column-major order. + All the bytes for each column are then continuous. In addition, the bytes within + each table element may be 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. Byte shuffling often + improves the gzip compression of floating-point arrays. + + 2. Compress the contiguous array of bytes in each column using the specified + compression method. If no method is specifed, then a default method for that + data type is chosen. + + 3. Store the compressed stream of bytes into a column that has the same name + as in the input table, but which has a variable-length array data type (1QB). + The output table will contain one row for each piece of the original table. + + 4. If the input table contain variable-length arrays, then each VLA + is compressed individually, and written to the heap in the output table. + Note that the output table will contain 2 sets of pointers for each VLA column. + The first set contains the pointers to the uncompressed VLAs from the input table + and the second is the set of pointers to the compressed VLAs in the output table. + The latter set of pointers is used to reconstruct table when it is uncompressed, + so that the heap has exactly the same structure as in the original file. The 2 + sets of pointers are concatinated together, compressed with gzip, and written to + the output table. When reading the compressed table, the only VLA that is directly + visible is this compressed array of descriptors. One has to uncompress this array + to be able to to read all the descriptors to the individual VLAs in the column. +*/ +{ + long maxchunksize = 10000000; /* default value for the size of each chunk of the table */ + + char *cm_buffer; /* memory buffer for the transposed, Column-Major, chunk of the table */ + LONGLONG cm_colstart[1000]; /* starting offset of each column in the cm_buffer */ + LONGLONG rm_repeat[1000]; /* repeat count of each column in the input row-major table */ + LONGLONG rm_colwidth[999]; /* width in bytes of each column in the input row-major table */ + LONGLONG cm_repeat[999]; /* total number of elements in each column of the transposed column-major table */ + + int coltype[999]; /* data type code for each column */ + int compalgor[999], default_algor = 0; /* compression algorithm to be applied to each column */ + float cratio[999]; /* compression ratio for each column (for diagnostic purposes) */ + + float compressed_size, uncompressed_size, tot_compressed_size, tot_uncompressed_size; + LONGLONG nrows, firstrow; + LONGLONG headstart, datastart, dataend, startbyte, jj, kk, naxis1; + LONGLONG vlalen, vlamemlen, vlastart, bytepos; + long repeat, width, nchunks, rowspertile, lastrows; + int ii, ll, ncols, hdutype, ltrue = 1, print_report = 0, tstatus; + char *cptr, keyname[9], tform[40], *cdescript; + char comm[FLEN_COMMENT], keyvalue[FLEN_VALUE], *cvlamem, tempstring[FLEN_VALUE], card[FLEN_CARD]; + + LONGLONG *descriptors, *outdescript, *vlamem; + int *pdescriptors; + size_t dlen, datasize, compmemlen; + + /* ================================================================================== */ + /* perform initial sanity checks */ + /* ================================================================================== */ + + /* special input flag value that means print out diagnostics */ + if (*status == -999) { + print_report = 1; + *status = 0; + } + + if (*status > 0) + return(*status); + + fits_get_hdu_type(infptr, &hdutype, status); + if (hdutype != BINARY_TBL) { + *status = NOT_BTABLE; + return(*status); + } + + if (infptr == outfptr) { + ffpmsg("Cannot compress table 'in place' (fits_compress_table)"); + ffpmsg(" outfptr cannot be the same as infptr."); + *status = DATA_COMPRESSION_ERR; + return(*status); + } + + /* get dimensions of the table */ + fits_get_num_rowsll(infptr, &nrows, status); + fits_get_num_cols(infptr, &ncols, status); + fits_read_key(infptr, TLONGLONG, "NAXIS1", &naxis1, NULL, status); + /* get offset to the start of the data and total size of the table (including the heap) */ + fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status); + + if (*status > 0) + return(*status); + + tstatus = 0; + if (!fits_read_key(infptr, TSTRING, "FZALGOR", tempstring, NULL, &tstatus)) { + + if (!fits_strcasecmp(tempstring, "NONE")) { + default_algor = NOCOMPRESS; + } else if (!fits_strcasecmp(tempstring, "GZIP") || !fits_strcasecmp(tempstring, "GZIP_1")) { + default_algor = GZIP_1; + } else if (!fits_strcasecmp(tempstring, "GZIP_2")) { + default_algor = GZIP_2; + } else if (!fits_strcasecmp(tempstring, "RICE_1")) { + default_algor = RICE_1; + } else { + ffpmsg("FZALGOR specifies unsupported table compression algorithm:"); + ffpmsg(tempstring); + *status = DATA_COMPRESSION_ERR; + return(*status); + } + } + + /* just copy the HDU verbatim if the table has 0 columns or rows or if the table */ + /* is less than 5760 bytes (2 blocks) in size, or compression directive keyword = "NONE" */ + if (nrows < 1 || ncols < 1 || (dataend - datastart) < 5760 || default_algor == NOCOMPRESS) { + fits_copy_hdu (infptr, outfptr, 0, status); + return(*status); + } + + /* Check if the chunk size has been specified with the FZTILELN keyword. */ + /* If not, calculate a default number of rows per chunck, */ + + tstatus = 0; + if (fits_read_key(infptr, TLONG, "FZTILELN", &rowspertile, NULL, &tstatus)) { + rowspertile = (long) (maxchunksize / naxis1); + } + + if (rowspertile < 1) rowspertile = 1; + if (rowspertile > nrows) rowspertile = (long) nrows; + + nchunks = (long) ((nrows - 1) / rowspertile + 1); /* total number of chunks */ + lastrows = (long) (nrows - ((nchunks - 1) * rowspertile)); /* number of rows in last chunk */ + + /* allocate space for the transposed, column-major chunk of the table */ + cm_buffer = calloc((size_t) naxis1, (size_t) rowspertile); + if (!cm_buffer) { + ffpmsg("Could not allocate cm_buffer for transposed table"); + *status = MEMORY_ALLOCATION; + return(*status); + } + + /* ================================================================================== */ + /* Construct the header of the output compressed table */ + /* ================================================================================== */ + fits_copy_header(infptr, outfptr, status); /* start with verbatim copy of the input header */ + + fits_write_key(outfptr, TLOGICAL, "ZTABLE", <rue, "this is a compressed table", status); + fits_write_key(outfptr, TLONG, "ZTILELEN", &rowspertile, "number of rows in each tile", status); + + fits_read_card(outfptr, "NAXIS1", card, status); /* copy NAXIS1 to ZNAXIS1 */ + strncpy(card, "ZNAXIS1", 7); + fits_write_record(outfptr, card, status); + + fits_read_card(outfptr, "NAXIS2", card, status); /* copy NAXIS2 to ZNAXIS2 */ + strncpy(card, "ZNAXIS2", 7); + fits_write_record(outfptr, card, status); + + fits_read_card(outfptr, "PCOUNT", card, status); /* copy PCOUNT to ZPCOUNT */ + strncpy(card, "ZPCOUNT", 7); + fits_write_record(outfptr, card, status); + + fits_modify_key_lng(outfptr, "NAXIS2", nchunks, "&", status); /* 1 row per chunk */ + fits_modify_key_lng(outfptr, "NAXIS1", ncols * 16, "&", status); /* 16 bytes for each 1QB column */ + fits_modify_key_lng(outfptr, "PCOUNT", 0L, "&", status); /* reset PCOUNT to 0 */ + + /* rename the Checksum keywords, if they exist */ + tstatus = 0; + fits_modify_name(outfptr, "CHECKSUM", "ZHECKSUM", &tstatus); + tstatus = 0; + fits_modify_name(outfptr, "DATASUM", "ZDATASUM", &tstatus); + + /* ================================================================================== */ + /* Now loop over each column of the input table: write the column-specific keywords */ + /* and determine which compression algorithm to use. */ + /* Also calculate various offsets to the start of the column data in both the */ + /* original row-major table and in the transposed column-major form of the table. */ + /* ================================================================================== */ + + cm_colstart[0] = 0; + for (ii = 0; ii < ncols; ii++) { + + /* get the structural parameters of the original uncompressed column */ + fits_make_keyn("TFORM", ii+1, keyname, status); + fits_read_key(outfptr, TSTRING, keyname, tform, comm, status); + fits_binary_tform(tform, coltype+ii, &repeat, &width, status); /* get the repeat count and the width */ + + /* preserve the original TFORM value and comment string in a ZFORMn keyword */ + fits_read_card(outfptr, keyname, card, status); + card[0] = 'Z'; + fits_write_record(outfptr, card, status); + + /* All columns in the compressed table will have a variable-length array type. */ + fits_modify_key_str(outfptr, keyname, "1QB", "&", status); /* Use 'Q' pointers (64-bit) */ + + /* deal with special cases: bit, string, and variable length array columns */ + if (coltype[ii] == TBIT) { + repeat = (repeat + 7) / 8; /* convert from bits to equivalent number of bytes */ + } else if (coltype[ii] == TSTRING) { + width = 1; /* ignore the optional 'w' in 'rAw' format */ + } else if (coltype[ii] < 0) { /* pointer to variable length array */ + if (strchr(tform,'Q') ) { + width = 16; /* 'Q' descriptor has 64-bit pointers */ + } else { + width = 8; /* 'P' descriptor has 32-bit pointers */ + } + repeat = 1; + } + + rm_repeat[ii] = repeat; + rm_colwidth[ii] = repeat * width; /* column width (in bytes)in the input table */ + + /* starting offset of each field in the OUTPUT transposed column-major table */ + cm_colstart[ii + 1] = cm_colstart[ii] + rm_colwidth[ii] * rowspertile; + /* total number of elements in each column of the transposed column-major table */ + cm_repeat[ii] = rm_repeat[ii] * rowspertile; + + compalgor[ii] = default_algor; /* initialize the column compression algorithm to the default */ + + /* check if a compression method has been specified for this column */ + fits_make_keyn("FZALG", ii+1, keyname, status); + tstatus = 0; + if (!fits_read_key(outfptr, TSTRING, keyname, tempstring, NULL, &tstatus)) { + + if (!fits_strcasecmp(tempstring, "GZIP") || !fits_strcasecmp(tempstring, "GZIP_1")) { + compalgor[ii] = GZIP_1; + } else if (!fits_strcasecmp(tempstring, "GZIP_2")) { + compalgor[ii] = GZIP_2; + } else if (!fits_strcasecmp(tempstring, "RICE_1")) { + compalgor[ii] = RICE_1; + } else { + ffpmsg("Unsupported table compression algorithm specification."); + ffpmsg(keyname); + ffpmsg(tempstring); + *status = DATA_COMPRESSION_ERR; + free(cm_buffer); + return(*status); + } + } + + /* do sanity check of the requested algorithm and override if necessary */ + if ( abs(coltype[ii]) == TLOGICAL || abs(coltype[ii]) == TBIT || abs(coltype[ii]) == TSTRING) { + if (compalgor[ii] != GZIP_1) { + compalgor[ii] = GZIP_1; + } + } else if ( abs(coltype[ii]) == TCOMPLEX || abs(coltype[ii]) == TDBLCOMPLEX || + abs(coltype[ii]) == TFLOAT || abs(coltype[ii]) == TDOUBLE || + abs(coltype[ii]) == TLONGLONG ) { + if (compalgor[ii] != GZIP_1 && compalgor[ii] != GZIP_2) { + compalgor[ii] = GZIP_2; /* gzip_2 usually works better gzip_1 */ + } + } else if ( abs(coltype[ii]) == TSHORT ) { + if (compalgor[ii] != GZIP_1 && compalgor[ii] != GZIP_2 && compalgor[ii] != RICE_1) { + compalgor[ii] = GZIP_2; /* gzip_2 usually works better rice_1 */ + } + } else if ( abs(coltype[ii]) == TLONG ) { + if (compalgor[ii] != GZIP_1 && compalgor[ii] != GZIP_2 && compalgor[ii] != RICE_1) { + compalgor[ii] = RICE_1; + } + } else if ( abs(coltype[ii]) == TBYTE ) { + if (compalgor[ii] != GZIP_1 && compalgor[ii] != RICE_1 ) { + compalgor[ii] = GZIP_1; + } + } + } /* end of loop over columns */ + + /* ================================================================================== */ + /* now process each chunk of the table, in turn */ + /* ================================================================================== */ + + tot_uncompressed_size = 0.; + tot_compressed_size = 0; + firstrow = 1; + for (ll = 0; ll < nchunks; ll++) { + + if (ll == nchunks - 1) { /* the last chunk may have fewer rows */ + rowspertile = lastrows; + for (ii = 0; ii < ncols; ii++) { + cm_colstart[ii + 1] = cm_colstart[ii] + (rm_colwidth[ii] * rowspertile); + cm_repeat[ii] = rm_repeat[ii] * rowspertile; + } + } + + /* move to the start of the chunk in the input table */ + ffmbyt(infptr, datastart, 0, status); + + /* ================================================================================*/ + /* First, transpose this chunck from row-major order to column-major order */ + /* At the same time, shuffle the bytes in each datum, if doing GZIP_2 compression */ + /* ================================================================================*/ + + for (jj = 0; jj < rowspertile; jj++) { /* loop over rows */ + for (ii = 0; ii < ncols; ii++) { /* loop over columns */ + + if (rm_repeat[ii] > 0) { /* skip virtual columns that have 0 elements */ + + kk = 0; + + /* if the GZIP_2 compression algorithm is used, shuffle the bytes */ + if (coltype[ii] == TSHORT && compalgor[ii] == GZIP_2) { + while(kk < rm_colwidth[ii]) { + cptr = cm_buffer + (cm_colstart[ii] + (jj * rm_repeat[ii]) + kk/2); + ffgbyt(infptr, 1, cptr, status); /* get 1st byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 2nd byte */ + kk += 2; + } + } else if ((coltype[ii] == TFLOAT || coltype[ii] == TLONG) && compalgor[ii] == GZIP_2) { + while(kk < rm_colwidth[ii]) { + cptr = cm_buffer + (cm_colstart[ii] + (jj * rm_repeat[ii]) + kk/4); + ffgbyt(infptr, 1, cptr, status); /* get 1st byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 2nd byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 3rd byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 4th byte */ + kk += 4; + } + } else if ( (coltype[ii] == TDOUBLE || coltype[ii] == TLONGLONG) && compalgor[ii] == GZIP_2) { + while(kk < rm_colwidth[ii]) { + cptr = cm_buffer + (cm_colstart[ii] + (jj * rm_repeat[ii]) + kk/8); + ffgbyt(infptr, 1, cptr, status); /* get 1st byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 2nd byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 3rd byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 4th byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 5th byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 6th byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 7th byte */ + cptr += cm_repeat[ii]; + ffgbyt(infptr, 1, cptr, status); /* get 8th byte */ + kk += 8; + } + } else { /* all other cases: don't shuffle the bytes; simply transpose the column */ + cptr = cm_buffer + (cm_colstart[ii] + (jj * rm_colwidth[ii])); /* addr to copy to */ + startbyte = (infptr->Fptr)->bytepos; /* save the starting byte location */ + ffgbyt(infptr, rm_colwidth[ii], cptr, status); /* copy all the bytes */ + + if (rm_colwidth[ii] >= MINDIRECT) { /* have to explicitly move to next byte */ + ffmbyt(infptr, startbyte + rm_colwidth[ii], 0, status); + } + } /* end of test of coltypee */ + + } /* end of not virtual column */ + } /* end of loop over columns */ + } /* end of loop over rows */ + + /* ================================================================================*/ + /* now compress each column in the transposed chunk of the table */ + /* ================================================================================*/ + + fits_set_hdustruc(outfptr, status); /* initialize structures in the output table */ + + for (ii = 0; ii < ncols; ii++) { /* loop over columns */ + /* initialize the diagnostic compression results string */ + snprintf(results[ii],30,"%3d %3d %3d ", ii+1, coltype[ii], compalgor[ii]); + cratio[ii] = 0; + + if (rm_repeat[ii] > 0) { /* skip virtual columns with zero width */ + + if (coltype[ii] < 0) { /* this is a variable length array (VLA) column */ + + /*=========================================================================*/ + /* variable-length array columns are a complicated special case */ + /*=========================================================================*/ + + /* allocate memory to hold all the VLA descriptors from the input table, plus */ + /* room to hold the descriptors to the compressed VLAs in the output table */ + /* In total, there will be 2 descriptors for each row in this chunk */ + + uncompressed_size = 0.; + compressed_size = 0; + + datasize = (size_t) (cm_colstart[ii + 1] - cm_colstart[ii]); /* size of input descriptors */ + + cdescript = calloc(datasize + (rowspertile * 16), 1); /* room for both descriptors */ + if (!cdescript) { + ffpmsg("Could not allocate buffer for descriptors"); + *status = MEMORY_ALLOCATION; + free(cm_buffer); + return(*status); + } + + /* copy the input descriptors to this array */ + memcpy(cdescript, &cm_buffer[cm_colstart[ii]], datasize); +#if BYTESWAPPED + /* byte-swap the integer values into the native machine representation */ + if (rm_colwidth[ii] == 16) { + ffswap8((double *) cdescript, rowspertile * 2); + } else { + ffswap4((int *) cdescript, rowspertile * 2); + } +#endif + descriptors = (LONGLONG *) cdescript; /* use this for Q type descriptors */ + pdescriptors = (int *) cdescript; /* use this instead for or P type descriptors */ + /* pointer to the 2nd set of descriptors */ + outdescript = (LONGLONG *) (cdescript + datasize); /* this is a LONGLONG pointer */ + + for (jj = 0; jj < rowspertile; jj++) { /* loop to compress each VLA in turn */ + + if (rm_colwidth[ii] == 16) { /* if Q pointers */ + vlalen = descriptors[jj * 2]; + vlastart = descriptors[(jj * 2) + 1]; + } else { /* if P pointers */ + vlalen = (LONGLONG) pdescriptors[jj * 2]; + vlastart = (LONGLONG) pdescriptors[(jj * 2) + 1]; + } + + if (vlalen > 0) { /* skip zero-length VLAs */ + + vlamemlen = vlalen * (int) (-coltype[ii] / 10); + vlamem = (LONGLONG *) malloc((size_t) vlamemlen); /* memory for the input uncompressed VLA */ + if (!vlamem) { + ffpmsg("Could not allocate buffer for VLA"); + *status = MEMORY_ALLOCATION; + free(cdescript); free(cm_buffer); + return(*status); + } + + compmemlen = (size_t) (vlalen * ((LONGLONG) (-coltype[ii] / 10)) * 1.5); + if (compmemlen < 100) compmemlen = 100; + cvlamem = malloc(compmemlen); /* memory for the output compressed VLA */ + if (!cvlamem) { + ffpmsg("Could not allocate buffer for compressed data"); + *status = MEMORY_ALLOCATION; + free(vlamem); free(cdescript); free(cm_buffer); + return(*status); + } + + /* read the raw bytes directly from the heap, without any byte-swapping or null value detection */ + bytepos = (infptr->Fptr)->datastart + (infptr->Fptr)->heapstart + vlastart; + ffmbyt(infptr, bytepos, REPORT_EOF, status); + ffgbyt(infptr, vlamemlen, vlamem, status); /* read the bytes */ + uncompressed_size += vlamemlen; /* total size of the uncompressed VLAs */ + tot_uncompressed_size += vlamemlen; /* total size of the uncompressed file */ + + /* compress the VLA with the appropriate algorithm */ + if (compalgor[ii] == RICE_1) { + + if (-coltype[ii] == TSHORT) { +#if BYTESWAPPED + ffswap2((short *) (vlamem), (long) vlalen); +#endif + dlen = fits_rcomp_short ((short *)(vlamem), (int) vlalen, (unsigned char *) cvlamem, + (int) compmemlen, 32); + } else if (-coltype[ii] == TLONG) { +#if BYTESWAPPED + ffswap4((int *) (vlamem), (long) vlalen); +#endif + dlen = fits_rcomp ((int *)(vlamem), (int) vlalen, (unsigned char *) cvlamem, + (int) compmemlen, 32); + } else if (-coltype[ii] == TBYTE) { + dlen = fits_rcomp_byte ((signed char *)(vlamem), (int) vlalen, (unsigned char *) cvlamem, + (int) compmemlen, 32); + } else { + /* this should not happen */ + ffpmsg(" Error: cannot compress this column type with the RICE algorithm"); + free(vlamem); free(cdescript); free(cm_buffer); free(cvlamem); + *status = DATA_COMPRESSION_ERR; + return(*status); + } + } else if (compalgor[ii] == GZIP_1 || compalgor[ii] == GZIP_2){ + if (compalgor[ii] == GZIP_2 ) { /* shuffle the bytes before gzipping them */ + if ( (int) (-coltype[ii] / 10) == 2) { + fits_shuffle_2bytes((char *) vlamem, vlalen, status); + } else if ( (int) (-coltype[ii] / 10) == 4) { + fits_shuffle_4bytes((char *) vlamem, vlalen, status); + } else if ( (int) (-coltype[ii] / 10) == 8) { + fits_shuffle_8bytes((char *) vlamem, vlalen, status); + } + } + /*: gzip compress the array of bytes */ + compress2mem_from_mem( (char *) vlamem, (size_t) vlamemlen, + &cvlamem, &compmemlen, realloc, &dlen, status); + } else { + /* this should not happen */ + ffpmsg(" Error: unknown compression algorithm"); + free(vlamem); free(cdescript); free(cm_buffer); free(cvlamem); + *status = DATA_COMPRESSION_ERR; + return(*status); + } + + /* write the compressed array to the output table, but... */ + /* We use a trick of always writing the array to the same row of the output table */ + /* and then copy the descriptor into the array of descriptors that we allocated. */ + + /* First, reset the descriptor */ + fits_write_descript(outfptr, ii+1, ll+1, 0, 0, status); + + /* write the compressed VLA if it is smaller than the original, else write */ + /* the uncompressed array */ + fits_set_tscale(outfptr, ii + 1, 1.0, 0.0, status); /* turn off any data scaling, first */ + if (dlen < vlamemlen) { + fits_write_col(outfptr, TBYTE, ii + 1, ll+1, 1, dlen, cvlamem, status); + compressed_size += dlen; /* total size of the compressed VLAs */ + tot_compressed_size += dlen; /* total size of the compressed file */ + } else { + if ( -coltype[ii] != TBYTE && compalgor[ii] != GZIP_1) { + /* it is probably faster to reread the raw bytes, rather than unshuffle or unswap them */ + bytepos = (infptr->Fptr)->datastart + (infptr->Fptr)->heapstart + vlastart; + ffmbyt(infptr, bytepos, REPORT_EOF, status); + ffgbyt(infptr, vlamemlen, vlamem, status); /* read the bytes */ + } + fits_write_col(outfptr, TBYTE, ii + 1, ll+1, 1, vlamemlen, vlamem, status); + compressed_size += vlamemlen; /* total size of the compressed VLAs */ + tot_compressed_size += vlamemlen; /* total size of the compressed file */ + } + + /* read back the descriptor and save it in the array of descriptors */ + fits_read_descriptll(outfptr, ii + 1, ll + 1, outdescript+(jj*2), outdescript+(jj*2)+1, status); + free(cvlamem); free(vlamem); + + } /* end of vlalen > 0 */ + } /* end of loop over rows */ + + if (compressed_size != 0) + cratio[ii] = uncompressed_size / compressed_size; + + snprintf(tempstring,FLEN_VALUE," r=%6.2f",cratio[ii]); + strncat(results[ii],tempstring, 29-strlen(results[ii])); + + /* now we just have to compress the array of descriptors (both input and output) */ + /* and write them to the output table. */ + + /* allocate memory for the compressed descriptors */ + cvlamem = malloc(datasize + (rowspertile * 16) ); + if (!cvlamem) { + ffpmsg("Could not allocate buffer for compressed data"); + *status = MEMORY_ALLOCATION; + free(cdescript); free(cm_buffer); + return(*status); + } + +#if BYTESWAPPED + /* byte swap the input and output descriptors */ + if (rm_colwidth[ii] == 16) { + ffswap8((double *) cdescript, rowspertile * 2); + } else { + ffswap4((int *) cdescript, rowspertile * 2); + } + ffswap8((double *) outdescript, rowspertile * 2); +#endif + /* compress the array contain both sets of descriptors */ + compress2mem_from_mem((char *) cdescript, datasize + (rowspertile * 16), + &cvlamem, &datasize, realloc, &dlen, status); + + free(cdescript); + + /* write the compressed descriptors to the output column */ + fits_set_tscale(outfptr, ii + 1, 1.0, 0.0, status); /* turn off any data scaling, first */ + fits_write_descript(outfptr, ii+1, ll+1, 0, 0, status); /* First, reset the descriptor */ + fits_write_col(outfptr, TBYTE, ii + 1, ll+1, 1, dlen, cvlamem, status); + free(cvlamem); + + if (ll == 0) { /* only write the ZCTYPn keyword once, while processing the first column */ + fits_make_keyn("ZCTYP", ii+1, keyname, status); + + if (compalgor[ii] == RICE_1) { + strcpy(keyvalue, "RICE_1"); + } else if (compalgor[ii] == GZIP_2) { + strcpy(keyvalue, "GZIP_2"); + } else { + strcpy(keyvalue, "GZIP_1"); + } + + fits_write_key(outfptr, TSTRING, keyname, keyvalue, + "compression algorithm for column", status); + } + + continue; /* jump to end of loop, to go to next column */ + } /* end of VLA case */ + + /* ================================================================================*/ + /* deal with all the normal fixed-length columns here */ + /* ================================================================================*/ + + /* allocate memory for the compressed data */ + datasize = (size_t) (cm_colstart[ii + 1] - cm_colstart[ii]); + cvlamem = malloc(datasize*2); + tot_uncompressed_size += datasize; + + if (!cvlamem) { + ffpmsg("Could not allocate buffer for compressed data"); + *status = MEMORY_ALLOCATION; + free(cm_buffer); + return(*status); + } + + if (compalgor[ii] == RICE_1) { + if (coltype[ii] == TSHORT) { +#if BYTESWAPPED + ffswap2((short *) (cm_buffer + cm_colstart[ii]), datasize / 2); +#endif + dlen = fits_rcomp_short ((short *)(cm_buffer + cm_colstart[ii]), datasize / 2, (unsigned char *) cvlamem, + datasize * 2, 32); + + } else if (coltype[ii] == TLONG) { +#if BYTESWAPPED + ffswap4((int *) (cm_buffer + cm_colstart[ii]), datasize / 4); +#endif + dlen = fits_rcomp ((int *)(cm_buffer + cm_colstart[ii]), datasize / 4, (unsigned char *) cvlamem, + datasize * 2, 32); + + } else if (coltype[ii] == TBYTE) { + + dlen = fits_rcomp_byte ((signed char *)(cm_buffer + cm_colstart[ii]), datasize, (unsigned char *) cvlamem, + datasize * 2, 32); + } else { /* this should not happen */ + ffpmsg(" Error: cannot compress this column type with the RICE algorthm"); + free(cvlamem); free(cm_buffer); + *status = DATA_COMPRESSION_ERR; + return(*status); + } + } else { + /* all other cases: gzip compress the column (bytes may have been shuffled previously) */ + compress2mem_from_mem(cm_buffer + cm_colstart[ii], datasize, + &cvlamem, &datasize, realloc, &dlen, status); + } + + if (ll == 0) { /* only write the ZCTYPn keyword once, while processing the first column */ + fits_make_keyn("ZCTYP", ii+1, keyname, status); + + if (compalgor[ii] == RICE_1) { + strcpy(keyvalue, "RICE_1"); + } else if (compalgor[ii] == GZIP_2) { + strcpy(keyvalue, "GZIP_2"); + } else { + strcpy(keyvalue, "GZIP_1"); + } + + fits_write_key(outfptr, TSTRING, keyname, keyvalue, + "compression algorithm for column", 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, ll+1, 1, dlen, cvlamem, status); + tot_compressed_size += dlen; + + free(cvlamem); /* don't need the compressed data any more */ + + /* create diagnostic messages */ + if (dlen != 0) + cratio[ii] = (float) datasize / (float) dlen; /* compression ratio of the column */ + + snprintf(tempstring,FLEN_VALUE," r=%6.2f",cratio[ii]); + strncat(results[ii],tempstring,29-strlen(results[ii])); + + } /* end of not a virtual column */ + } /* end of loop over columns */ + + datastart += (rowspertile * naxis1); /* increment to start of next chunk */ + firstrow += rowspertile; /* increment first row in next chunk */ + + if (print_report) { + printf("\nChunk = %d\n",ll+1); + for (ii = 0; ii < ncols; ii++) { + printf("%s\n", results[ii]); + } + } + + } /* end of loop over chunks of the table */ + + /* =================================================================================*/ + /* all done; just clean up and return */ + /* ================================================================================*/ + + free(cm_buffer); + fits_set_hdustruc(outfptr, status); /* reset internal structures */ + + if (print_report) { + + if (tot_compressed_size != 0) + printf("\nTotal data size (MB) %.3f -> %.3f, ratio = %.3f\n", tot_uncompressed_size/1000000., + tot_compressed_size/1000000., tot_uncompressed_size/tot_compressed_size); + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int fits_uncompress_table(fitsfile *infptr, fitsfile *outfptr, int *status) + +/* + Uncompress the table that was compressed with fits_compress_table +*/ +{ + char colcode[999]; /* column data type code character */ + char coltype[999]; /* column data type numeric code value */ + char *cm_buffer; /* memory buffer for the transposed, Column-Major, chunk of the table */ + char *rm_buffer; /* memory buffer for the original, Row-Major, chunk of the table */ + 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 = 0, dataend, rowsremain, *descript, *qdescript = 0; + LONGLONG rowstart, cvlalen, cvlastart, vlalen, vlastart; + long repeat, width, vla_repeat, vla_address, rowspertile, ntile; + int ncols, hdutype, inttype, anynull, tstatus, zctype[999], addspace = 0, *pdescript = 0; + char *cptr, keyname[9], tform[40]; + long pcount, zheapptr, naxis1, naxis2, ii, jj; + char *ptr, comm[FLEN_COMMENT], zvalue[FLEN_VALUE], *uncompressed_vla = 0, *compressed_vla; + char card[FLEN_CARD]; + size_t dlen, fullsize, cm_size, bytepos, vlamemlen; + + /* ================================================================================== */ + /* perform initial sanity checks */ + /* ================================================================================== */ + if (*status > 0) + return(*status); + + fits_get_hdu_type(infptr, &hdutype, status); + if (hdutype != BINARY_TBL) { + ffpmsg("This is not a binary table, so cannot uncompress it!"); + *status = NOT_BTABLE; + return(*status); + } + + if (fits_read_key(infptr, TLOGICAL, "ZTABLE", &tstatus, NULL, status)) { + /* just copy the HDU if the table is not compressed */ + if (infptr != outfptr) { + fits_copy_hdu (infptr, outfptr, 0, status); + } + return(*status); + } + + fits_get_num_rowsll(infptr, &nrows, status); + fits_get_num_cols(infptr, &ncols, status); + + if ((ncols < 1)) { + /* just copy the HDU if the table does not have more than 0 columns */ + if (infptr != outfptr) { + fits_copy_hdu (infptr, outfptr, 0, status); + } + return(*status); + } + + fits_read_key(infptr, TLONG, "ZTILELEN", &rowspertile, comm, status); + if (*status > 0) { + ffpmsg("Could not find the required ZTILELEN keyword"); + *status = DATA_DECOMPRESSION_ERR; + 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 = DATA_DECOMPRESSION_ERR; + return(*status); + } + + fits_read_key(infptr, TLONG, "ZNAXIS2", &naxis2, comm, status); + if (*status > 0) { + ffpmsg("Could not find the required ZNAXIS2 keyword"); + *status = DATA_DECOMPRESSION_ERR; + return(*status); + } + + /* silently ignore illegal ZTILELEN value if too large */ + if (rowspertile > naxis2) rowspertile = naxis2; + + fits_read_key(infptr, TLONG, "ZPCOUNT", &pcount, comm, status); + if (*status > 0) { + ffpmsg("Could not find the required ZPCOUNT keyword"); + *status = DATA_DECOMPRESSION_ERR; + return(*status); + } + + tstatus = 0; + fits_read_key(infptr, TLONG, "ZHEAPPTR", &zheapptr, comm, &tstatus); + if (tstatus > 0) { + zheapptr = 0; /* uncompressed table has no heap */ + } + + /* ================================================================================== */ + /* copy of the input header, then recreate the uncompressed table keywords */ + /* ================================================================================== */ + fits_copy_header(infptr, outfptr, status); + + /* reset the NAXIS1, NAXIS2. and PCOUNT keywords to the original */ + fits_read_card(outfptr, "ZNAXIS1", card, status); + strncpy(card, "NAXIS1 ", 7); + fits_update_card(outfptr, "NAXIS1", card, status); + + fits_read_card(outfptr, "ZNAXIS2", card, status); + strncpy(card, "NAXIS2 ", 7); + fits_update_card(outfptr, "NAXIS2", card, status); + + fits_read_card(outfptr, "ZPCOUNT", card, status); + strncpy(card, "PCOUNT ", 7); + fits_update_card(outfptr, "PCOUNT", card, status); + + fits_delete_key(outfptr, "ZTABLE", status); + fits_delete_key(outfptr, "ZTILELEN", status); + fits_delete_key(outfptr, "ZNAXIS1", status); + fits_delete_key(outfptr, "ZNAXIS2", status); + fits_delete_key(outfptr, "ZPCOUNT", status); + tstatus = 0; + fits_delete_key(outfptr, "CHECKSUM", &tstatus); + tstatus = 0; + fits_delete_key(outfptr, "DATASUM", &tstatus); + /* restore the Checksum keywords, if they exist */ + tstatus = 0; + fits_modify_name(outfptr, "ZHECKSUM", "CHECKSUM", &tstatus); + tstatus = 0; + fits_modify_name(outfptr, "ZDATASUM", "DATASUM", &tstatus); + + /* ================================================================================== */ + /* determine compression paramters for each column and write column-specific keywords */ + /* ================================================================================== */ + 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 */ + fits_read_card(outfptr, keyname, card, status); + card[0] = 'T'; + keyname[0] = 'T'; + fits_update_card(outfptr, keyname, card, 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, &inttype, &repeat, &width, status); + coltype[ii] = inttype; + + /* deal with special cases */ + if (abs(coltype[ii]) == TBIT) { + repeat = (repeat + 7) / 8 ; /* convert from bits to bytes */ + } else if (abs(coltype[ii]) == TSTRING) { + width = 1; + } else if (coltype[ii] < 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 */ + + addspace += 16; /* need space for a second set of Q pointers for this column */ + } + + rmajor_repeat[ii] = repeat; + + /* width (in bytes) of each field in the row-major table */ + rmajor_colwidth[ii] = rmajor_repeat[ii] * width; + + /* 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); + } + } + + /* rescan header keywords to reset internal table structure parameters */ + fits_set_hdustruc(outfptr, status); + + /* ================================================================================== */ + /* allocate memory for the transposed and untransposed tile of the table */ + /* ================================================================================== */ + + fullsize = naxis1 * rowspertile; + cm_size = fullsize + (addspace * rowspertile); + + cm_buffer = malloc(cm_size); + if (!cm_buffer) { + ffpmsg("Could not allocate buffer for transformed column-major table"); + *status = MEMORY_ALLOCATION; + return(*status); + } + + rm_buffer = malloc(fullsize); + if (!rm_buffer) { + ffpmsg("Could not allocate buffer for untransformed row-major table"); + *status = MEMORY_ALLOCATION; + free(cm_buffer); + return(*status); + } + + /* ================================================================================== */ + /* Main loop over all the tiles */ + /* ================================================================================== */ + + rowsremain = naxis2; + rowstart = 1; + ntile = 0; + + while(rowsremain) { + + /* ================================================================================== */ + /* loop over each column: read and uncompress the bytes */ + /* ================================================================================== */ + ntile++; + rmajor_colstart[0] = 0; + cmajor_colstart[0] = 0; + for (ii = 0; ii < ncols; ii++) { + + cmajor_repeat[ii] = rmajor_repeat[ii] * rowspertile; + + /* starting offset of each field in the column-major table */ + if (coltype[ii] > 0) { /* normal fixed length column */ + cmajor_colstart[ii + 1] = cmajor_colstart[ii] + rmajor_colwidth[ii] * rowspertile; + } else { /* VLA column: reserve space for the 2nd set of Q pointers */ + cmajor_colstart[ii + 1] = cmajor_colstart[ii] + (rmajor_colwidth[ii] + 16) * rowspertile; + } + /* length of each sequence of bytes, after sorting them in signicant order */ + cmajor_bytespan[ii] = (rmajor_repeat[ii] * rowspertile); + + /* starting offset of each field in the row-major table */ + rmajor_colstart[ii + 1] = rmajor_colstart[ii] + rmajor_colwidth[ii]; + + if (rmajor_repeat[ii] > 0) { /* ignore columns with 0 elements */ + + /* read compressed bytes from input table */ + fits_read_descript(infptr, ii + 1, ntile, &vla_repeat, &vla_address, status); + + /* allocate memory and read in the compressed bytes */ + ptr = malloc(vla_repeat); + if (!ptr) { + ffpmsg("Could not allocate buffer for uncompressed bytes"); + *status = MEMORY_ALLOCATION; + free(rm_buffer); free(cm_buffer); + 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, ntile, 1, vla_repeat, 0, (unsigned char *) ptr, &anynull, status); + cptr = cm_buffer + cmajor_colstart[ii]; + + /* size in bytes of the uncompressed column of bytes */ + fullsize = (size_t) (cmajor_colstart[ii+1] - cmajor_colstart[ii]); + + switch (colcode[ii]) { + + 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: + /* all variable length array columns are included in this case */ + /* 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); + } /* end of rmajor_repeat > 0 */ + } /* end of loop over columns */ + + /* now transpose the rows and columns (from cm_buffer to rm_buffer) */ + /* move each byte, in turn, from the cm_buffer to the appropriate place in the rm_buffer */ + for (ii = 0; ii < ncols; ii++) { /* loop over columns */ + ptr = (char *) (cm_buffer + cmajor_colstart[ii]); /* initialize ptr to start of the column in the cm_buffer */ + if (rmajor_repeat[ii] > 0) { /* skip columns with zero elements */ + if (coltype[ii] > 0) { /* normal fixed length array columns */ + if (zctype[ii] == GZIP_2) { /* need to unshuffle the bytes */ + + /* recombine the byte planes for the 2-byte, 4-byte, and 8-byte numeric columns */ + switch (colcode[ii]) { + + case 'I': + /* get the 1st byte of each I*2 value */ + for (jj = 0; jj < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_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 attempt to use GZIP_2 to compress a column unsuitable data type"); + *status = DATA_DECOMPRESSION_ERR; + free(rm_buffer); free(cm_buffer); + return(*status); + + } /* end of switch for shuffling the bytes*/ + + } else { /* not GZIP_2, don't have to shuffle bytes, so just transpose the rows and columns */ + + for (jj = 0; jj < rowspertile; jj++) { /* loop over number of rows in the output table */ + cptr = rm_buffer + (rmajor_colstart[ii] + jj * rmajor_colstart[ncols]); /* addr to copy to */ + memcpy(cptr, ptr, (size_t) rmajor_colwidth[ii]); + + ptr += (rmajor_colwidth[ii]); + } + } + } else { /* transpose the variable length array pointers */ + + for (jj = 0; jj < rowspertile; jj++) { /* loop over number of rows in the output uncompressed table */ + cptr = rm_buffer + (rmajor_colstart[ii] + jj * rmajor_colstart[ncols]); /* addr to copy to */ + memcpy(cptr, ptr, (size_t) rmajor_colwidth[ii]); + + ptr += (rmajor_colwidth[ii]); + } + + if (rmajor_colwidth[ii] == 8 ) { /* these are P-type descriptors */ + pdescript = (int *) (cm_buffer + cmajor_colstart[ii]); +#if BYTESWAPPED + ffswap4((int *) pdescript, rowspertile * 2); /* byte-swap the descriptor */ +#endif + } else if (rmajor_colwidth[ii] == 16 ) { /* these are Q-type descriptors */ + qdescript = (LONGLONG *) (cm_buffer + cmajor_colstart[ii]); +#if BYTESWAPPED + ffswap8((double *) qdescript, rowspertile * 2); /* byte-swap the descriptor */ +#endif + } else { /* this should never happen */ + ffpmsg("Error: Descriptor column is neither 8 nor 16 bytes wide"); + free(rm_buffer); free(cm_buffer); + *status = DATA_DECOMPRESSION_ERR; + return(*status); + } + + /* First, set pointer to the Q descriptors, and byte-swap them, if needed */ + descript = (LONGLONG*) (cm_buffer + cmajor_colstart[ii] + (rmajor_colwidth[ii] * rowspertile)); +#if BYTESWAPPED + /* byte-swap the descriptor */ + ffswap8((double *) descript, rowspertile * 2); +#endif + + /* now uncompress all the individual VLAs, and */ + /* write them to their original location in the uncompressed file */ + + for (jj = 0; jj < rowspertile; jj++) { /* loop over rows */ + /* get the size and location of the compressed VLA in the compressed table */ + cvlalen = descript[jj * 2]; + cvlastart = descript[(jj * 2) + 1]; + if (cvlalen > 0 ) { + + /* get the size and location to write the uncompressed VLA in the uncompressed table */ + if (rmajor_colwidth[ii] == 8 ) { + vlalen = pdescript[jj * 2]; + vlastart = pdescript[(jj * 2) + 1]; + } else { + vlalen = qdescript[jj * 2]; + vlastart = qdescript[(jj * 2) + 1]; + } + vlamemlen = (size_t) (vlalen * (-coltype[ii] / 10)); /* size of the uncompressed VLA, in bytes */ + + /* allocate memory for the compressed vla */ + compressed_vla = malloc( (size_t) cvlalen); + if (!compressed_vla) { + ffpmsg("Could not allocate buffer for compressed VLA"); + free(rm_buffer); free(cm_buffer); + *status = MEMORY_ALLOCATION; + return(*status); + } + + /* read the compressed VLA from the heap in the input compressed table */ + bytepos = (size_t) ((infptr->Fptr)->datastart + (infptr->Fptr)->heapstart + cvlastart); + ffmbyt(infptr, bytepos, REPORT_EOF, status); + ffgbyt(infptr, cvlalen, compressed_vla, status); /* read the bytes */ + /* if the VLA couldn't be compressed, just copy it directly to the output uncompressed table */ + if (cvlalen == vlamemlen ) { + bytepos = (size_t) ((outfptr->Fptr)->datastart + (outfptr->Fptr)->heapstart + vlastart); + ffmbyt(outfptr, bytepos, IGNORE_EOF, status); + ffpbyt(outfptr, cvlalen, compressed_vla, status); /* write the bytes */ + } else { /* uncompress the VLA */ + + /* allocate memory for the uncompressed VLA */ + uncompressed_vla = malloc(vlamemlen); + if (!uncompressed_vla) { + ffpmsg("Could not allocate buffer for uncompressed VLA"); + *status = MEMORY_ALLOCATION; + free(compressed_vla); free(rm_buffer); free(cm_buffer); + return(*status); + } + /* uncompress the VLA with the appropriate algorithm */ + if (zctype[ii] == RICE_1) { + + if (-coltype[ii] == TSHORT) { + dlen = fits_rdecomp_short((unsigned char *) compressed_vla, (int) cvlalen, (unsigned short *)uncompressed_vla, + (int) vlalen, 32); +#if BYTESWAPPED + ffswap2((short *) uncompressed_vla, (long) vlalen); +#endif + } else if (-coltype[ii] == TLONG) { + dlen = fits_rdecomp((unsigned char *) compressed_vla, (int) cvlalen, (unsigned int *)uncompressed_vla, + (int) vlalen, 32); +#if BYTESWAPPED + ffswap4((int *) uncompressed_vla, (long) vlalen); +#endif + } else if (-coltype[ii] == TBYTE) { + dlen = fits_rdecomp_byte((unsigned char *) compressed_vla, (int) cvlalen, (unsigned char *) uncompressed_vla, + (int) vlalen, 32); + } else { + /* this should not happen */ + ffpmsg(" Error: cannot uncompress this column type with the RICE algorithm"); + + *status = DATA_DECOMPRESSION_ERR; + free(uncompressed_vla); free(compressed_vla); free(rm_buffer); free(cm_buffer); + return(*status); + } + + } else if (zctype[ii] == GZIP_1 || zctype[ii] == GZIP_2){ + + /*: gzip uncompress the array of bytes */ + uncompress2mem_from_mem( compressed_vla, (size_t) cvlalen, &uncompressed_vla, &vlamemlen, realloc, &vlamemlen, status); + + if (zctype[ii] == GZIP_2 ) { + /* unshuffle the bytes after ungzipping them */ + if ( (int) (-coltype[ii] / 10) == 2) { + fits_unshuffle_2bytes((char *) uncompressed_vla, vlalen, status); + } else if ( (int) (-coltype[ii] / 10) == 4) { + fits_unshuffle_4bytes((char *) uncompressed_vla, vlalen, status); + } else if ( (int) (-coltype[ii] / 10) == 8) { + fits_unshuffle_8bytes((char *) uncompressed_vla, vlalen, status); + } + } + + } else { + /* this should not happen */ + ffpmsg(" Error: unknown compression algorithm"); + free(uncompressed_vla); free(compressed_vla); free(rm_buffer); free(cm_buffer); + *status = DATA_COMPRESSION_ERR; + return(*status); + } + + bytepos = (size_t) ((outfptr->Fptr)->datastart + (outfptr->Fptr)->heapstart + vlastart); + ffmbyt(outfptr, bytepos, IGNORE_EOF, status); + ffpbyt(outfptr, vlamemlen, uncompressed_vla, status); /* write the bytes */ + + free(uncompressed_vla); + } /* end of uncompress VLA */ + + free(compressed_vla); + + } /* end of vlalen > 0 */ + } /* end of loop over rowspertile */ + + } /* end of variable length array section*/ + } /* end of if column repeat > 0 */ + } /* end of ncols loop */ + + /* copy the buffer of data to the output data unit */ + + if (datastart == 0) fits_get_hduaddrll(outfptr, &headstart, &datastart, &dataend, status); + + ffmbyt(outfptr, datastart, 1, status); + ffpbyt(outfptr, naxis1 * rowspertile, rm_buffer, status); + + /* increment pointers for next tile */ + rowstart += rowspertile; + rowsremain -= rowspertile; + datastart += (naxis1 * rowspertile); + if (rowspertile > rowsremain) rowspertile = (long) rowsremain; + + } /* end of while rows still remain */ + + free(rm_buffer); + free(cm_buffer); + + /* reset internal table structure parameters */ + 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_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); +} +/*--------------------------------------------------------------------------*/ +static int fits_int_to_longlong_inplace(int *intarray, long length, int *status) + +/* convert the input array of 32-bit integers into an array of 64-bit integers, +in place. This will overwrite the input array with the new longer array starting +at the same memory location. + +Note that aliasing the same memory location with pointers of different datatypes is +not allowed in strict ANSI C99, however it is used here for efficency. In principle, +one could simply copy the input array in reverse order to the output array, +but this only works if the compiler performs the operation in strict order. Certain +compiler optimization techniques may vioate this assumption. Therefore, we first +copy a section of the input array to a temporary intermediate array, before copying +the longer datatype values back to the original array. +*/ + +{ + LONGLONG *longlongarray, *aliasarray; + long ii, ntodo, firstelem, nmax = 10000; + + if (*status > 0) + return(*status); + + ntodo = nmax; + if (length < nmax) ntodo = length; + + firstelem = length - ntodo; /* first element to be converted */ + + longlongarray = (LONGLONG *) malloc(ntodo * sizeof(LONGLONG)); + + if (longlongarray == NULL) + { + ffpmsg("Out of memory. (fits_int_to_longlong_inplace)"); + return (*status = MEMORY_ALLOCATION); + } + + aliasarray = (LONGLONG *) intarray; /* alias pointer to the input array */ + + while (ntodo > 0) { + + /* do datatype conversion into temp array */ + for (ii = 0; ii < ntodo; ii++) { + longlongarray[ii] = intarray[ii + firstelem]; + } + + /* copy temp array back to alias */ + memcpy(&(aliasarray[firstelem]), longlongarray, ntodo * 8); + + if (firstelem == 0) { /* we are all done */ + ntodo = 0; + } else { /* recalculate ntodo and firstelem for next loop */ + if (firstelem > nmax) { + firstelem -= nmax; + } else { + ntodo = firstelem; + firstelem = 0; + } + } + } + + free(longlongarray); + return(*status); +} +/*--------------------------------------------------------------------------*/ +static int fits_short_to_int_inplace(short *shortarray, long length, int shift, int *status) + +/* convert the input array of 16-bit integers into an array of 32-bit integers, +in place. This will overwrite the input array with the new longer array starting +at the same memory location. + +Note that aliasing the same memory location with pointers of different datatypes is +not allowed in strict ANSI C99, however it is used here for efficency. In principle, +one could simply copy the input array in reverse order to the output array, +but this only works if the compiler performs the operation in strict order. Certain +compiler optimization techniques may vioate this assumption. Therefore, we first +copy a section of the input array to a temporary intermediate array, before copying +the longer datatype values back to the original array. +*/ + +{ + int *intarray, *aliasarray; + long ii, ntodo, firstelem, nmax = 10000; + + if (*status > 0) + return(*status); + + ntodo = nmax; + if (length < nmax) ntodo = length; + + firstelem = length - ntodo; /* first element to be converted */ + + intarray = (int *) malloc(ntodo * sizeof(int)); + + if (intarray == NULL) + { + ffpmsg("Out of memory. (fits_short_to_int_inplace)"); + return (*status = MEMORY_ALLOCATION); + } + + aliasarray = (int *) shortarray; /* alias pointer to the input array */ + + while (ntodo > 0) { + + /* do datatype conversion into temp array */ + for (ii = 0; ii < ntodo; ii++) { + intarray[ii] = (int)(shortarray[ii + firstelem]) + shift; + } + + /* copy temp array back to alias */ + memcpy(&(aliasarray[firstelem]), intarray, ntodo * 4); + + if (firstelem == 0) { /* we are all done */ + ntodo = 0; + } else { /* recalculate ntodo and firstelem for next loop */ + if (firstelem > nmax) { + firstelem -= nmax; + } else { + ntodo = firstelem; + firstelem = 0; + } + } + } + + free(intarray); + return(*status); +} +/*--------------------------------------------------------------------------*/ +static int fits_ushort_to_int_inplace(unsigned short *ushortarray, long length, + int shift, int *status) + +/* convert the input array of 16-bit unsigned integers into an array of 32-bit integers, +in place. This will overwrite the input array with the new longer array starting +at the same memory location. + +Note that aliasing the same memory location with pointers of different datatypes is +not allowed in strict ANSI C99, however it is used here for efficency. In principle, +one could simply copy the input array in reverse order to the output array, +but this only works if the compiler performs the operation in strict order. Certain +compiler optimization techniques may vioate this assumption. Therefore, we first +copy a section of the input array to a temporary intermediate array, before copying +the longer datatype values back to the original array. +*/ + +{ + int *intarray, *aliasarray; + long ii, ntodo, firstelem, nmax = 10000; + + if (*status > 0) + return(*status); + + ntodo = nmax; + if (length < nmax) ntodo = length; + + firstelem = length - ntodo; /* first element to be converted */ + + intarray = (int *) malloc(ntodo * sizeof(int)); + + if (intarray == NULL) + { + ffpmsg("Out of memory. (fits_ushort_to_int_inplace)"); + return (*status = MEMORY_ALLOCATION); + } + + aliasarray = (int *) ushortarray; /* alias pointer to the input array */ + + while (ntodo > 0) { + + /* do datatype conversion into temp array */ + for (ii = 0; ii < ntodo; ii++) { + intarray[ii] = (int)(ushortarray[ii + firstelem]) + shift; + } + + /* copy temp array back to alias */ + memcpy(&(aliasarray[firstelem]), intarray, ntodo * 4); + + if (firstelem == 0) { /* we are all done */ + ntodo = 0; + } else { /* recalculate ntodo and firstelem for next loop */ + if (firstelem > nmax) { + firstelem -= nmax; + } else { + ntodo = firstelem; + firstelem = 0; + } + } + } + + free(intarray); + return(*status); +} +/*--------------------------------------------------------------------------*/ +static int fits_ubyte_to_int_inplace(unsigned char *ubytearray, long length, + int *status) + +/* convert the input array of 8-bit unsigned integers into an array of 32-bit integers, +in place. This will overwrite the input array with the new longer array starting +at the same memory location. + +Note that aliasing the same memory location with pointers of different datatypes is +not allowed in strict ANSI C99, however it is used here for efficency. In principle, +one could simply copy the input array in reverse order to the output array, +but this only works if the compiler performs the operation in strict order. Certain +compiler optimization techniques may vioate this assumption. Therefore, we first +copy a section of the input array to a temporary intermediate array, before copying +the longer datatype values back to the original array. +*/ + +{ + int *intarray, *aliasarray; + long ii, ntodo, firstelem, nmax = 10000; + + if (*status > 0) + return(*status); + + ntodo = nmax; + if (length < nmax) ntodo = length; + + firstelem = length - ntodo; /* first element to be converted */ + + intarray = (int *) malloc(ntodo * sizeof(int)); + + if (intarray == NULL) + { + ffpmsg("Out of memory. (fits_ubyte_to_int_inplace)"); + return (*status = MEMORY_ALLOCATION); + } + + aliasarray = (int *) ubytearray; /* alias pointer to the input array */ + + while (ntodo > 0) { + + /* do datatype conversion into temp array */ + for (ii = 0; ii < ntodo; ii++) { + intarray[ii] = ubytearray[ii + firstelem]; + } + + /* copy temp array back to alias */ + memcpy(&(aliasarray[firstelem]), intarray, ntodo * 4); + + if (firstelem == 0) { /* we are all done */ + ntodo = 0; + } else { /* recalculate ntodo and firstelem for next loop */ + if (firstelem > nmax) { + firstelem -= nmax; + } else { + ntodo = firstelem; + firstelem = 0; + } + } + } + + free(intarray); + return(*status); +} +/*--------------------------------------------------------------------------*/ +static int fits_sbyte_to_int_inplace(signed char *sbytearray, long length, + int *status) + +/* convert the input array of 8-bit signed integers into an array of 32-bit integers, +in place. This will overwrite the input array with the new longer array starting +at the same memory location. + +Note that aliasing the same memory location with pointers of different datatypes is +not allowed in strict ANSI C99, however it is used here for efficency. In principle, +one could simply copy the input array in reverse order to the output array, +but this only works if the compiler performs the operation in strict order. Certain +compiler optimization techniques may vioate this assumption. Therefore, we first +copy a section of the input array to a temporary intermediate array, before copying +the longer datatype values back to the original array. +*/ + +/* +!!!!!!!!!!!!!!!!! +NOTE THAT THIS IS A SPECIALIZED ROUTINE THAT ADDS AN OFFSET OF 128 TO THE ARRAY VALUES +!!!!!!!!!!!!!!!!! +*/ + +{ + int *intarray, *aliasarray; + long ii, ntodo, firstelem, nmax = 10000; + + if (*status > 0) + return(*status); + + ntodo = nmax; + if (length < nmax) ntodo = length; + + firstelem = length - ntodo; /* first element to be converted */ + + intarray = (int *) malloc(ntodo * sizeof(int)); + + if (intarray == NULL) + { + ffpmsg("Out of memory. (fits_sbyte_to_int_inplace)"); + return (*status = MEMORY_ALLOCATION); + } + + aliasarray = (int *) sbytearray; /* alias pointer to the input array */ + + while (ntodo > 0) { + + /* do datatype conversion into temp array */ + for (ii = 0; ii < ntodo; ii++) { + intarray[ii] = sbytearray[ii + firstelem] + 128; /* !! Note the offset !! */ + } + + /* copy temp array back to alias */ + memcpy(&(aliasarray[firstelem]), intarray, ntodo * 4); + + if (firstelem == 0) { /* we are all done */ + ntodo = 0; + } else { /* recalculate ntodo and firstelem for next loop */ + if (firstelem > nmax) { + firstelem -= nmax; + } else { + ntodo = firstelem; + firstelem = 0; + } + } + } + + free(intarray); + return(*status); +} + +int fits_calc_tile_rows(long *tlpixel, long *tfpixel, int ndim, long *trowsize, long *ntrows, int *status) +{ + + /* The quantizing algorithms treat all N-dimensional tiles as if they + were 2 dimensions (trowsize * ntrows). This sets trowsize to the + first dimensional size encountered that's > 1 (typically the X dimension). + ntrows will then be the product of the remaining dimensional sizes. + + Examples: Tile = (5,4,1,3): trowsize=5, ntrows=12 + Tile = (1,1,5): trowsize=5, ntrows=1 + */ + + int ii; + long np; + + if (*status) + return (*status); + + *trowsize = 0; + *ntrows = 1; + for (ii=0; ii 1) + { + if (!(*trowsize)) + *trowsize = np; + else + *ntrows *= np; + } + } + if (!(*trowsize)) + { + /* Should only get here for the unusual case of all tile dimensions + having size = 1 */ + *trowsize = 1; + } + + return (*status); +} diff --git a/vendor/cfitsio/install-sh b/vendor/cfitsio/install-sh new file mode 100755 index 000000000..ac159ceda --- /dev/null +++ b/vendor/cfitsio/install-sh @@ -0,0 +1,509 @@ +#!/bin/sh +# install - install a program, script, or datafile + +scriptversion=2017-09-23.17; # UTC + +# This originates from X11R5 (mit/util/scripts/install.sh), which was +# later released in X11R6 (xc/config/util/install.sh) with the +# following copyright and license. +# +# Copyright (C) 1994 X Consortium +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN +# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- +# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the name of the X Consortium shall not +# be used in advertising or otherwise to promote the sale, use or other deal- +# ings in this Software without prior written authorization from the X Consor- +# tium. +# +# +# FSF changes to this file are in the public domain. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# 'make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. + +tab=' ' +nl=' +' +IFS=" $tab$nl" + +# Set DOITPROG to "echo" to test this script. + +doit=${DOITPROG-} +doit_exec=${doit:-exec} + +# Put in absolute file names if you don't have them in your path; +# or use environment vars. + +chgrpprog=${CHGRPPROG-chgrp} +chmodprog=${CHMODPROG-chmod} +chownprog=${CHOWNPROG-chown} +cmpprog=${CMPPROG-cmp} +cpprog=${CPPROG-cp} +mkdirprog=${MKDIRPROG-mkdir} +mvprog=${MVPROG-mv} +rmprog=${RMPROG-rm} +stripprog=${STRIPPROG-strip} + +posix_mkdir= + +# Desired mode of installed file. +mode=0755 + +chgrpcmd= +chmodcmd=$chmodprog +chowncmd= +mvcmd=$mvprog +rmcmd="$rmprog -f" +stripcmd= + +src= +dst= +dir_arg= +dst_arg= + +copy_on_change=false +is_target_a_directory=possibly + +usage="\ +Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE + or: $0 [OPTION]... SRCFILES... DIRECTORY + or: $0 [OPTION]... -t DIRECTORY SRCFILES... + or: $0 [OPTION]... -d DIRECTORIES... + +In the 1st form, copy SRCFILE to DSTFILE. +In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. +In the 4th, create DIRECTORIES. + +Options: + --help display this help and exit. + --version display version info and exit. + + -c (ignored) + -C install only if different (preserve the last data modification time) + -d create directories instead of installing files. + -g GROUP $chgrpprog installed files to GROUP. + -m MODE $chmodprog installed files to MODE. + -o USER $chownprog installed files to USER. + -s $stripprog installed files. + -t DIRECTORY install into DIRECTORY. + -T report an error if DSTFILE is a directory. + +Environment variables override the default commands: + CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG + RMPROG STRIPPROG +" + +while test $# -ne 0; do + case $1 in + -c) ;; + + -C) copy_on_change=true;; + + -d) dir_arg=true;; + + -g) chgrpcmd="$chgrpprog $2" + shift;; + + --help) echo "$usage"; exit $?;; + + -m) mode=$2 + case $mode in + *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*) + echo "$0: invalid mode: $mode" >&2 + exit 1;; + esac + shift;; + + -o) chowncmd="$chownprog $2" + shift;; + + -s) stripcmd=$stripprog;; + + -t) + is_target_a_directory=always + dst_arg=$2 + # Protect names problematic for 'test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac + shift;; + + -T) is_target_a_directory=never;; + + --version) echo "$0 $scriptversion"; exit $?;; + + --) shift + break;; + + -*) echo "$0: invalid option: $1" >&2 + exit 1;; + + *) break;; + esac + shift +done + +# We allow the use of options -d and -T together, by making -d +# take the precedence; this is for compatibility with GNU install. + +if test -n "$dir_arg"; then + if test -n "$dst_arg"; then + echo "$0: target directory not allowed when installing a directory." >&2 + exit 1 + fi +fi + +if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then + # When -d is used, all remaining arguments are directories to create. + # When -t is used, the destination is already specified. + # Otherwise, the last argument is the destination. Remove it from $@. + for arg + do + if test -n "$dst_arg"; then + # $@ is not empty: it contains at least $arg. + set fnord "$@" "$dst_arg" + shift # fnord + fi + shift # arg + dst_arg=$arg + # Protect names problematic for 'test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac + done +fi + +if test $# -eq 0; then + if test -z "$dir_arg"; then + echo "$0: no input file specified." >&2 + exit 1 + fi + # It's OK to call 'install-sh -d' without argument. + # This can happen when creating conditional directories. + exit 0 +fi + +if test -z "$dir_arg"; then + if test $# -gt 1 || test "$is_target_a_directory" = always; then + if test ! -d "$dst_arg"; then + echo "$0: $dst_arg: Is not a directory." >&2 + exit 1 + fi + fi +fi + +if test -z "$dir_arg"; then + do_exit='(exit $ret); exit $ret' + trap "ret=129; $do_exit" 1 + trap "ret=130; $do_exit" 2 + trap "ret=141; $do_exit" 13 + trap "ret=143; $do_exit" 15 + + # Set umask so as not to create temps with too-generous modes. + # However, 'strip' requires both read and write access to temps. + case $mode in + # Optimize common cases. + *644) cp_umask=133;; + *755) cp_umask=22;; + + *[0-7]) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw='% 200' + fi + cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; + *) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw=,u+rw + fi + cp_umask=$mode$u_plus_rw;; + esac +fi + +for src +do + # Protect names problematic for 'test' and other utilities. + case $src in + -* | [=\(\)!]) src=./$src;; + esac + + if test -n "$dir_arg"; then + dst=$src + dstdir=$dst + test -d "$dstdir" + dstdir_status=$? + else + + # Waiting for this to be detected by the "$cpprog $src $dsttmp" command + # might cause directories to be created, which would be especially bad + # if $src (and thus $dsttmp) contains '*'. + if test ! -f "$src" && test ! -d "$src"; then + echo "$0: $src does not exist." >&2 + exit 1 + fi + + if test -z "$dst_arg"; then + echo "$0: no destination specified." >&2 + exit 1 + fi + dst=$dst_arg + + # If destination is a directory, append the input filename. + if test -d "$dst"; then + if test "$is_target_a_directory" = never; then + echo "$0: $dst_arg: Is a directory" >&2 + exit 1 + fi + dstdir=$dst + dstbase=`basename "$src"` + case $dst in + */) dst=$dst$dstbase;; + *) dst=$dst/$dstbase;; + esac + dstdir_status=0 + else + dstdir=`dirname "$dst"` + test -d "$dstdir" + dstdir_status=$? + fi + fi + + case $dstdir in + */) dstdirslash=$dstdir;; + *) dstdirslash=$dstdir/;; + esac + + obsolete_mkdir_used=false + + if test $dstdir_status != 0; then + case $posix_mkdir in + '') + # Create intermediate dirs using mode 755 as modified by the umask. + # This is like FreeBSD 'install' as of 1997-10-28. + umask=`umask` + case $stripcmd.$umask in + # Optimize common cases. + *[2367][2367]) mkdir_umask=$umask;; + .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; + + *[0-7]) + mkdir_umask=`expr $umask + 22 \ + - $umask % 100 % 40 + $umask % 20 \ + - $umask % 10 % 4 + $umask % 2 + `;; + *) mkdir_umask=$umask,go-w;; + esac + + # With -d, create the new directory with the user-specified mode. + # Otherwise, rely on $mkdir_umask. + if test -n "$dir_arg"; then + mkdir_mode=-m$mode + else + mkdir_mode= + fi + + posix_mkdir=false + case $umask in + *[123567][0-7][0-7]) + # POSIX mkdir -p sets u+wx bits regardless of umask, which + # is incompatible with FreeBSD 'install' when (umask & 300) != 0. + ;; + *) + tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ + trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 + + if (umask $mkdir_umask && + exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 + then + if test -z "$dir_arg" || { + # Check for POSIX incompatibilities with -m. + # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or + # other-writable bit of parent directory when it shouldn't. + # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. + ls_ld_tmpdir=`ls -ld "$tmpdir"` + case $ls_ld_tmpdir in + d????-?r-*) different_mode=700;; + d????-?--*) different_mode=755;; + *) false;; + esac && + $mkdirprog -m$different_mode -p -- "$tmpdir" && { + ls_ld_tmpdir_1=`ls -ld "$tmpdir"` + test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" + } + } + then posix_mkdir=: + fi + rmdir "$tmpdir/d" "$tmpdir" + else + # Remove any dirs left behind by ancient mkdir implementations. + rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null + fi + trap '' 0;; + esac;; + esac + + if + $posix_mkdir && ( + umask $mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" + ) + then : + else + + # The umask is ridiculous, or mkdir does not conform to POSIX, + # or it failed possibly due to a race condition. Create the + # directory the slow way, step by step, checking for races as we go. + + case $dstdir in + /*) prefix='/';; + [-=\(\)!]*) prefix='./';; + *) prefix='';; + esac + + oIFS=$IFS + IFS=/ + set -f + set fnord $dstdir + shift + set +f + IFS=$oIFS + + prefixes= + + for d + do + test X"$d" = X && continue + + prefix=$prefix$d + if test -d "$prefix"; then + prefixes= + else + if $posix_mkdir; then + (umask=$mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break + # Don't fail if two instances are running concurrently. + test -d "$prefix" || exit 1 + else + case $prefix in + *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; + *) qprefix=$prefix;; + esac + prefixes="$prefixes '$qprefix'" + fi + fi + prefix=$prefix/ + done + + if test -n "$prefixes"; then + # Don't fail if two instances are running concurrently. + (umask $mkdir_umask && + eval "\$doit_exec \$mkdirprog $prefixes") || + test -d "$dstdir" || exit 1 + obsolete_mkdir_used=true + fi + fi + fi + + if test -n "$dir_arg"; then + { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && + { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || + test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 + else + + # Make a couple of temp file names in the proper directory. + dsttmp=${dstdirslash}_inst.$$_ + rmtmp=${dstdirslash}_rm.$$_ + + # Trap to clean up those temp files at exit. + trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 + + # Copy the file name to the temp name. + (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && + + # and set any options; do chmod last to preserve setuid bits. + # + # If any of these fail, we abort the whole thing. If we want to + # ignore errors from any of these, just make sure not to ignore + # errors from the above "$doit $cpprog $src $dsttmp" command. + # + { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && + { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && + { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && + + # If -C, don't bother to copy if it wouldn't change the file. + if $copy_on_change && + old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && + new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && + set -f && + set X $old && old=:$2:$4:$5:$6 && + set X $new && new=:$2:$4:$5:$6 && + set +f && + test "$old" = "$new" && + $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 + then + rm -f "$dsttmp" + else + # Rename the file to the real destination. + $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || + + # The rename failed, perhaps because mv can't rename something else + # to itself, or perhaps because mv is so ancient that it does not + # support -f. + { + # Now remove or move aside any old file at destination location. + # We try this two ways since rm can't unlink itself on some + # systems and the destination file might be busy for other + # reasons. In this case, the final cleanup might fail but the new + # file should still install successfully. + { + test ! -f "$dst" || + $doit $rmcmd -f "$dst" 2>/dev/null || + { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && + { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } + } || + { echo "$0: cannot unlink or rename $dst" >&2 + (exit 1); exit 1 + } + } && + + # Now rename the file to the real destination. + $doit $mvcmd "$dsttmp" "$dst" + } + fi || exit 1 + + trap '' 0 + fi +done + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC0" +# time-stamp-end: "; # UTC" +# End: diff --git a/vendor/cfitsio/iraffits.c b/vendor/cfitsio/iraffits.c new file mode 100644 index 000000000..187ac65d9 --- /dev/null +++ b/vendor/cfitsio/iraffits.c @@ -0,0 +1,2101 @@ +/*------------------------------------------------------------------------*/ +/* */ +/* 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 "fitsio2.h" +#include /* define stderr, FD, and NULL */ +#include +#include /* stddef.h is apparently needed to define size_t */ +#include + +#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(const 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, const 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 (const 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); + +/* CFITS_API is defined below for use on Windows systems. */ +/* It is used to identify the public functions which should be exported. */ +/* This has no effect on non-windows platforms where "WIN32" is not defined */ + +/* this is only needed to export the "fits_delete_iraf_file" symbol, which */ +/* is called in fpackutil.c (and perhaps in other applications programs) */ + +#if defined (WIN32) + #if defined(cfitsio_EXPORTS) + #define CFITS_API __declspec(dllexport) + #else + #define CFITS_API //__declspec(dllimport) + #endif /* CFITS_API */ +#else /* defined (WIN32) */ + #define CFITS_API +#endif + +int CFITS_API fits_delete_iraf_file(const char *filename, int *status); + + +/*--------------------------------------------------------------------------*/ +int fits_delete_iraf_file(const 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 ( + const 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[FLEN_ERRMSG]; + 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) { + snprintf(errmsg, FLEN_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) { + snprintf(errmsg, FLEN_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[FLEN_ERRMSG]; + 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) { + snprintf(errmsg, FLEN_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) { + snprintf(errmsg, FLEN_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) { + snprintf(errmsg, FLEN_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[FLEN_ERRMSG]; + + /* 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) { + snprintf(errmsg, FLEN_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: + snprintf(errmsg,FLEN_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 ( + const 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 */ +const 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 = {/ } */ +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; + if (strlen(value) > 29) + return(0); + 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 = {/ } */ +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); + str[lstr-1]=0; + } + 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 = {/ } */ +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; + char *saveptr; + 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); + keyword[80]=0; + 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 = ffstrtok (v1,cwhite,&saveptr); + 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 = {/ } + 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 = {/ } + 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 + = {/ } + 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 */ + snprintf (value,30,"%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/vendor/cfitsio/longnam.h b/vendor/cfitsio/longnam.h new file mode 100644 index 000000000..b34888ab6 --- /dev/null +++ b/vendor/cfitsio/longnam.h @@ -0,0 +1,628 @@ +#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 compatible with the version + as included when compiling the application program +*/ +#define fits_open_file(A, B, C, D) ffopentest( CFITSIO_SONAME, A, B, C, D) + +#define fits_open_data ffdopn +#define fits_open_extlist ffeopn +#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_make_key ffmkky +#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_ulng ffpkyuj +#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_ulnglng ffgkyujj +#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_get_key_strlen ffgksl +#define fits_read_key_longstr ffgkls +#define fits_read_string_key ffgsky +#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_hdutab ffcpht +#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_ulnglng ffggpujj +#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_ulnglng ffgpvujj +#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_ulnglng ffgpfujj +#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_ulnglng ffg2dujj +#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_ulnglng ffg3dujj +#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_ulnglng ffgsvujj +#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_ulnglng ffgsfujj +#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_cols ffgcvn +#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_ulnglng ffgcvujj +#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_ulnglng ffgcfujj +#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_ulnglng ffpgpujj +#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_ulnglng ffpprujj +#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_ulnglng ffppnujj +#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_ulnglng ffp2dujj +#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_ulnglng ffp3dujj +#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_ulnglng ffpssujj +#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_cols ffpcln +#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_ulnglng ffpclujj +#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_ulnglng ffpcnujj +#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_cols ffccls +#define fits_copy_rows ffcprw +#define fits_copy_selrows ffcpsr +#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 + +#define fits_init_https ffihtps +#define fits_cleanup_https ffchtps +#define fits_verbose_https ffvhtps + +#define fits_show_download_progress ffshdwn +#define fits_get_timeout ffgtmo +#define fits_set_timeout ffstmo + +#endif diff --git a/vendor/cfitsio/modkey.c b/vendor/cfitsio/modkey.c new file mode 100644 index 000000000..0c84dad77 --- /dev/null +++ b/vendor/cfitsio/modkey.c @@ -0,0 +1,1842 @@ +/* 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 +/* stddef.h is apparently needed to define size_t */ +#include +#include +#include +#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 */ + const 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 */ + const 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 */ + const char *value, /* I - keyword value */ + const 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 */ + const char *value, /* I - keyword value */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const char *card, /* I - card string value */ + int *status) /* IO - error status */ +{ + char tcard[FLEN_CARD], valstring[FLEN_CARD], comm[FLEN_CARD], value[FLEN_CARD]; + char nextcomm[FLEN_COMMENT]; + 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); + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check for string value which may be continued over multiple keywords */ + ffpmrk(); /* put mark on message stack; erase any messages after this */ + ffc2s(valstring, value, status); /* remove quotes and trailing spaces */ + + if (*status == VALUE_UNDEFINED) { + ffcmrk(); /* clear any spurious error messages, back to the mark */ + *status = 0; + } else { + + len = strlen(value); + + while (len && value[len - 1] == '&') /* ampersand used as continuation char */ + { + ffgcnt(fptr, value, nextcomm, 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 */ + const 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 */ + const 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 FITS convention 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 */ + const 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 */ + const char *value, /* I - keyword value */ + const 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], nextcomm[FLEN_COMMENT]; + 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); + + if (*status > 0) + return(*status); + + /* check if old string value was continued over multiple keywords */ + ffpmrk(); /* put mark on message stack; erase any messages after this */ + ffc2s(oldval, valstring, status); /* remove quotes and trailing spaces */ + + if (*status == VALUE_UNDEFINED) { + ffcmrk(); /* clear any spurious error messages, back to the mark */ + *status = 0; + } else { + + len = strlen(valstring); + + while (len && valstring[len - 1] == '&') /* ampersand is continuation char */ + { + ffgcnt(fptr, valstring, nextcomm, 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 */ + const char *value, /* I - keyword value */ + const 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 + { + nchar = 80 - nquote - namelen - 5; + } + + contin = 0; + while (remain > 0) + { + if (nchar > FLEN_VALUE-1) + { + ffpmsg("longstr keyword value is too long (ffmkls)"); + return (*status=BAD_KEYCHAR); + } + 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + if (strlen(tmpstring)+3 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffmkfc)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2f(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring) + strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffmkfc)"); + return(*status=BAD_F2C); + } + 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 */ + const 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 */ + if (strlen(tmpstring)+3 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffmkyc)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2e(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring) + strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffmkyc)"); + return(*status=BAD_F2C); + } + 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 */ + const 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 */ + if (strlen(tmpstring)+3 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffmkfm)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2f(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring) + strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffmkfm)"); + return(*status=BAD_F2C); + } + 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 */ + const 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 */ + if (strlen(tmpstring)+3 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffmkym)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2e(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring) + strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffmkym)"); + return(*status=BAD_F2C); + } + 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 */ + const 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 */ + const char *value, /* I - keyword value */ + const 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 */ + const char *value, /* I - keyword value */ + const 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 + { + nchar = 80 - nquote - namelen - 5; + } + + contin = 0; + while (remain > 0) + { + if (nchar > FLEN_VALUE-1) + { + ffpmsg("longstr keyword value is too long (ffikls)"); + return (*status=BAD_KEYCHAR); + } + 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + const 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 */ + if (strlen(tmpstring)+3 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffikfc)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2f(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring) + strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffikfc)"); + return(*status=BAD_F2C); + } + 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 */ + const 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 */ + if (strlen(tmpstring)+3 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffikyc)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2e(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring) + strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffikyc)"); + return(*status=BAD_F2C); + } + 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 */ + const 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 */ + if (strlen(tmpstring)+3 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffikfm)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2f(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring) + strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffikfm)"); + return(*status=BAD_F2C); + } + 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 */ + const 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 */ + if (strlen(tmpstring)+3 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffikym)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2e(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring) + strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("complex key value too long (ffikym)"); + return(*status=BAD_F2C); + } + 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 */ + const 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 */ + const 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, keylength; + 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] = ' '; + + keylength = strcspn(buff2, "="); + if (keylength == 80) keylength = 8; + + /* test for the common commentary keywords which by definition have 8-char names */ + if ( !fits_strncasecmp( "COMMENT ", buff2, 8) || !fits_strncasecmp( "HISTORY ", buff2, 8) || + !fits_strncasecmp( " ", buff2, 8) || !fits_strncasecmp( "CONTINUE", buff2, 8) ) + keylength = 8; + + for (ii=0; ii < keylength; 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], nextcomm[FLEN_COMMENT]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgkey(fptr, keyname, valstring, comm, status) > 0) /* read keyword */ + { + snprintf(message, FLEN_ERRMSG,"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 */ + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check for string value which may be continued over multiple keywords */ + ffpmrk(); /* put mark on message stack; erase any messages after this */ + ffc2s(valstring, value, status); /* remove quotes and trailing spaces */ + + if (*status == VALUE_UNDEFINED) { + ffcmrk(); /* clear any spurious error messages, back to the mark */ + *status = 0; + } else { + + len = strlen(value); + + while (len && value[len - 1] == '&') /* ampersand used as continuation char */ + { + ffgcnt(fptr, value, nextcomm, 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], nextcomm[FLEN_COMMENT]; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + if (ffgstr(fptr, string, card, status) > 0) /* read keyword */ + { + snprintf(message, FLEN_ERRMSG,"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); + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + /* check for string value which may be continued over multiple keywords */ + ffpmrk(); /* put mark on message stack; erase any messages after this */ + ffc2s(valstring, value, status); /* remove quotes and trailing spaces */ + + if (*status == VALUE_UNDEFINED) { + ffcmrk(); /* clear any spurious error messages, back to the mark */ + *status = 0; + } else { + + len = strlen(value); + + while (len && value[len - 1] == '&') /* ampersand used as continuation char */ + { + ffgcnt(fptr, value, nextcomm, 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) + { + snprintf(message, FLEN_ERRMSG,"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/vendor/cfitsio/pliocomp.c b/vendor/cfitsio/pliocomp.c new file mode 100644 index 000000000..47a636918 --- /dev/null +++ b/vendor/cfitsio/pliocomp.c @@ -0,0 +1,331 @@ +/* stdlib is needed for the abs function */ +#include +/* + 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 = 0, 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/vendor/cfitsio/putcol.c b/vendor/cfitsio/putcol.c new file mode 100644 index 000000000..098b7dc04 --- /dev/null +++ b/vendor/cfitsio/putcol.c @@ -0,0 +1,2186 @@ +/* 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 +#include +#include +#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 == TULONGLONG) + { + ffpprujj(fptr, group, firstelem, nelem, (ULONGLONG *) 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 == TULONGLONG) + { + ffpprujj(fptr, group, firstelem, nelem, (ULONGLONG *) 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 == TULONGLONG) + { + ffppnujj(fptr, group, firstelem, nelem, (ULONGLONG *) array, + *(ULONGLONG *) 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 == TULONGLONG) + { + ffppnujj(fptr, group, firstelem, nelem, (ULONGLONG *) array, + *(ULONGLONG *) 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 == TULONGLONG) + { + ffpprujj(fptr, group, firstelem, nelem, (ULONGLONG *) 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 == TULONGLONG) + { + ffppnujj(fptr, group, firstelem, nelem, (ULONGLONG *) array, + *(ULONGLONG *) 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 == TULONGLONG) + { + ffpssujj(fptr, 1, naxis, naxes, blc, trc, + (ULONGLONG *) 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 == TULONGLONG) + { + ffpclujj(fptr, colnum, firstrow, firstelem, nelem, (ULONGLONG *) 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 == TULONGLONG) + { + ffpcnujj(fptr, colnum, firstrow, firstelem, nelem, (ULONGLONG *) array, + *(ULONGLONG *) 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 ffpcln( fitsfile *fptr, /* I - FITS file pointer */ + int ncols, /* I - number of columns to write */ + int *datatype, /* I - datatypes of the values */ + int *colnum, /* I - columns numbers to write (1 = 1st col) */ + LONGLONG firstrow, /* I - first row to write (1 = 1st row) */ + LONGLONG nrows, /* I - number of rows to write */ + void **array, /* I - array of pointers to values to write */ + void **nulval, /* I - array of pointers to values for undefined pixels */ + int *status) /* IO - error status */ +/* + Write arrays of values to NCOLS table columns. This is an optimization + to write all columns in one pass through the table. The datatypes of the + input arrays are defined by the 3rd 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). + Undefined elements for column i that are equal to *(nulval[i]) are set to + the defined null value, unless nulval[i]=0, + in which case no checking for undefined values will be performed. +*/ +{ + LONGLONG ntotrows, ndone, nwrite, currow; + long nrowbuf; + LONGLONG *repeats = 0; + size_t sizes[255] = {0}; + int icol; + + sizes[TBYTE] = sizes[TSBYTE] = sizes[TLOGICAL] = sizeof(char); + sizes[TUSHORT] = sizes[TSHORT] = sizeof(short int); + sizes[TINT] = sizes[TUINT] = sizeof(int); + sizes[TLONG] = sizes[TULONG] = sizeof(long int); + sizes[TLONGLONG] = sizes[TULONGLONG] = sizeof(LONGLONG); + sizes[TFLOAT] = sizeof(float); + sizes[TDOUBLE] = sizeof(double); + sizes[TDBLCOMPLEX] = 2*sizeof(double); + + if (*status > 0) + return(*status); + + if (ncols <= 0) return (*status=0); + + repeats = malloc(sizeof(LONGLONG)*ncols); + if (repeats == 0) return (*status=MEMORY_ALLOCATION); + + fits_get_num_rowsll(fptr, &ntotrows, status); + fits_get_rowsize(fptr, &nrowbuf, status); + + /* Retrieve column repeats */ + for (icol = 0; (icol < ncols) && (icol < 1000); icol++) { + int typecode; + LONGLONG repeat, width; + fits_get_coltypell(fptr, colnum[icol], &typecode, + &repeat, &width, status); + repeats[icol] = repeat; + + if (datatype[icol] == TBIT || datatype[icol] == TSTRING || + sizes[datatype[icol]] == 0) { + ffpmsg("Cannot write to TBIT or TSTRING datatypes (ffpcln)"); + *status = BAD_DATATYPE; + } + if (typecode < 0) { + ffpmsg("Cannot write to variable-length data (ffpcln)"); + *status = BAD_DIMEN; + } + + if (*status) break; + } + if (*status) { + free(repeats); + return *status; + } + + /* Optimize for 1 column */ + if (ncols == 1) { + fits_write_colnull(fptr, datatype[0], colnum[0], firstrow, 1, + nrows*repeats[0], + array[0], nulval[0], status); + free(repeats); + return *status; + } + + /* Scan through file, in chunks of nrowbuf */ + currow = firstrow; + ndone = 0; + while (ndone < nrows) { + int icol; + nwrite = (nrows-ndone); + if (nwrite > nrowbuf) nwrite = nrowbuf; + + for (icol=0; icolfptr = fptr; + strncpy(col->colname, colname,69); + col->colname[69]=0; + 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 +*/ +{ + strncpy(col->colname, colname,69); + col->colname[69]=0; + 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=0, 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/TemporaryCol + columns. Variable length arrays have a negative type code + value. */ + + if ( !((cols[jj].iotype == OutputCol) || (cols[jj].iotype == TemporaryCol)) + && (type<0)) { + type*=-1; + } + + /* TemporaryCol must have defined datatype and repeat */ + if (cols[jj].iotype == TemporaryCol && + (type <= 0 || cols[jj].repeat <= 0)) { + + snprintf(message,FLEN_ERRMSG, + "TemporaryCol column must have defined datatype and repeat for column %d (ffiter)", + jj + 1); + ffpmsg(message); + return(*status = BAD_DATATYPE); + } + + /* Check for variable length or illegal data types */ + 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) { + snprintf(message,FLEN_ERRMSG, + "Variable length array not allowed for output column number %d (ffiter)", + jj + 1); + } else { + snprintf(message,FLEN_ERRMSG, + "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'; + + /* Determine HDU type of this table (or BINARY_TBL for TemporaryCol) */ + if (cols[jj].iotype != TemporaryCol) { + ffghdt(cols[jj].fptr, &jtype, status); /* get HDU type */ + } else { + hdutype = BINARY_TBL; + } + + if (hdutype == IMAGE_HDU) /* operating on FITS images */ + { + if (jtype != IMAGE_HDU) + { + snprintf(message,FLEN_ERRMSG, + "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); + + if (cols[jj].iotype == TemporaryCol) { + snprintf(message,FLEN_ERRMSG, + "Column type TemporaryCol not permitted for IMAGE HDUs (ffiter)"); + return(*status = BAD_DATATYPE); + } + + } + else /* operating on FITS tables */ + { + if (jtype == IMAGE_HDU) + { + snprintf(message,FLEN_ERRMSG, + "File %d not positioned to a table extension (ffiter)", + jj + 1); + return(*status = NOT_TABLE); + } + + if (cols[jj].iotype != TemporaryCol) + { + 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) ) + { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "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 */ + + felement = 0; + 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 */ + { + /* Note the maxvalue here is a special case to deal with + how the calculator treats expressions that have NO + referenced columns, just constants and other derivable + values like #ROW. In that case, the calculator creates + a cols[0].fptr even though there is no column for it, + and the iterator is not meant to allocate any space, + etc for the column. So the maxvalue() here assures + that cols[0] is always checked, even if ncols==0, which + is how the original logic worked. This is a bit + dangerous in the sense that, what happens if the user + passes a non-calculator input to this iterator, and + has NOT set fptr to a legitimate FITS handle. Boom! */ + for (jj=0; jj < maxvalue(n_cols,1); jj++) { + if (cols[jj].iotype != TemporaryCol && cols[jj].fptr) { + ffgkyj(cols[jj].fptr, "NAXIS2", &totaln, 0, status); + frow = 1 + offset; + felement = 1; + break; + } + } + if (felement != 1) { + snprintf(message,FLEN_ERRMSG, + "There must be at least one input or output column in iterator (ffiter)"); + ffpmsg(message); + return(*status = BAD_COL_NUM); + } + } + + /* 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; + n_optimum = 0; + if (cols[0].iotype != TemporaryCol) ffgrsz(cols[0].fptr, &n_optimum, status); + + for (jj = 1; jj < n_cols; jj++) + { + if (cols[jj].iotype == TemporaryCol) continue; + 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); + if (n_optimum == 0) { /* If first column is TemporaryCol */ + n_optimum = i_optimum; + } else { + 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 (cols[jj].iotype != TemporaryCol) + { + 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) { + snprintf(message,FLEN_ERRMSG, + "Variable length array not allowed for output column number %d (ffiter)", + jj + 1); + ffpmsg(message); + return(*status = BAD_DATATYPE); + } + } + } + else + { + /* TemporaryCol - datatype etc must be defined */ + typecode = cols[jj].datatype; + if (typecode <= 0 || typecode == TBIT || typecode == TSTRING) { + snprintf(message,FLEN_ERRMSG, + "Invalid typecode for temporary output column number %d (ffiter)", + jj+1); + ffpmsg(message); + return(*status = BAD_DATATYPE); + } + + rept = cols[jj].repeat; + if (rept <= 0) { + snprintf(message,FLEN_ERRMSG, + "Invalid repeat (%ld) for temporary output column number %d (ffiter)", + rept, jj+1); + ffpmsg(message); + return(*status = BAD_DIMEN); + } + + } + + /* 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; + /* handle special case of a 0-width string column */ + if (hdutype == BINARY_TBL && rept == 0) + cols[jj].repeat = 0; + + /* get the BLANK keyword value, if it exists */ + if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + tnull = minvalue(tnull, INT32_MAX); + tnull = maxvalue(tnull, 0); + col[jj].null.uintnull = (unsigned int) tnull; + } + else + { + col[jj].null.uintnull = 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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 + || abs(typecode) == TINT || abs(typecode) == TLONGLONG) + { + 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) ); + if (rept > 0) + 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 || abs(typecode) == TINT) + { + col[jj].null.longlongnull = tnull; + } + else + { + col[jj].null.longlongnull = LONGLONG_MIN; /* use minimum as null */ + } + break; + + default: + snprintf(message,FLEN_ERRMSG, + "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 && cols[jj].iotype != TemporaryCol) + { + 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 && cols[jj].iotype != TemporaryCol) + { + 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/vendor/cfitsio/putcolb.c b/vendor/cfitsio/putcolb.c new file mode 100644 index 000000000..363a875ab --- /dev/null +++ b/vendor/cfitsio/putcolb.c @@ -0,0 +1,1040 @@ +/* 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 +#include +#include +#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 writemode; + int tcode, maxelem2, hdutype, writeraw; + long twidth, incre; + long ntodo; + LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull, maxelem; + 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: */ + /*---------------------------------------------------*/ + + /* IMPORTANT NOTE: that the special case of using this subroutine + to write bytes to a character column are handled internally + by the call to ffgcprll() below. It will adjust the effective + *tcode, repeats, etc, to appear as a TBYTE column. */ + + writemode = 17; /* Equivalent to writemode = 1 but allow TSTRING -> TBYTE */ + + if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, writemode, &scale, &zero, + tform, &twidth, &tcode, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + maxelem = maxelem2; + + 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; + if (nelem < (LONGLONG)INT32_MAX) { + maxelem = nelem; + } else { + maxelem = INT32_MAX; + } + } + 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 */ + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + /* no need to check range limits because all unsigned char values */ + /* are valid ULONGLONG values. */ + + for (ii = 0; ii < ntodo; ii++) { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + else 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/vendor/cfitsio/putcold.c b/vendor/cfitsio/putcold.c new file mode 100644 index 000000000..10f670d4d --- /dev/null +++ b/vendor/cfitsio/putcold.c @@ -0,0 +1,1084 @@ +/* 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 +#include +#include +#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, maxelem2, hdutype, writeraw; + long twidth, incre; + long ntodo; + LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull, maxelem; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + maxelem = maxelem2; + + 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; + if (nelem < (LONGLONG)INT32_MAX) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/8; + } + } + 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 */ + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. Input values must not be negative */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + if (input[ii] < -0.49) { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (input[ii] > 2.* DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } else { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + } + else 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/vendor/cfitsio/putcole.c b/vendor/cfitsio/putcole.c new file mode 100644 index 000000000..501cab834 --- /dev/null +++ b/vendor/cfitsio/putcole.c @@ -0,0 +1,1098 @@ +/* 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 +#include +#include +#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, maxelem2, hdutype, writeraw; + long twidth, incre; + long ntodo; + LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull, maxelem; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + maxelem = maxelem2; + + 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; + if (nelem < (LONGLONG)INT32_MAX) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/4; + } + } + 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 */ + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. Input values must not be negative */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + if (input[ii] < -0.49) { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } + else if (input[ii] > 2.* DLONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } else { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + } + else 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 > 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 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/vendor/cfitsio/putcoli.c b/vendor/cfitsio/putcoli.c new file mode 100644 index 000000000..d080ec9d3 --- /dev/null +++ b/vendor/cfitsio/putcoli.c @@ -0,0 +1,1003 @@ +/* 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 +#include +#include +#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, maxelem2, hdutype, writeraw; + long twidth, incre; + long ntodo; + LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull, maxelem; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + maxelem = maxelem2; + + 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; + if (nelem < (LONGLONG)INT32_MAX) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/2; + } + } + 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 */ + snprintf(message,FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. Input values must not be negative */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + if (input[ii] < 0) { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } else { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + } + else 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; + + 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/vendor/cfitsio/putcolj.c b/vendor/cfitsio/putcolj.c new file mode 100644 index 000000000..98ba41e30 --- /dev/null +++ b/vendor/cfitsio/putcolj.c @@ -0,0 +1,2029 @@ +/* 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 +#include +#include +#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, maxelem2, hdutype, writeraw; + long twidth, incre; + long ntodo; + LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull, maxelem; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + maxelem = maxelem2; + + 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; + if (nelem < (LONGLONG)INT32_MAX) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/8; + } + } + 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): + + ffi4fi8(&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 */ + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 ffi4fi8(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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. Input values must not be negative */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + if (input[ii] < 0) { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } else { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + } + else 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 TLONGLONG 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 TLONGLONG 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 TLONGLONG 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 TLONGLONG 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, maxelem2, hdutype, writeraw; + long twidth, incre; + long ntodo; + LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull, maxelem; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + maxelem = maxelem2; + + 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; + if (nelem < (LONGLONG)INT32_MAX/8) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/8; + } + } + 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 */ + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. Input values must not be negative */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + if (input[ii] < 0) { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } else { + output[ii] = (input[ii]) ^ 0x8000000000000000; + } + } + } + else 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/vendor/cfitsio/putcolk.c b/vendor/cfitsio/putcolk.c new file mode 100644 index 000000000..a8648a00e --- /dev/null +++ b/vendor/cfitsio/putcolk.c @@ -0,0 +1,1033 @@ +/* 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 +#include +#include +#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, maxelem2, hdutype, writeraw; + long twidth, incre; + long ntodo; + LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull, maxelem; + 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, &maxelem2, &startpos, &elemnum, &incre, + &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0) + return(*status); + maxelem = maxelem2; + + 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; + if (nelem < (LONGLONG)INT32_MAX) { + maxelem = nelem; + } else { + maxelem = INT32_MAX/4; + } + } + 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 */ + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. Input values must not be negative */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + if (input[ii] < 0) { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } else { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + } + else 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/vendor/cfitsio/putcoll.c b/vendor/cfitsio/putcoll.c new file mode 100644 index 000000000..1339ce5af --- /dev/null +++ b/vendor/cfitsio/putcoll.c @@ -0,0 +1,372 @@ +/* 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 +#include +#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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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}; + LONGLONG heapoffset, lrepeat; + 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). */ + /* Make sure to not change the current heap offset value! */ + + if (tcode == -TBIT) { + ffgdesll(fptr, colnum, frow, &lrepeat, &heapoffset, status); + ffpdes( fptr, colnum, frow, (long) repeat, heapoffset, 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/vendor/cfitsio/putcols.c b/vendor/cfitsio/putcols.c new file mode 100644 index 000000000..a1ab6d3da --- /dev/null +++ b/vendor/cfitsio/putcols.c @@ -0,0 +1,304 @@ +/* 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 +#include +#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) + { + snprintf(message, FLEN_ERRMSG,"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 */ + { + snprintf(message,FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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/vendor/cfitsio/putcolsb.c b/vendor/cfitsio/putcolsb.c new file mode 100644 index 000000000..c01f737a5 --- /dev/null +++ b/vendor/cfitsio/putcolsb.c @@ -0,0 +1,989 @@ +/* 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 +#include +#include +#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 */ + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. Input values must not be negative */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + for (ii = 0; ii < ntodo; ii++) { + if (input[ii] < 0) { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MIN; + } else { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + } + else 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/vendor/cfitsio/putcolu.c b/vendor/cfitsio/putcolu.c new file mode 100644 index 000000000..7620ca8a6 --- /dev/null +++ b/vendor/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 +#include +#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; + LONGLONG 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 + ffswap8((double *)(&i8null), 1); /* 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 */ + snprintf(message,FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 + ffswap8((double *)(&i8null), 1); /* 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 */ + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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/vendor/cfitsio/putcolui.c b/vendor/cfitsio/putcolui.c new file mode 100644 index 000000000..b8df01d43 --- /dev/null +++ b/vendor/cfitsio/putcolui.c @@ -0,0 +1,982 @@ +/* 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 +#include +#include +#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 */ + snprintf(message,FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + /* no need to check range limits because all unsigned short values */ + /* are valid ULONGLONG values. */ + + for (ii = 0; ii < ntodo; ii++) { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + else 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/vendor/cfitsio/putcoluj.c b/vendor/cfitsio/putcoluj.c new file mode 100644 index 000000000..29c72588d --- /dev/null +++ b/vendor/cfitsio/putcoluj.c @@ -0,0 +1,1966 @@ +/* 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 +#include +#include +#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 */ + snprintf(message,FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + /* no need to check range limits because all unsigned long values */ + /* are valid ULONGLONG values. */ + + for (ii = 0; ii < ntodo; ii++) { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + else 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); +} + +/* ======================================================================== */ +/* the following routines support the 'unsigned long long' data type */ +/* ======================================================================== */ + +/*--------------------------------------------------------------------------*/ +int ffpprujj( 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 */ + ULONGLONG *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 */ + + ffpmsg("writing TULONGLONG to compressed image is not supported"); + + return(*status = DATA_COMPRESSION_ERR); + } + + row=maxvalue(1,group); + + ffpclujj(fptr, 2, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffppnujj( 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 */ + ULONGLONG *array, /* I - array of values that are written */ + ULONGLONG 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 TULONGLONG to compressed image is not supported"); + + return(*status = DATA_COMPRESSION_ERR); + } + + row=maxvalue(1,group); + + ffpcnujj(fptr, 2, row, firstelem, nelem, array, nulval, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp2dujj(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 */ + ULONGLONG *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 */ + + ffp3dujj(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffp3dujj(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 */ + ULONGLONG *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 */ + + ffpmsg("writing TULONGLONG 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 */ + ffpclujj(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 (ffpclujj(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0) + return(*status); + + nfits += naxis1; + narray += ncols; + } + narray += (nrows - naxis2) * ncols; + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpssujj(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 */ + ULONGLONG *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 TULONGLONG 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 (ffpclujj(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 ffpgpujj( 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 */ + ULONGLONG *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); + + ffpclujj(fptr, 1L, row, firstelem, nelem, array, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffpclujj( 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 */ + ULONGLONG *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 (TLONGLONG): + + ffu8fi8(&array[next], ntodo, scale, zero, + (LONGLONG *) buffer, status); + ffpi8b(fptr, ntodo, incre, (long *) buffer, status); + break; + + case (TLONG): + + ffu8fi4(&array[next], ntodo, scale, zero, + (INT32BIT *) buffer, status); + ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status); + break; + + case (TBYTE): + + ffu8fi1(&array[next], ntodo, scale, zero, + (unsigned char *) buffer, status); + ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status); + break; + + case (TSHORT): + + ffu8fi2(&array[next], ntodo, scale, zero, + (short *) buffer, status); + ffpi2b(fptr, ntodo, incre, (short *) buffer, status); + break; + + case (TFLOAT): + + ffu8fr4(&array[next], ntodo, scale, zero, + (float *) buffer, status); + ffpr4b(fptr, ntodo, incre, (float *) buffer, status); + break; + + case (TDOUBLE): + ffu8fr8(&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 */ + { + ffu8fstr(&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 */ + snprintf(message, FLEN_ERRMSG, + "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 */ + { + snprintf(message, FLEN_ERRMSG, + "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 ffpcnujj( 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 */ + ULONGLONG *array, /* I - array of values to write */ + ULONGLONG 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; + LONGLONG 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 (ffpclujj(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 (ffpclujj(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 */ + ffpclujj(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 ffu8fi1(ULONGLONG *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 ffu8fi2(ULONGLONG *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 ffu8fi4(ULONGLONG *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_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 ffu8fi8(ULONGLONG *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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + /* no need to check range limits because all input values */ + /* are valid ULONGLONG values. */ + + for (ii = 0; ii < ntodo; ii++) { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + else if (scale == 1. && zero == 0.) + { + for (ii = 0; ii < ntodo; ii++) { + if (input[ii] > LONGLONG_MAX) + { + *status = OVERFLOW_ERR; + output[ii] = LONGLONG_MAX; + } + else + { + 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 ffu8fr4(ULONGLONG *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 ffu8fr8(ULONGLONG *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 ffu8fstr(ULONGLONG *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/vendor/cfitsio/putcoluk.c b/vendor/cfitsio/putcoluk.c new file mode 100644 index 000000000..6c2a6d233 --- /dev/null +++ b/vendor/cfitsio/putcoluk.c @@ -0,0 +1,1007 @@ +/* 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 +#include +#include +#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 */ + snprintf(message,FLEN_ERRMSG, + "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 */ + { + snprintf(message,FLEN_ERRMSG, + "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; + LONGLONG 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 == 9223372036854775808.) + { + /* Writing to unsigned long long column. */ + /* Instead of subtracting 9223372036854775808, it is more efficient */ + /* and more precise to just flip the sign bit with the XOR operator */ + + /* no need to check range limits because all unsigned int values */ + /* are valid ULONGLONG values. */ + + for (ii = 0; ii < ntodo; ii++) { + output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000; + } + } + else 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/vendor/cfitsio/putkey.c b/vendor/cfitsio/putkey.c new file mode 100644 index 000000000..b51eb0fba --- /dev/null +++ b/vendor/cfitsio/putkey.c @@ -0,0 +1,3335 @@ +/* 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 +#include +#include +#include +/* stddef.h is apparently needed to define size_t */ +#include +#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[FLEN_ERRMSG]; + + 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) + { + ffpkyuj(fptr, keyname, (ULONGLONG) *(unsigned long *) value, + comm, status); + } + else if (datatype == TULONGLONG) + { + ffpkyuj(fptr, keyname, (ULONGLONG) *(ULONGLONG *) value, + 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 + { + snprintf(errmsg, FLEN_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; + int keylength; + + 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] = ' '; + + keylength = strcspn(tcard, "="); /* support for free-format keywords */ + if (keylength == 80) keylength = 8; + + /* test for the common commentary keywords which by definition have 8-char names */ + if ( !fits_strncasecmp( "COMMENT ", tcard, 8) || !fits_strncasecmp( "HISTORY ", tcard, 8) || + !fits_strncasecmp( " ", tcard, 8) || !fits_strncasecmp( "CONTINUE", tcard, 8) ) + keylength = 8; + + for (ii=0; ii < keylength; 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 */ + 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. + 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; + int commlen=0, nocomment = 0; + + if (*status > 0) /* inherit input status value if > 0 */ + return(*status); + + remain = maxvalue(strlen(value), 1); /* no. of chars to write (at least 1) */ + if (comm) { + commlen = strlen(comm); + if (commlen > 47) commlen = 47; /* only guarantee preserving the first 47 characters */ + } + + /* 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 + { + nchar = 80 - nquote - namelen - 5; + } + + 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 */ + /* expand quotes, and put quotes around the string */ + if (contin) + ffs2c_nopad(tstring,valstring,status); + else + ffs2c(tstring, valstring, status); + + 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 */ + { + if (nocomment) { + ffmkky("CONTINUE", valstring, NULL, card, status); /* make keyword w/o comment */ + } else { + 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; + nocomment = 0; + + 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 */ + } + + /* make adjustment if necessary to allow reasonable room for a comment on last CONTINUE card + only need to do this if + a) there is a comment string, and + b) the remaining value string characters could all fit on the next CONTINUE card, and + c) there is not enough room on the next CONTINUE card for both the remaining value + characters, and at least 47 characters of the comment string. + */ + + if (commlen > 0 && remain + nquote < 69 && remain + nquote + commlen > 65) + { + if (nchar > 18) { /* only false if there are a rediculous number of quotes in the string */ + nchar = remain - 15; /* force continuation onto another card, so that */ + /* there is room for a comment up to 47 chara long */ + nocomment = 1; /* don't write the comment string 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 ffpkyuj( fitsfile *fptr, /* I - FITS file pointer */ + const char *keyname,/* I - name of keyword to write */ + ULONGLONG 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); + + ffu2c(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 */ + if (strlen(valstring)+strlen(tmpstring)+2 > FLEN_VALUE-1) + { + ffpmsg("Error converting complex to string (ffpkyc)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2e(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring)+strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("Error converting complex to string (ffpkyc)"); + return(*status=BAD_F2C); + } + 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 */ + if (strlen(valstring)+strlen(tmpstring)+2 > FLEN_VALUE-1) + { + ffpmsg("Error converting complex to string (ffpkym)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2e(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring)+strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("Error converting complex to string (ffpkym)"); + return(*status=BAD_F2C); + } + 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 */ + if (strlen(valstring)+strlen(tmpstring)+2 > FLEN_VALUE-1) + { + ffpmsg("Error converting complex to string (ffpkfc)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffr2f(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring)+strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("Error converting complex to string (ffpkfc)"); + return(*status=BAD_F2C); + } + 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 */ + if (strlen(valstring)+strlen(tmpstring)+2 > FLEN_VALUE-1) + { + ffpmsg("Error converting complex to string (ffpkfm)"); + return(*status=BAD_F2C); + } + strcat(valstring, tmpstring); + strcat(valstring, ", "); + ffd2f(value[1], decim, tmpstring, status); /* convert to string */ + if (strlen(valstring)+strlen(tmpstring)+1 > FLEN_VALUE-1) + { + ffpmsg("Error converting complex to string (ffpkfm)"); + return(*status=BAD_F2C); + } + 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 */ + if (strlen(valstring)+strlen(cptr) > FLEN_VALUE-1) + { + ffpmsg("converted numerical string too long"); + return(*status=BAD_F2C); + } + 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[FLEN_ERRMSG]; + + + if (year < 0 || year > 9999) + { + snprintf(errmsg, FLEN_ERRMSG, + "input year value = %d is out of range 0 - 9999", year); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (month < 1 || month > 12) + { + snprintf(errmsg, FLEN_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) + { + snprintf(errmsg, FLEN_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) + { + snprintf(errmsg, FLEN_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); + + snprintf(errmsg, FLEN_ERRMSG, + "input day value = %d is out of range 1 - 28 for February %d (not leap year)", day, year); + ffpmsg(errmsg); + } else { + snprintf(errmsg, FLEN_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[FLEN_ERRMSG]; + + 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) + { + snprintf(errmsg, FLEN_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) + { + snprintf(errmsg, FLEN_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) + { + snprintf(errmsg, FLEN_ERRMSG, + "input second value is out of range 0 - 60.999: %f (fftm2s)", second); + ffpmsg(errmsg); + return(*status = BAD_DATE); + } + else if (decimals > 25) + { + snprintf(errmsg, FLEN_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[FLEN_ERRMSG]; + + 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') + { + if (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 + { + 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) + { + snprintf(errmsg,FLEN_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) + { + snprintf(errmsg, FLEN_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.) + { + snprintf(errmsg, FLEN_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 (len > 0 && 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 (len > 0 && 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 (len > 0 && 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 (len > 0 && 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 (len > 0 && 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 (len > 0 && 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 (len > 0 && 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 (len > 0 && 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[FLEN_ERRMSG]; + 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); + } + + snprintf(value, 80,"%ld", naxes[ii]); + /* This will either be followed by a ',' or ')'. */ + if (strlen(tdimstr)+strlen(value)+1 > FLEN_VALUE-1) + { + ffpmsg("TDIM string too long (ffptdm)"); + return(*status = BAD_TDIM); + } + 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) + { + snprintf(message,FLEN_ERRMSG, + "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 ) */ + + snprintf(value, 80, "%.0f", (double) naxes[ii]); + + if (strlen(tdimstr)+strlen(value)+1 > FLEN_VALUE-1) + { + ffpmsg("TDIM string too long (ffptdmll)"); + return(*status = BAD_TDIM); + } + 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) + { + snprintf(message,FLEN_ERRMSG, + "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]; + char card[FLEN_CARD]; + + 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 == ULONGLONG_IMG) + longbitpix = LONGLONG_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) + { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "Illegal negative value for NAXIS%d keyword: %.0f", ii + 1, (double) (naxes[ii])); + ffpmsg(message); + return(*status = BAD_NAXES); + } + + snprintf(&comm[20], FLEN_COMMENT-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 == ULONGLONG_IMG) + { + strcpy(card,"BZERO = 9223372036854775808 / offset data range to that of unsigned long long"); + ffprec(fptr, card, 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 */ + { + snprintf(comm, FLEN_COMMENT,"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; + + snprintf(comm, FLEN_COMMENT,"beginning column of field %3d", ii + 1); + ffkeyn("TBCOL", ii + 1, name, status); + ffpkyj(fptr, name, tbcol[ii], comm, status); + + if (strlen(tform[ii]) > 29) + { + ffpmsg("Error: ASCII table TFORM code is too long (ffphtb)"); + *status = BAD_TFORM; + break; + } + 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[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, card[FLEN_CARD]; + tcolumn *colptr; + + 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'|| + 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 */ + { + snprintf(comm, FLEN_COMMENT,"label for field %3d", ii + 1); + ffkeyn("TTYPE", ii + 1, name, status); + ffpkys(fptr, name, ttype[ii], comm, status); + } + + if (strlen(tform[ii]) > 29) + { + ffpmsg("Error: BIN table TFORM code is too long (ffphbn)"); + *status = BAD_TFORM; + break; + } + 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 == TULONGLONG) + strcat(comm, ": 8-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 if (abs(datatype) == TULONGLONG) + { + /* Replace the 'W' with an 'K' in the TFORMn code */ + cptr = tfmt; + while (*cptr != 'W') + cptr++; + + *cptr = 'K'; + ffpkys(fptr, name, tfmt, comm, status); + + /* write the TZEROn and TSCALn keywords */ + ffkeyn("TZERO", ii + 1, card, status); + strcat(card, " "); /* make sure name is >= 8 chars long */ + *(card+8) = '\0'; + strcat(card, "= 9223372036854775808 / offset for unsigned integers"); + fits_write_record(fptr, card, 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[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) + { + snprintf(message,FLEN_ERRMSG, + "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) + { + snprintf(message,FLEN_ERRMSG, + "Illegal negative value for NAXIS%d keyword: %.0f", ii + 1, (double) (naxes[ii])); + ffpmsg(message); + return(*status = BAD_NAXES); + } + + snprintf(&comm[20], 61, "%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 ffu2c(ULONGLONG 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, "%I64u", ival) < 0) + +#elif (USE_LL_SUFFIX == 1) + if (sprintf(cval, "%llu", ival) < 0) +#else + if (sprintf(cval, "%lu", ival) < 0) +#endif + { + ffpmsg("Error in ffu2c 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(const 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. + (*** This 8 char requirement is now obsolete. See ffs2c_nopad + for an alternative ***) + 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 ffs2c_nopad(const char *instr, /* I - null terminated input string */ + char *outstr, /* O - null terminated quoted output string */ + int *status) /* IO - error status */ +/* + This performs identically to ffs2c except that it won't pad output + strings to make them a minimum of 8 chars long. The requirement + that FITS keyword string values be 8 characters is now obsolete + (except for "XTENSION" keyword), but for backwards compatibility we'll + keep ffs2c the way it is. A better solution would be to add another + argument to ffs2c for 'pad' or 'nopad', but it is called from many other + places in Heasoft outside of CFITSIO. +*/ +{ + 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 */ + } + } + + 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 (snprintf(cval, FLEN_VALUE,"%.*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 ( snprintf(cval, FLEN_VALUE,"%.*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 ( snprintf(cval, FLEN_VALUE,"%.1E", fval) < 0) + { + ffpmsg("Error in ffr2e converting float to string"); + *status = BAD_F2C; + } + + return(*status); + } + } + } + else + { + if ( snprintf(cval, FLEN_VALUE,"%.*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') && strlen(cval) < FLEN_VALUE-1 ) + { + /* 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 (snprintf(cval, FLEN_VALUE,"%.*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 ( snprintf(cval, FLEN_VALUE,"%.*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 ( snprintf(cval, FLEN_VALUE,"%.1E", dval) < 0) + { + ffpmsg("Error in ffd2e converting float to string"); + *status = BAD_F2C; + } + + return(*status); + } + } + } + else + { + if ( snprintf(cval, FLEN_VALUE,"%.*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') && strlen(cval) < FLEN_VALUE-1) + { + /* add decimal point if necessary to distinquish from integer */ + strcat(cval, "."); + } + } + + return(*status); +} + diff --git a/vendor/cfitsio/quantize.c b/vendor/cfitsio/quantize.c new file mode 100644 index 000000000..0bf73faa6 --- /dev/null +++ b/vendor/cfitsio/quantize.c @@ -0,0 +1,3955 @@ +/* + 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 +# include +# include +# include +# include + +#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 ZERO_VALUE -2147483646 /* value used to represent zero-valued 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 dither_method, int idata[], double *bscale, + double *bzero, int *iminval, int *imaxval) { + +/* arguments: +long row i: if positive, used to calculate random dithering seed value + (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 dither_method i; which dithering method to use +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, iseed = 0; + 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 (dither_method == SUBTRACTIVE_DITHER_2) + { + /* shift the range to be close to the value used to represent zeros */ + zeropt = minval - delta * (NULL_VALUE + N_RESERVED_VALUES); + } + else 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++) { + + if (dither_method == SUBTRACTIVE_DITHER_2 && fdata[i] == 0.0) { + idata[i] = ZERO_VALUE; + } else { + 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) { + if (dither_method == SUBTRACTIVE_DITHER_2 && fdata[i] == 0.0) { + idata[i] = ZERO_VALUE; + } else { + 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 dither_method, int idata[], double *bscale, + double *bzero, int *iminval, int *imaxval) { + +/* arguments: +long row i: tile number = row number in the binary table + (this is only used when dithering the quantized values) +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 +float qlevel i: quantization level +int dither_method i; which dithering method to use +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, iseed = 0; + long i, nx, ngood = 0; + double stdev, noise2 = 0., noise3 = 0., noise5 = 0.; /* 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 (dither_method == SUBTRACTIVE_DITHER_2) + { + /* shift the range to be close to the value used to represent zeros */ + zeropt = minval - delta * (NULL_VALUE + N_RESERVED_VALUES); + } + else 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++) { + + if (dither_method == SUBTRACTIVE_DITHER_2 && fdata[i] == 0.0) { + idata[i] = ZERO_VALUE; + } else { + 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) { + if (dither_method == SUBTRACTIVE_DITHER_2 && fdata[i] == 0.0) { + idata[i] = ZERO_VALUE; + } else { + 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_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 = 0, maxval = 0; + 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 = 0, maxval = 0; + 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 < 9) { + /* 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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; + + 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 < 9) { + /* 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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; + + 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 < 9) { + /* 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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; + + 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 < 9) { + /* 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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 */ + ngoodpix++; + + 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; + + 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/vendor/cfitsio/region.c b/vendor/cfitsio/region.c new file mode 100644 index 000000000..a5bec8d69 --- /dev/null +++ b/vendor/cfitsio/region.c @@ -0,0 +1,1809 @@ +#include +#include +#include +#include +#include +#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 ) { + snprintf(currLine,allocLen,"Could not open Region file %s.",filename); + ffpmsg( currLine ); + free( currLine ); + free( aRgn ); + return( *status = FILE_NOT_OPENED ); + } + + /* Read in file, line by line */ + /* First, set error status in case file is empty */ + *status = FILE_NOT_OPENED; + + while( fgets(currLine,allocLen,rgnFile) != NULL ) { + + /* reset status if we got here */ + *status = 0; + + /* 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( !fits_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( !fits_strncasecmp( currLoc, "pixel", 5 ) ) { + cFmt = pixel_fmt; + } else if( !fits_strncasecmp( currLoc, "degree", 6 ) ) { + cFmt = degree_fmt; + } else if( !fits_strncasecmp( currLoc, "hhmmss", 6 ) ) { + cFmt = hhmmss_fmt; + } else if( !fits_strncasecmp( currLoc, "hms", 3 ) ) { + cFmt = hhmmss_fmt; + } else { + ffpmsg("Unknown format code encountered in region file."); + *status = PARSE_SYNTAX_ERR; + goto error; + } + } + + } else if( !fits_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( !fits_strncasecmp( namePtr, "image;", 6 ) ) { + namePtr += 6; + cFmt = pixel_fmt; + } else if( !fits_strncasecmp( namePtr, "physical;", 9 ) ) { + namePtr += 9; + cFmt = pixel_fmt; + } else if( !fits_strncasecmp( namePtr, "linear;", 7 ) ) { + namePtr += 7; + cFmt = pixel_fmt; + } else if( !fits_strncasecmp( namePtr, "fk4;", 4 ) ) { + namePtr += 4; + cFmt = degree_fmt; + } else if( !fits_strncasecmp( namePtr, "fk5;", 4 ) ) { + namePtr += 4; + cFmt = degree_fmt; + } else if( !fits_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( !fits_strncasecmp( namePtr, "fk5", 3 ) ) { + cFmt = degree_fmt; + continue; /* supports POW region file format */ + } else if( !fits_strncasecmp( namePtr, "fk4", 3 ) ) { + cFmt = degree_fmt; + continue; /* supports POW region file format */ + } else if( !fits_strncasecmp( namePtr, "icrs", 4 ) ) { + cFmt = degree_fmt; + continue; /* supports POW region file format */ + } else if( !fits_strncasecmp( namePtr, "image", 5 ) ) { + cFmt = pixel_fmt; + continue; /* supports POW region file format */ + } else if( !fits_strncasecmp( namePtr, "physical", 8 ) ) { + cFmt = pixel_fmt; + continue; /* supports POW region file format */ + + + } else if( !fits_strncasecmp( namePtr, "galactic;", 9 ) ) { + ffpmsg( "Galactic region coordinates not supported" ); + ffpmsg( namePtr ); + *status = PARSE_SYNTAX_ERR; + goto error; + } else if( !fits_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( !fits_strcasecmp( namePtr, "circle" ) ) { + newShape->shape = circle_rgn; + if( nParams != 3 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 2; + } else if( !fits_strcasecmp( namePtr, "annulus" ) ) { + newShape->shape = annulus_rgn; + if( nParams != 4 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 2; + } else if( !fits_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( !fits_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( !fits_strcasecmp( namePtr, "box" ) + || !fits_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( !fits_strcasecmp( namePtr, "rectangle" ) + || !fits_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( !fits_strcasecmp( namePtr, "diamond" ) + || !fits_strcasecmp( namePtr, "rotdiamond" ) + || !fits_strcasecmp( namePtr, "rhombus" ) + || !fits_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( !fits_strcasecmp( namePtr, "sector" ) + || !fits_strcasecmp( namePtr, "pie" ) ) { + newShape->shape = sector_rgn; + if( nParams != 4 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 2; + } else if( !fits_strcasecmp( namePtr, "point" ) ) { + newShape->shape = point_rgn; + if( nParams != 2 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 2; + } else if( !fits_strcasecmp( namePtr, "line" ) ) { + newShape->shape = line_rgn; + if( nParams != 4 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 4; + } else if( !fits_strcasecmp( namePtr, "polygon" ) ) { + newShape->shape = poly_rgn; + if( nParams < 6 || (nParams&1) ) + *status = PARSE_SYNTAX_ERR; + nCoords = nParams; + } else if( !fits_strcasecmp( namePtr, "panda" ) ) { + newShape->shape = panda_rgn; + if( nParams != 8 ) + *status = PARSE_SYNTAX_ERR; + nCoords = 2; + } else if( !fits_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( !fits_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; iexists ) { + 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( ; ixrefval, 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); + default: + break; + } + } + + /* 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; inShapes; 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( Xxmin || X>Shapes->xmax + || Yymin || 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. + This is more complicated for the case of polygons, which may be sharing + points arrays due to shallow copying (in fits_set_region_components) of + 'exluded' regions. We must ensure that these arrays are only freed once. + +/*---------------------------------------------------------------------------*/ +{ + int i,j; + + int nFreedPoly=0; + int nPolyArraySize=10; + double **freedPolyPtrs=0; + double *ptsToFree=0; + int isAlreadyFreed=0; + + freedPolyPtrs = (double**)malloc(nPolyArraySize*sizeof(double*)); + + for( i=0; inShapes; i++ ) + if( Rgn->Shapes[i].shape == poly_rgn ) + { + /* No shared arrays for 'include' polygons */ + if (Rgn->Shapes[i].sign) + free(Rgn->Shapes[i].param.poly.Pts); + else + { + ptsToFree = Rgn->Shapes[i].param.poly.Pts; + isAlreadyFreed = 0; + for (j=0; jShapes ) + free( Rgn->Shapes ); + free( Rgn ); + + free(freedPolyPtrs); +} + +/*---------------------------------------------------------------------------*/ +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; iprevY && y>=nextY) || (yprevX && 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 ( inShapes ) { + + /* 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 */ + + /* Note that this makes shallow copies of a polygon's dynamically + allocated Pts array -- the memory is shared. This must be checked + when freeing in fits_free_region. */ + + 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; inShapes; 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; + default: + 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; + + default: + 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; + + default: + 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 = 0, Ysave = 0, 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 = 0; + + 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<17; 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; jparam.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; jxrefval, 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; + default: + 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; jxrefval, 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; + default: + 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; jcomp, &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/vendor/cfitsio/region.h b/vendor/cfitsio/region.h new file mode 100644 index 000000000..516c4fdb1 --- /dev/null +++ b/vendor/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/vendor/cfitsio/ricecomp.c b/vendor/cfitsio/ricecomp.c new file mode 100644 index 000000000..f176924ca --- /dev/null +++ b/vendor/cfitsio/ricecomp.c @@ -0,0 +1,1361 @@ +/* + 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. + + Note that beginning with CFITSIO v3.08, EOB checking was removed to improve + speed, and so now the input compressed bytes buffers must have been + allocated big enough so that they will never be overflowed. A simple + rule of thumb that guarantees the buffer will be large enough is to make + it 1% larger than the size of the input array of pixels that are being + compressed. + +*/ + +/*----------------------------------------------------------*/ +/* */ +/* 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 +#include +#include + +/* + * nonzero_count is lookup table giving number of bits in 8-bit values not including + * leading zeros used in fits_rdecomp, fits_rdecomp_short and fits_rdecomp_byte + */ +static const int nonzero_count[256] = { +0, +1, +2, 2, +3, 3, 3, 3, +4, 4, 4, 4, 4, 4, 4, 4, +5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, +6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, +6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, +7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, +7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, +7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, +7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, +8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, +8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, +8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, +8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, +8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, +8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, +8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, +8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8}; + +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); + +/* only used for diagnoistics +static int case1, case2, case3; +int fits_get_case(int *c1, int*c2, int*c3) { + + *c1 = case1; + *c2 = case2; + *c3 = case3; + return(0); +} +*/ + +/* 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<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> 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; jbitbuffer; + lbits_to_go = buffer->bits_to_go; + for (j=0; j> 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<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> 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) { +/* case3++; */ + /* 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; jbitbuffer; + lbits_to_go = buffer->bits_to_go; + for (j=0; j> 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<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> 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; jbitbuffer; + lbits_to_go = buffer->bits_to_go; + for (j=0; j> 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<>(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<>(-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<bits_to_go,buffer); + +/* if (putcbuf(buffer->bitbuffer<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 +#include +*/ + +/*---------------------------------------------------------------------------*/ +/* 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; +extern const int nonzero_count[]; + + /* + * 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<> nbits) - 1; + + b &= (1< nx) imax = nx; + if (fs<0) { + /* low-entropy case, all zero differences */ + for ( ; i= 0; k -= 8) { + b = *c++; + diff |= b<0) { + b = *c++; + diff |= b>>(-k); + b &= (1<>1; + } else { + diff = ~(diff>>1); + } + array[i] = diff+lastpix; + lastpix = array[i]; + } + } else { + /* normal case, Rice coding */ + for ( ; i>nbits); + b &= (1<>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; +extern const int nonzero_count[]; + + /* + * 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<> nbits) - 1; + + b &= (1< nx) imax = nx; + if (fs<0) { + /* low-entropy case, all zero differences */ + for ( ; i= 0; k -= 8) { + b = *c++; + diff |= b<0) { + b = *c++; + diff |= b>>(-k); + b &= (1<>1; + } else { + diff = ~(diff>>1); + } + array[i] = diff+lastpix; + lastpix = array[i]; + } + } else { + /* normal case, Rice coding */ + for ( ; i>nbits); + b &= (1<>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; +extern const int nonzero_count[]; + + /* + * 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<> nbits) - 1; + + b &= (1< nx) imax = nx; + if (fs<0) { + /* low-entropy case, all zero differences */ + for ( ; i= 0; k -= 8) { + b = *c++; + diff |= b<0) { + b = *c++; + diff |= b>>(-k); + b &= (1<>1; + } else { + diff = ~(diff>>1); + } + array[i] = diff+lastpix; + lastpix = array[i]; + } + } else { + /* normal case, Rice coding */ + for ( ; i>nbits); + b &= (1<>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/vendor/cfitsio/scalnull.c b/vendor/cfitsio/scalnull.c new file mode 100644 index 000000000..d2f2924ef --- /dev/null +++ b/vendor/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 +#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/vendor/cfitsio/simplerng.c b/vendor/cfitsio/simplerng.c new file mode 100644 index 000000000..91ef6f88e --- /dev/null +++ b/vendor/cfitsio/simplerng.c @@ -0,0 +1,461 @@ +/* + Simple Random Number Generators + - getuniform - uniform deviate [0,1] + - getnorm - gaussian (normal) deviate (mean=0, stddev=1) + - getpoisson - poisson deviate for given expected mean lambda + + This code is adapted from SimpleRNG by John D Cook, which is + provided in the public domain. + + The original C++ code is found here: + http://www.johndcook.com/cpp_random_number_generation.html + + This code has been modified in the following ways compared to the + original. + 1. convert to C from C++ + 2. keep only uniform, gaussian and poisson deviates + 3. state variables are module static instead of class variables + 4. provide an srand() equivalent to initialize the state +*/ +#include +#include + +#define PI 3.1415926535897932384626433832795 + +/* Use the standard system rand() library routine if it provides + enough bits of information, since it probably has better randomness + than the toy algorithm in this module. */ +#if defined(RAND_MAX) && RAND_MAX > 1000000000 +#define USE_SYSTEM_RAND +#endif + +int simplerng_poisson_small(double lambda); +int simplerng_poisson_large(double lambda); +double simplerng_getuniform_pr(unsigned int *u, unsigned int *v); +unsigned int simplerng_getuint_pr(unsigned int *u, unsigned int *v); +double simplerng_logfactorial(int n); + +/* + These values are not magical, just the default values Marsaglia used. + Any unit should work. +*/ +static unsigned int m_u = 521288629, m_v = 362436069; + +/* Set u and v state variables */ +void simplerng_setstate(unsigned int u, unsigned int v) +{ + m_u = u; + m_v = v; +} + +/* Retrieve u and v state variables */ +void simplerng_getstate(unsigned int *u, unsigned int *v) +{ + *u = m_u; + *v = m_v; +} + +/* srand() equivalent to seed the two state variables */ +void simplerng_srand(unsigned int seed) +{ +#ifdef USE_SYSTEM_RAND + srand(seed); +#else + simplerng_setstate(seed ^ 521288629, seed ^ 362436069); +#endif +} + +/* Private routine to get uniform deviate */ +double simplerng_getuniform_pr(unsigned int *u, unsigned int *v) +{ + /* 0 <= u <= 2^32 */ + unsigned int z = simplerng_getuint_pr(u, v); + /* The magic number is 1/(2^32) and so result is positive and less than 1. */ + return z*2.328306435996595e-10; +} + +/* Private routine to get unsigned integer */ +/* Marsaglia multiply-with-carry algorithm (MWC) */ +unsigned int simplerng_getuint_pr(unsigned int *u, unsigned int *v) +{ + *v = 36969*((*v) & 65535) + ((*v) >> 16); + *u = 18000*((*u) & 65535) + ((*u) >> 16); + return ((*v) << 16) + (*u); +} + +/* Get uniform deviate [0,1] */ +double simplerng_getuniform(void) +{ +#ifdef USE_SYSTEM_RAND + return rand()*(1.0 / ((double)RAND_MAX + 1)); +#else + return simplerng_getuniform_pr(&m_u, &m_v); +#endif +} + +/* Get unsigned integer [0, UINT_MAX] */ +unsigned int simplerng_getuint() +{ + /* WARNING: no option for calling rand() here. Will need to provide + a scalar to make the uint in the [0,UINT_MAX] range */ + return simplerng_getuint_pr(&m_u, &m_v); +} + +/* Get normal (Gaussian) random sample with mean=0, stddev=1 */ +double simplerng_getnorm() +{ + double u1, u2, r, theta; + static int saved = 0; + static double y; + + /* Since you get two deviates for "free" with each calculation, save + one of them for later */ + + if (saved == 0) { + /* Use Box-Muller algorithm */ + u1 = simplerng_getuniform(); + u2 = simplerng_getuniform(); + r = sqrt( -2.0*log(u1) ); + theta = 2.0*PI*u2; + /* save second value for next call */ + y = r*cos(theta); + saved = 1; + return r*sin(theta); + + } else { + /* We already saved a value from the last call so use it */ + saved = 0; + return y; + } +} + +/* Poisson deviate for expected mean value lambda. + lambda should be in the range [0, infinity] + + For small lambda, a simple rejection method is used + For large lambda, an approximation is used +*/ +int simplerng_getpoisson(double lambda) +{ + if (lambda < 0) lambda = 0; + return ((lambda < 15.0) + ? simplerng_poisson_small(lambda) + : simplerng_poisson_large(lambda)); +} + +int simplerng_poisson_small(double lambda) +{ + /* Algorithm due to Donald Knuth, 1969. */ + double p = 1.0, L = exp(-lambda); + int k = 0; + do { + k++; + p *= simplerng_getuniform(); + } + while (p > L); + return k - 1; +} + +int simplerng_poisson_large(double lambda) +{ + /* "Rejection method PA" from "The Computer Generation of Poisson Random Variables" by A. C. Atkinson + Journal of the Royal Statistical Society Series C (Applied Statistics) Vol. 28, No. 1. (1979) + The article is on pages 29-35. The algorithm given here is on page 32. */ + static double beta, alpha, k; + static double old_lambda = -999999.; + + if (lambda != old_lambda) { + double c = 0.767 - 3.36/lambda; + beta = PI/sqrt(3.0*lambda); + alpha = beta*lambda; + k = log(c) - lambda - log(beta); + old_lambda = lambda; + } + + for(;;) { /* forever */ + double u, x, v, y, temp, lhs, rhs; + int n; + + u = simplerng_getuniform(); + x = (alpha - log((1.0 - u)/u))/beta; + n = (int) floor(x + 0.5); + if (n < 0) continue; + + v = simplerng_getuniform(); + y = alpha - beta*x; + temp = 1.0 + exp(y); + lhs = y + log(v/(temp*temp)); + rhs = k + n*log(lambda) - simplerng_logfactorial(n); + if (lhs <= rhs) return n; + } + +} + +/* Lookup table for log-gamma function */ +static double lf[] = { + 0.000000000000000, + 0.000000000000000, + 0.693147180559945, + 1.791759469228055, + 3.178053830347946, + 4.787491742782046, + 6.579251212010101, + 8.525161361065415, + 10.604602902745251, + 12.801827480081469, + 15.104412573075516, + 17.502307845873887, + 19.987214495661885, + 22.552163853123421, + 25.191221182738683, + 27.899271383840894, + 30.671860106080675, + 33.505073450136891, + 36.395445208033053, + 39.339884187199495, + 42.335616460753485, + 45.380138898476908, + 48.471181351835227, + 51.606675567764377, + 54.784729398112319, + 58.003605222980518, + 61.261701761002001, + 64.557538627006323, + 67.889743137181526, + 71.257038967168000, + 74.658236348830158, + 78.092223553315307, + 81.557959456115029, + 85.054467017581516, + 88.580827542197682, + 92.136175603687079, + 95.719694542143202, + 99.330612454787428, + 102.968198614513810, + 106.631760260643450, + 110.320639714757390, + 114.034211781461690, + 117.771881399745060, + 121.533081515438640, + 125.317271149356880, + 129.123933639127240, + 132.952575035616290, + 136.802722637326350, + 140.673923648234250, + 144.565743946344900, + 148.477766951773020, + 152.409592584497350, + 156.360836303078800, + 160.331128216630930, + 164.320112263195170, + 168.327445448427650, + 172.352797139162820, + 176.395848406997370, + 180.456291417543780, + 184.533828861449510, + 188.628173423671600, + 192.739047287844900, + 196.866181672889980, + 201.009316399281570, + 205.168199482641200, + 209.342586752536820, + 213.532241494563270, + 217.736934113954250, + 221.956441819130360, + 226.190548323727570, + 230.439043565776930, + 234.701723442818260, + 238.978389561834350, + 243.268849002982730, + 247.572914096186910, + 251.890402209723190, + 256.221135550009480, + 260.564940971863220, + 264.921649798552780, + 269.291097651019810, + 273.673124285693690, + 278.067573440366120, + 282.474292687630400, + 286.893133295426990, + 291.323950094270290, + 295.766601350760600, + 300.220948647014100, + 304.686856765668720, + 309.164193580146900, + 313.652829949878990, + 318.152639620209300, + 322.663499126726210, + 327.185287703775200, + 331.717887196928470, + 336.261181979198450, + 340.815058870798960, + 345.379407062266860, + 349.954118040770250, + 354.539085519440790, + 359.134205369575340, + 363.739375555563470, + 368.354496072404690, + 372.979468885689020, + 377.614197873918670, + 382.258588773060010, + 386.912549123217560, + 391.575988217329610, + 396.248817051791490, + 400.930948278915760, + 405.622296161144900, + 410.322776526937280, + 415.032306728249580, + 419.750805599544780, + 424.478193418257090, + 429.214391866651570, + 433.959323995014870, + 438.712914186121170, + 443.475088120918940, + 448.245772745384610, + 453.024896238496130, + 457.812387981278110, + 462.608178526874890, + 467.412199571608080, + 472.224383926980520, + 477.044665492585580, + 481.872979229887900, + 486.709261136839360, + 491.553448223298010, + 496.405478487217580, + 501.265290891579240, + 506.132825342034830, + 511.008022665236070, + 515.890824587822520, + 520.781173716044240, + 525.679013515995050, + 530.584288294433580, + 535.496943180169520, + 540.416924105997740, + 545.344177791154950, + 550.278651724285620, + 555.220294146894960, + 560.169054037273100, + 565.124881094874350, + 570.087725725134190, + 575.057539024710200, + 580.034272767130800, + 585.017879388839220, + 590.008311975617860, + 595.005524249382010, + 600.009470555327430, + 605.020105849423770, + 610.037385686238740, + 615.061266207084940, + 620.091704128477430, + 625.128656730891070, + 630.172081847810200, + 635.221937855059760, + 640.278183660408100, + 645.340778693435030, + 650.409682895655240, + 655.484856710889060, + 660.566261075873510, + 665.653857411105950, + 670.747607611912710, + 675.847474039736880, + 680.953419513637530, + 686.065407301994010, + 691.183401114410800, + 696.307365093814040, + 701.437263808737160, + 706.573062245787470, + 711.714725802289990, + 716.862220279103440, + 722.015511873601330, + 727.174567172815840, + 732.339353146739310, + 737.509837141777440, + 742.685986874351220, + 747.867770424643370, + 753.055156230484160, + 758.248113081374300, + 763.446610112640200, + 768.650616799717000, + 773.860102952558460, + 779.075038710167410, + 784.295394535245690, + 789.521141208958970, + 794.752249825813460, + 799.988691788643450, + 805.230438803703120, + 810.477462875863580, + 815.729736303910160, + 820.987231675937890, + 826.249921864842800, + 831.517780023906310, + 836.790779582469900, + 842.068894241700490, + 847.352097970438420, + 852.640365001133090, + 857.933669825857460, + 863.231987192405430, + 868.535292100464630, + 873.843559797865740, + 879.156765776907600, + 884.474885770751830, + 889.797895749890240, + 895.125771918679900, + 900.458490711945270, + 905.796028791646340, + 911.138363043611210, + 916.485470574328820, + 921.837328707804890, + 927.193914982476710, + 932.555207148186240, + 937.921183163208070, + 943.291821191335660, + 948.667099599019820, + 954.046996952560450, + 959.431492015349480, + 964.820563745165940, + 970.214191291518320, + 975.612353993036210, + 981.015031374908400, + 986.422203146368590, + 991.833849198223450, + 997.249949600427840, + 1002.670484599700300, + 1008.095434617181700, + 1013.524780246136200, + 1018.958502249690200, + 1024.396581558613400, + 1029.838999269135500, + 1035.285736640801600, + 1040.736775094367400, + 1046.192096209724900, + 1051.651681723869200, + 1057.115513528895000, + 1062.583573670030100, + 1068.055844343701400, + 1073.532307895632800, + 1079.012946818975000, + 1084.497743752465600, + 1089.986681478622400, + 1095.479742921962700, + 1100.976911147256000, + 1106.478169357800900, + 1111.983500893733000, + 1117.492889230361000, + 1123.006317976526100, + 1128.523770872990800, + 1134.045231790853000, + 1139.570684729984800, + 1145.100113817496100, + 1150.633503306223700, + 1156.170837573242400, +}; + +double simplerng_logfactorial(int n) +{ + if (n < 0) return 0; + if (n > 254) { + double x = n + 1; + return (x - 0.5)*log(x) - x + 0.5*log(2*PI) + 1.0/(12.0*x); + } + return lf[n]; +} diff --git a/vendor/cfitsio/simplerng.h b/vendor/cfitsio/simplerng.h new file mode 100644 index 000000000..ef4e74ee3 --- /dev/null +++ b/vendor/cfitsio/simplerng.h @@ -0,0 +1,27 @@ +/* + Simple Random Number Generators + - getuniform - uniform deviate [0,1] + - getnorm - gaussian (normal) deviate (mean=0, stddev=1) + - getpoisson - poisson deviate for given expected mean lambda + + This code is adapted from SimpleRNG by John D Cook, which is + provided in the public domain. + + The original C++ code is found here: + http://www.johndcook.com/cpp_random_number_generation.html + + This code has been modified in the following ways compared to the + original. + 1. convert to C from C++ + 2. keep only uniform, gaussian and poisson deviates + 3. state variables are module static instead of class variables + 4. provide an srand() equivalent to initialize the state +*/ + +extern void simplerng_setstate(unsigned int u, unsigned int v); +extern void simplerng_getstate(unsigned int *u, unsigned int *v); +extern void simplerng_srand(unsigned int seed); +extern double simplerng_getuniform(void); +extern double simplerng_getnorm(void); +extern int simplerng_getpoisson(double lambda); +extern double simplerng_logfactorial(int n); diff --git a/vendor/cfitsio/swapproc.c b/vendor/cfitsio/swapproc.c new file mode 100644 index 000000000..cc69d6e69 --- /dev/null +++ b/vendor/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 +#include +#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 +/* 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 +/* 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/vendor/cfitsio/wcssub.c b/vendor/cfitsio/wcssub.c new file mode 100644 index 000000000..1c1a5b701 --- /dev/null +++ b/vendor/cfitsio/wcssub.c @@ -0,0 +1,1043 @@ +#include +#include +#include +#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/vendor/cfitsio/wcsutil.c b/vendor/cfitsio/wcsutil.c new file mode 100644 index 000000000..394a0f043 --- /dev/null +++ b/vendor/cfitsio/wcsutil.c @@ -0,0 +1,503 @@ +#include +#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') && + !(*(cptr + 1) == 'P' && *(cptr + 2) == 'V') ) { + 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)1.0) + return(*status = 501); + rat = asin (rat); + mg = 1.0 + sin(dect) * sin0 + cos(dect) * cos0 * cos(rat); + if (fabs(mg)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))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)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)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 +#include +#include +#include +#include +#include "zlib.h" + +#define GZBUFSIZE 115200 /* 40 FITS blocks */ +#define 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 */ + /* Input args buffptr and buffsize may refer to a block of memory + larger than the 2^32 4 byte limit. If so, must be broken + up into "pages" when assigned to d_stream. + (d_stream.avail_out is a uInt type, which might be smaller + than buffsize's size_t type.) + */ + const uLong nPages = (uLong)(*buffsize)/(uLong)UINT_MAX; + uLong iPage=0; + uInt outbuffsize = (nPages > 0) ? UINT_MAX : (uInt)(*buffsize); + + + 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 = outbuffsize; + + /* 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 || err == Z_BUF_ERROR) { + /* Z_BUF_ERROR means need more input data to make progress */ + if (!d_stream.avail_in) break; /* need more input */ + + /* need more space in output buffer */ + /* First check if more memory is available above the + 4Gb limit in the originally input buffptr array */ + if (iPage < nPages) + { + ++iPage; + d_stream.next_out = (unsigned char*)(*buffptr + iPage*(uLong)UINT_MAX); + if (iPage < nPages) + d_stream.avail_out = UINT_MAX; + else + d_stream.avail_out = (uInt)((uLong)(*buffsize) % (uLong)UINT_MAX); + } + else 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; +/* + These settings for next_out and avail_out appear to be redundant, + as the inflate() function should already be re-setting these. + For case where *buffsize < 4Gb this did not matter, but for + > 4Gb it would produce the wrong value in the avail_out assignment. + (C. Gordon Jul 2016) + 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 || err == Z_BUF_ERROR) { /* need more space in output buffer */ + /* Z_BUF_ERROR means need more input data to make progress */ + + 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 || err == Z_BUF_ERROR) { + /* Z_BUF_ERROR means need more input data to make progress */ + + 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/vendor/cfitsio/zuncompress.c b/vendor/cfitsio/zuncompress.c new file mode 100644 index 000000000..c73ee6deb --- /dev/null +++ b/vendor/cfitsio/zuncompress.c @@ -0,0 +1,603 @@ +/* gzcompress.h -- definitions for the .Z decompression routine used in CFITSIO */ + +#include +#include +#include +#include + +#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< 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<>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<= 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<= 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<= 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/vendor/trim_cfitsio.sh b/vendor/trim_cfitsio.sh new file mode 100755 index 000000000..3e0121464 --- /dev/null +++ b/vendor/trim_cfitsio.sh @@ -0,0 +1,47 @@ +#!/bin/sh +# Copyright (c) 2011-2017, Astropy Developers +# Distributable under a BSD-3-Clause license + +# This script is adopted from astropy and adjusted for the needs in IRFA. +# It should be run every time cfitsio is updated. +# This moves all the code needed for the actual library to lib +# and deletes everything else (except License.txt and doc/changes.txt) + +# So, the standard update would be to execute, from this directory, +# rm -rf cfitsio +# tar xvf # (e.g., cfitsio3410.tar.gz) +# ./trim_cfitsio.sh + +set -e + +# This just gets CORE_SOURCES from Makefile.in +lib_files=$(make -f cfitsio/Makefile.in cfitsioLibSrcs | sed 's/zlib\/.*//') +flib_files='f77_wrap1.c f77_wrap2.c f77_wrap3.c f77_wrap4.c' + +# The include files cannot be directly inferred from Makefile.in +inc_files='fitsio.h fitsio2.h longnam.h drvrsmem.h eval_defs.h eval_tab.h region.h group.h simplerng.h grparser.h f77_wrap.h cfortran.h' + +extra_files='config.sub config.guess Makefile.in cfitsio.pc.in' + +if [ ! -d cfitsio/lib ]; then + mkdir cfitsio/lib +fi + +for fil in $lib_files $flib_files $inc_files $extra_files; do + if [ -f "cfitsio/$fil" ]; then + mv "cfitsio/$fil" cfitsio/lib/ + fi +done + +rm -rf cfitsio/cfitsio.xcodeproj +rm -rf cfitsio/docs +rm -f cfitsio/[!L]*.* +rm -f cfitsio/f77_* cfitsio/cfortran.h +mv cfitsio/lib/* cfitsio/ +rmdir cfitsio/lib/ + +cat <cfitsio/README.IRAF +Note: IRAF only requires the CFITSIO library, and hence in this bundled version, +we removed all other files except the required license (License.txt) and changelog +(docs/changes.txt, which has the version number). +EOF From 5e5a21bc667580104fd7201e145fa22f57c9036d Mon Sep 17 00:00:00 2001 From: Mike Fitzpatrick Date: Tue, 5 Mar 2024 05:19:26 +0100 Subject: [PATCH 2/4] revert to CFITSIO for table i/o The libtbtables.a was changed in v2.16 to use SPP fitsio from earlier uses of the fortran version under the assumption that they were equivalent. However, there is a bug in the fortran version of ftdrow() when called by the TDIFFER task in which the output table doesn't have its NAXIS2 value properly updated for FITS tables causing the task to exit. The cfitsio code acknowledges the value may not be correct and so uses an internal data structure value for the 'nrows' rather than the keyword, but equivalent functionality does not exist in the fortran version. A similar problem exists when inserting rows but this is not called from any existing NTTOOLS tasks. This change fixes a bug in the GEMINI.GSEEING task which is the only task known to call TDIFFER. --- pkg/tbtables/mkpkg | 14 +- pkg/tbtables/tbfxff.c | 795 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 805 insertions(+), 4 deletions(-) create mode 100644 pkg/tbtables/tbfxff.c diff --git a/pkg/tbtables/mkpkg b/pkg/tbtables/mkpkg index 1a8b5bddb..8b710d088 100644 --- a/pkg/tbtables/mkpkg +++ b/pkg/tbtables/mkpkg @@ -34,7 +34,7 @@ update: libtbtables.a: - $set XFLAGS = "-Inolibc $(XFLAGS)" + $set XFLAGS = "-Inolibc -I$(iraf)include $(XFLAGS)" tbagt.x tbtables.h tbapt.x tbtables.h @@ -235,7 +235,13 @@ libtbtables.a: tbnparse.x @selector - $echo "NOTE: SPP FITSIO will be used for FITS tables." - tbfhp_f.x tbtables.h tblfits.h - @fitsio + $ifdef (SPPFITSIO) + $echo "NOTE: SPP FITSIO will be used for FITS tables." + tbfhp_f.x tbtables.h tblfits.h + @fitsio + $else + $echo "NOTE: CFITSIO will be used for FITS tables." + tbfxff.c fitsio_spp.h underscore.h + tbfhp.x tbtables.h tblfits.h + $endif ; diff --git a/pkg/tbtables/tbfxff.c b/pkg/tbtables/tbfxff.c new file mode 100644 index 000000000..27755ebc0 --- /dev/null +++ b/pkg/tbtables/tbfxff.c @@ -0,0 +1,795 @@ +# include +# include /* CFITSIO include file */ +# include "fitsio_spp.h" /* sizes of SPP strings and Fortran FITSIO */ +# include "underscore.h" /* appends underscore, if needed */ + +/* These are buffers for character string values. The sizes are defined + in fitsio.h. +*/ +static char c_filename[FLEN_FILENAME+1]; +static char c_keyword[FLEN_KEYWORD+1]; +static char c_card[FLEN_CARD+1]; +static char c_value[FLEN_VALUE+1]; +static char c_comment[FLEN_COMMENT+1]; +static char c_message[FLEN_ERRMSG+1]; + +static void strpak (short *, char *, int); +static void strupk (char *, short *, int); + +/* This file tbfxff.c contains the interface between the SPP FITSIO calls + and the CFITSIO functions. + + Most subroutines begin with fs, but two of them (ftcmsg and ftdrec) + begin with ft. + + These function names, in upper case and ending in "_U", will be + converted to similar lower case names by underscore.h. The + resulting names will either end in "_" or not, depending on whether + NO_UNDERSCORE has been defined (see tables$lib/mkpkg.inc). + + Phil Hodge, 22-Mar-1999 File created. + Phil Hodge, 8-Apr-1999 Change FLEN_KEYWORD to FLEN_VALUE in fsukys. + Phil Hodge, 7-Sep-1999 Add fsukyj. + Phil Hodge, 25-May-2000 Add fsgrsz (fits_get_rowsize). + Phil Hodge, 23-Jun-2000 Add fsukyd. + Phil Hodge, 12-Sep-2000 Add fsgtbb and fsptbb. +*/ + +void FTDREC_U (fitsfile **fptr, int *keypos, int *status) { + + ffdrec (*fptr, *keypos, status); +} + +void FTCMSG_U() { + + ffcmsg(); +} + +void FSGIOU_U (fitsfile **fptr, int *status) { + ; +} + +void FSFIOU_U (fitsfile **fptr, int *status) { + ; +} + +void FSCLOS_U (fitsfile **fptr, int *status) { + + ffclos (*fptr, status); +} + +void FSCOPY_U (fitsfile **infptr, fitsfile **outfptr, int *morekeys, + int *status) { + + ffcopy (*infptr, *outfptr, *morekeys, status); +} + +void FSCRHD_U (fitsfile **fptr, int *status) { + + ffcrhd (*fptr, status); +} + +void FSDHDU_U (fitsfile **fptr, int *hdutyp, int *status) { + + ffdhdu (*fptr, hdutyp, status); +} + +void FSDROW_U (fitsfile **fptr, int *frow, int *nrows, int *status) { + + ffdrow (*fptr, (long)*frow, (long)*nrows, status); +} + +/* read bytes */ +void FSGTBB_U (fitsfile **fptr, int *frow, int *felem, int *nbytes, + short array[], int *status) { + + ffgtbb (*fptr, (long)*frow, (long)*felem, (long)*nbytes, + (unsigned char *)array, status); +} + +/* write bytes */ +void FSPTBB_U (fitsfile **fptr, int *frow, int *felem, int *nbytes, + short array[], int *status) { + + ffptbb (*fptr, (long)*frow, (long)*felem, (long)*nbytes, + (unsigned char *)array, status); +} + +/* NOTE: This is deprecated; use fsgcfl instead. See next function. ### */ + +void FSGCL_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int lray[], int *status) { + + char nulval = 0; + int anynul; + int i; + char *larray; /* really an array of logical values, not a string */ + + larray = calloc (*nelem, sizeof(char)); + + ffgcvl (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + nulval, larray, &anynul, status); + + for (i = 0; i < *nelem; i++) + lray[i] = larray[i]; + + free (larray); +} + +void FSGCFL_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int lray[], int flgval[], int *anynul, int *status) { + + int i; + /* These two are really arrays of logical values, not strings. */ + char *larray; + char *nularray; + + larray = calloc (*nelem, sizeof(char)); + nularray = calloc (*nelem, sizeof(char)); + + ffgcfl (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + larray, nularray, anynul, status); + + for (i = 0; i < *nelem; i++) { + lray[i] = larray[i]; + flgval[i] = nularray[i]; + } + + free (larray); + free (nularray); +} + +void FSGCVD_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + double *nulval, double array[], int *anynul, int *status) { + + ffgcvd (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + *nulval, array, anynul, status); +} + +void FSGCVE_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + float *nulval, float array[], int *anynul, int *status) { + + ffgcve (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + *nulval, array, anynul, status); +} + +void FSGCVI_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + short *nulval, short array[], int *anynul, int *status) { + + ffgcvi (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + *nulval, array, anynul, status); +} + +void FSGCVJ_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int *nulval, int array[], int *anynul, int *status) { + + long *larray; + int i; + + larray = calloc (*nelem, sizeof(long)); + + ffgcvj (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + (long)*nulval, larray, anynul, status); + + for (i = 0; i < *nelem; i++) + array[i] = larray[i]; + + free (larray); +} + +void FSGCVS_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + short nulval[], short array[], int *dim1, + int *anynul, int *status) { + + char **larray; + char *lnulval; + int i, j; /* j is the index for array */ + + /* Note that the local variable for nulval has length dim1. */ + lnulval = calloc (*dim1+1, sizeof(char)); + larray = calloc (*nelem, sizeof(char*)); + + for (i = 0; i < *nelem; i++) + larray[i] = calloc (*dim1+1, sizeof(char)); + + strpak (nulval, lnulval, *dim1); + + ffgcvs (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + lnulval, larray, anynul, status); + + j = 0; + for (i = 0; i < *nelem; i++) { + strupk (larray[i], &array[j], *dim1); + free (larray[i]); + j += (*dim1 + 1); /* array is 2-D */ + } + + free (lnulval); + free (larray); +} + +void FSGHSP_U (fitsfile **fptr, int *nexist, int *nmore, int *status) { + + ffghsp (*fptr, nexist, nmore, status); +} + +void FSGKEY_U (fitsfile **fptr, short sppkey[], + short sppvalue[], short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + + ffgkey (*fptr, c_keyword, c_value, c_comment, status); + + if (*status == 0) { + strupk (c_value, sppvalue, FLEN_VALUE); + strupk (c_comment, sppcomm, FLEN_COMMENT); + } +} + +void FSGKYD_U (fitsfile **fptr, short sppkey[], double *value, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + + ffgkyd (*fptr, c_keyword, value, c_comment, status); + + if (status == 0) + strupk (c_comment, sppcomm, FLEN_COMMENT); +} + +void FSGKYJ_U (fitsfile **fptr, short sppkey[], int *value, + short sppcomm[], int *status) { + + long lvalue; + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + + ffgkyj (*fptr, c_keyword, &lvalue, c_comment, status); + *value = (int)lvalue; + + if (status == 0) + strupk (c_comment, sppcomm, FLEN_COMMENT); +} + +void FSGKYS_U (fitsfile **fptr, short sppkey[], short sppvalue[], + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + + ffgkys (*fptr, c_keyword, c_value, c_comment, status); + + if (*status == 0) { + strupk (c_value, sppvalue, FLEN_VALUE); + strupk (c_comment, sppcomm, FLEN_COMMENT); + } +} + +void FSGMSG_U (short sppmsg[]) { + + int i; + + i = ffgmsg (c_message); + if (i > 0) + strupk (c_message, sppmsg, FLEN_ERRMSG); + else + sppmsg[0] = 0; +} + +void FSGREC_U (fitsfile **fptr, int *nrec, short spprecord[], int *status) { + + ffgrec (*fptr, *nrec, c_card, status); + + if (*status == 0) + strupk (c_card, spprecord, FLEN_CARD); +} + +void FSGRSZ_U (fitsfile **fptr, int *maxrows, int *status) { + + long ndata; + + ffgrsz (*fptr, &ndata, status); + *maxrows = (int)ndata; +} + +void FSGTDM_U (fitsfile **fptr, int *colnum, int *maxdim, + int *naxis, int naxes[], int *status) { + + long *axlen; + int i; + + axlen = calloc (*maxdim, sizeof(long)); + + ffgtdm (*fptr, *colnum, *maxdim, naxis, axlen, status); + + if (*status == 0) { + for (i = 0; i < *naxis; i++) + naxes[i] = axlen[i]; + } + + free (axlen); +} + +void FSIBIN_U (fitsfile **fptr, int *nrows, int *nfields, + short sppttype[], short spptform[], short spptunit[], + short sppextnam[], int *pcount, int *status) { + + char **ttype, **tform, **tunit; + char *extnam; + int i; + int j1 = 0, j2 = 0, j3 = 0; + + ttype = calloc (*nfields, sizeof(char*)); + tform = calloc (*nfields, sizeof(char*)); + tunit = calloc (*nfields, sizeof(char*)); + + extnam = calloc (FLEN_VALUE+1, sizeof(char)); + strpak (sppextnam, extnam, FLEN_VALUE); + + for (i = 0; i < *nfields; i++) { + + ttype[i] = calloc (FLEN_VALUE+1, sizeof(char)); + tform[i] = calloc (FLEN_VALUE+1, sizeof(char)); + tunit[i] = calloc (FLEN_VALUE+1, sizeof(char)); + + strpak (&sppttype[j1], ttype[i], SZ_FTTYPE); + strpak (&spptform[j2], tform[i], SZ_FTFORM); + strpak (&spptunit[j3], tunit[i], SZ_FTUNIT); + + j1 += SZ_FTTYPE+1; + j2 += SZ_FTFORM+1; + j3 += SZ_FTUNIT+1; + } + + ffibin (*fptr, (long)*nrows, *nfields, + ttype, tform, tunit, + extnam, (long)*pcount, status); + + free (extnam); + for (i = 0; i < *nfields; i++) { + free (ttype[i]); + free (tform[i]); + free (tunit[i]); + } + free (ttype); + free (tform); + free (tunit); +} + +void FSICOL_U (fitsfile **fptr, int *colnum, + short sppttype[], short spptform[], int *status) { + + char *ttype, *tform; + + ttype = calloc (SZ_FTTYPE+1, sizeof(char*)); + tform = calloc (SZ_FTFORM+1, sizeof(char*)); + strpak (sppttype, ttype, SZ_FTTYPE); + strpak (spptform, tform, SZ_FTFORM); + + fficol (*fptr, *colnum, ttype, tform, status); + + free (ttype); + free (tform); +} + +void FSINIT_U (fitsfile **fptr, short sppname[], + int *blocksize, int *status) { + + strpak (sppname, c_filename, FLEN_FILENAME); + ffinit (fptr, c_filename, status); +} + +void FSIROW_U (fitsfile **fptr, int *frow, int *nrows, int *status) { + + ffirow (*fptr, (long)*frow, (long)*nrows, status); +} + +void FSMAHD_U (fitsfile **fptr, int *hdunum, int *exttype, int *status) { + + ffmahd (*fptr, *hdunum, exttype, status); +} + +void FSMCOM_U (fitsfile **fptr, short sppkey[], short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmcom (*fptr, c_keyword, c_comment, status); +} + +void FSMKYD_U (fitsfile **fptr, short sppkey[], double *dval, + int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkyd (*fptr, c_keyword, *dval, *decim, c_comment, status); +} + +void FSMKYE_U (fitsfile **fptr, short sppkey[], float *rval, + int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkye (*fptr, c_keyword, *rval, *decim, c_comment, status); +} + +void FSMKYJ_U (fitsfile **fptr, short sppkey[], int *intval, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkyj (*fptr, c_keyword, (long)*intval, c_comment, status); +} + +void FSMKYL_U (fitsfile **fptr, short sppkey[], int *logval, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkyl (*fptr, c_keyword, *logval, c_comment, status); +} + +void FSMKYS_U (fitsfile **fptr, short sppkey[], short sppvalue[], + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppvalue, c_value, FLEN_VALUE); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffmkys (*fptr, c_keyword, c_value, c_comment, status); +} + +void FSMREC_U (fitsfile **fptr, int *nkey, short sppcard[], int *status) { + + strpak (sppcard, c_card, FLEN_CARD); + + ffmrec (*fptr, *nkey, c_card, status); +} + +void FSOPEN_U (fitsfile **fptr, short sppname[], int *iomode, + int *blocksize, int *status) { + + strpak (sppname, c_filename, FLEN_FILENAME); + + ffopen (fptr, c_filename, *iomode, status); +} + +void FSPCLD_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + double array[], int *status) { + + ffpcld (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + array, status); +} + +void FSPCLE_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + float array[], int *status) { + + ffpcle (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + array, status); +} + +void FSPCLI_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + short array[], int *status) { + + ffpcli (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + array, status); +} + +void FSPCLJ_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int array[], int *status) { + + long *larray; + int i; + + larray = calloc (*nelem, sizeof(long)); + + for (i = 0; i < *nelem; i++) + larray[i] = array[i]; + + ffpclj (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + larray, status); + + free (larray); +} + +void FSPCLL_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int array[], int *status) { + + char *larray; + int i; + + larray = calloc (*nelem, sizeof(char)); + + for (i = 0; i < *nelem; i++) + larray[i] = array[i]; + + ffpcll (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + larray, status); + + free (larray); +} + +void FSPCLS_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + short array[], int *dim1, int *status) { + + char **larray; + int i, j; /* j is the index for array */ + + larray = calloc (*nelem, sizeof(char*)); + + j = 0; + for (i = 0; i < *nelem; i++) { + larray[i] = calloc (*dim1+1, sizeof(char)); + strpak (&array[j], larray[i], *dim1); + j += (*dim1 + 1); /* array is 2-D */ + } + + ffpcls (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, + larray, status); + + for (i = 0; i < *nelem; i++) + free (larray[i]); + + free (larray); +} + +void FSPCLU_U (fitsfile **fptr, int *colnum, + int *frow, int *felem, int *nelem, + int *status) { + + ffpclu (*fptr, *colnum, + (long)*frow, (long)*felem, (long)*nelem, status); +} + +void FSPCOM_U (fitsfile **fptr, short sppcomm[], int *status) { + + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpcom (*fptr, c_comment, status); +} + +void FSPHBN_U (fitsfile **fptr, int *nrows, int *nfields, + short sppttype[], short spptform[], short spptunit[], + short sppextnam[], int *pcount, int *status) { + + char **ttype, **tform, **tunit; + char *extnam; + int i; + int j1 = 0, j2 = 0, j3 = 0; + + ttype = calloc (*nfields, sizeof(char*)); + tform = calloc (*nfields, sizeof(char*)); + tunit = calloc (*nfields, sizeof(char*)); + + extnam = calloc (FLEN_VALUE+1, sizeof(char)); + strpak (sppextnam, extnam, FLEN_VALUE); + + for (i = 0; i < *nfields; i++) { + + ttype[i] = calloc (FLEN_VALUE+1, sizeof(char)); + tform[i] = calloc (FLEN_VALUE+1, sizeof(char)); + tunit[i] = calloc (FLEN_VALUE+1, sizeof(char)); + + strpak (&sppttype[j1], ttype[i], SZ_FTTYPE); + strpak (&spptform[j2], tform[i], SZ_FTFORM); + strpak (&spptunit[j3], tunit[i], SZ_FTUNIT); + + j1 += SZ_FTTYPE+1; + j2 += SZ_FTFORM+1; + j3 += SZ_FTUNIT+1; + } + + ffphbn (*fptr, (long)*nrows, *nfields, + ttype, tform, tunit, + extnam, (long)*pcount, status); + + free (extnam); + for (i = 0; i < *nfields; i++) { + free (ttype[i]); + free (tform[i]); + free (tunit[i]); + } + free (ttype); + free (tform); + free (tunit); +} + +void FSPHIS_U (fitsfile **fptr, short sppcomm[], int *status) { + + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffphis (*fptr, c_comment, status); +} + +void FSPHPR_U (fitsfile **fptr, int *simple, int *bitpix, + int *naxis, long naxes[], long *pcount, long *gcount, + int *extend, int *status) { + + long *axlen; + int i; + + axlen = calloc (*naxis, sizeof(long)); + + for (i = 0; i < *naxis; i++) + axlen[i] = naxes[i]; + + ffphpr (*fptr, *simple, *bitpix, *naxis, axlen, + (long)*pcount, (long)*gcount, *extend, status); + + free (axlen); +} + +void FSPKYD_U (fitsfile **fptr, short sppkey[], + double *dval, int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkyd (*fptr, c_keyword, *dval, *decim, c_comment, status); +} + +void FSPKYE_U (fitsfile **fptr, short sppkey[], + float *rval, int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkye (*fptr, c_keyword, *rval, *decim, c_comment, status); +} + +void FSPKYJ_U (fitsfile **fptr, short sppkey[], int *value, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkyj (*fptr, c_keyword, (long)*value, c_comment, status); +} + +void FSPKYL_U (fitsfile **fptr, short sppkey[], + int *logval, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkyl (*fptr, c_keyword, *logval, c_comment, status); +} + +void FSPKYS_U (fitsfile **fptr, short sppkey[], short sppvalue[], + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppvalue, c_value, FLEN_VALUE); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffpkys (*fptr, c_keyword, c_value, c_comment, status); +} + +void FSPREC_U (fitsfile **fptr, short sppcard[], int *status) { + + strpak (sppcard, c_card, FLEN_CARD); + + ffprec (*fptr, c_card, status); +} + +void FSPSVC_U (short sppcard[], + short sppvalue[], short sppcomm[], int *status) { + + strpak (sppcard, c_card, FLEN_CARD); + + ffpsvc (c_card, c_value, c_comment, status); + + if (*status == 0) { + strupk (c_value, sppvalue, FLEN_VALUE); + strupk (c_comment, sppcomm, FLEN_COMMENT); + } +} + +void FSPTDM_U (fitsfile **fptr, int *colnum, + int *naxis, int naxes[], int *status) { + + long *axlen; + int i; + + axlen = calloc (*naxis, sizeof(long)); + + for (i = 0; i < *naxis; i++) + axlen[i] = naxes[i]; + + ffptdm (*fptr, *colnum, *naxis, axlen, status); + + free (axlen); +} + +void FSRDEF_U (fitsfile **fptr, int *status) { + + ffrdef (*fptr, status); +} + +void FSUKYD_U (fitsfile **fptr, short sppkey[], + double *dval, int *decim, short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffukyd (*fptr, c_keyword, *dval, *decim, c_comment, status); +} + +void FSUKYJ_U (fitsfile **fptr, short sppkey[], int *value, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffukyj (*fptr, c_keyword, (long)*value, c_comment, status); +} + +void FSUKYL_U (fitsfile **fptr, short sppkey[], int *logval, + short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffukyl (*fptr, c_keyword, *logval, c_comment, status); +} + +void FSUKYS_U (fitsfile **fptr, short sppkey[], + short sppvalue[], short sppcomm[], int *status) { + + strpak (sppkey, c_keyword, FLEN_KEYWORD); + strpak (sppvalue, c_value, FLEN_VALUE); + strpak (sppcomm, c_comment, FLEN_COMMENT); + + ffukys (*fptr, c_keyword, c_value, c_comment, status); +} + +static void strpak (short *in, char *out, int maxch) { + + int i = 0; + + while (in[i] != 0 && i < maxch) { + out[i] = in[i]; + i++; + } + out[i] = '\0'; +} + +static void strupk (char *in, short *out, int maxch) { + + int i = 0; + + while (in[i] != '\0' && i < maxch) { + out[i] = in[i]; + i++; + } + out[i] = 0; +} From e669201b6cffca22a37b289294f17e97745f0b99 Mon Sep 17 00:00:00 2001 From: Ole Streicher Date: Sat, 16 Mar 2024 15:10:13 +0100 Subject: [PATCH 3/4] Link to cfitsio when tbtables are linked --- Makefile | 2 +- noao/digiphot/daophot/mkpkg | 2 +- noao/digiphot/ptools/mkpkg | 2 +- pkg/utilities/nttools/mkpkg | 4 ++-- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Makefile b/Makefile index 154830090..5aa5001c4 100644 --- a/Makefile +++ b/Makefile @@ -84,7 +84,7 @@ core: host vendor $(MKPKG) # Build the NOAO package. -noao: host core +noao: host core vendor cd $(noao) && $(MKPKG) -p noao # Run the test suite. diff --git a/noao/digiphot/daophot/mkpkg b/noao/digiphot/daophot/mkpkg index 166fda251..8f4fef57e 100644 --- a/noao/digiphot/daophot/mkpkg +++ b/noao/digiphot/daophot/mkpkg @@ -22,7 +22,7 @@ install: ; trelink: - $set LIBS = "-lncar -lgks -ltbtables -lxtools -lds" + $set LIBS = "-lncar -lgks -ltbtables -lcfitsio -lxtools -lds" $set XFLAGS = "$(XFLAGS) $(XF)" $set LFLAGS = "$(LFLAGS) $(LF)" $update libpkg.a diff --git a/noao/digiphot/ptools/mkpkg b/noao/digiphot/ptools/mkpkg index c94e5a07c..6519b5871 100644 --- a/noao/digiphot/ptools/mkpkg +++ b/noao/digiphot/ptools/mkpkg @@ -23,7 +23,7 @@ install: ; trelink: - $set LIBS = "-lds -lncar -lgks -lxtools -ltbtables" + $set LIBS = "-lds -lncar -lgks -lxtools -ltbtables -lcfitsio" $set XFLAGS = "$(XFLAGS) $(XF)" $set LFLAGS = "$(LFLAGS) $(LF)" $update libpkg.a diff --git a/pkg/utilities/nttools/mkpkg b/pkg/utilities/nttools/mkpkg index 94d1927f6..a62a0ff51 100644 --- a/pkg/utilities/nttools/mkpkg +++ b/pkg/utilities/nttools/mkpkg @@ -37,8 +37,8 @@ install: nttools: linkonly: $omake x_nttools.x - $link x_nttools.o libpkg.a -lxtools -ltbtables -lstxtools \ - -o xx_nttools.e + $link x_nttools.o libpkg.a -lxtools -ltbtables -lstxtools -lcfitsio \ + -o xx_nttools.e ; libpkg.a: From d2cbcb16ef1367aff8f3c5e0cbdbb40645f9aa8d Mon Sep 17 00:00:00 2001 From: Ole Streicher Date: Tue, 12 Mar 2024 09:46:25 +0100 Subject: [PATCH 4/4] Adjust test output for cfitsio --- test/utilities.nttools.md | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/test/utilities.nttools.md b/test/utilities.nttools.md index 31e925964..d9a6a890a 100644 --- a/test/utilities.nttools.md +++ b/test/utilities.nttools.md @@ -104,22 +104,22 @@ PCOUNT i 0 size of special data area GCOUNT i 1 one data group (required keyword) TFIELDS i 7 TTYPE1 t 'STARno' label for field 1 -TFORM1 t '1J' data format of the field: 4-byte INTEGER +TFORM1 t '1J' data format of field: 4-byte INTEGER TTYPE2 t 'X' label for field 2 -TFORM2 t '1D' data format of the field: 8-byte DOUBLE +TFORM2 t '1D' data format of field: 8-byte DOUBLE TUNIT2 t 'pixels' physical unit of field TTYPE3 t 'Y' label for field 3 -TFORM3 t '1D' data format of the field: 8-byte DOUBLE +TFORM3 t '1D' data format of field: 8-byte DOUBLE TUNIT3 t 'pixels' physical unit of field TTYPE4 t 'MAG' label for field 4 -TFORM4 t '1D' data format of the field: 8-byte DOUBLE +TFORM4 t '1D' data format of field: 8-byte DOUBLE TUNIT4 t 'magnitude' physical unit of field TTYPE5 t 'SHARP' label for field 5 -TFORM5 t '1D' data format of the field: 8-byte DOUBLE +TFORM5 t '1D' data format of field: 8-byte DOUBLE TTYPE6 t 'ROUND' label for field 6 -TFORM6 t '1D' data format of the field: 8-byte DOUBLE +TFORM6 t '1D' data format of field: 8-byte DOUBLE TTYPE7 t 'STARNAME' label for field 7 -TFORM7 t '15A' data format of the field: ASCII Character +TFORM7 t '15A' data format of field: ASCII Character EXTNAME t 'startable' name of this binary table extension TDISP1 t 'I5' display format TNULL1 i -2147483647 undefined value for column