File indexing completed on 2024-04-21 14:45:55

 /* FPACK utility routines
     SPDX-FileCopyrightText: William D. Pence <https://heasarc.gsfc.nasa.gov/fitsio/>
     SPDX-FileCopyrightText: R. Seaman
 
     SPDX-License-Identifier: LicenseRef-NASA-FV-License-Agreement
 */
 
 /* The following unused functions have been deleted to suppress compiler warnings:
  * int fp_pack_data_to_fits (const char *inputBuffer, size_t inputBufferSize, fitsfile **outfits, fpstate fpvar, int *islossless)
  * int fp_pack_data_to_data (const char *inputBuffer, size_t inputBufferSize, unsigned char **outputBuffer, size_t *outputBufferSize,
  *                          fpstate fpvar, int *islossless)
  * int fp_unpack_data_to_fits (const char *inputBuffer, size_t inputBufferSize, fitsfile **outfits, fpstate fpvar)
  *
  * If any of these are required in the future, please refer back to before commit 56a544be 1st June 2022
 */
 
 #include <time.h>
 #include <float.h>
 #include <signal.h>
 #include <ctype.h>
 
 /* #include  "bzlib.h"  only for experimental purposes */
 
 #if defined(unix) || defined(__unix__)  || defined(__unix)
 #include <sys/time.h>
 #endif
 
 #include <math.h>
 #include <fitsio.h>
 #include <fitsio2.h>
 #include "fpack.h"
 
 /* these filename buffer are used to delete temporary files */
 /* in case the program is aborted */
 char tempfilename[SZ_STR];
 char tempfilename2[SZ_STR];
 char tempfilename3[SZ_STR];
 
 /* nearest integer function */
 # define NINT(x)  ((x >= 0.) ? (int) (x + 0.5) : (int) (x - 0.5))
 # define NSHRT(x) ((x >= 0.) ? (short) (x + 0.5) : (short) (x - 0.5))
 
 /* define variables for measuring elapsed time */
 clock_t scpu, ecpu;
 long startsec;   /* start of elapsed time interval */
 int startmilli;  /* start of elapsed time interval */
 
 /*  CLOCKS_PER_SEC should be defined by most compilers */
 #if defined(CLOCKS_PER_SEC)
 #define CLOCKTICKS CLOCKS_PER_SEC
 #else
 /* on SUN OS machine, CLOCKS_PER_SEC is not defined, so set its value */
 #define CLOCKTICKS 1000000
 #endif
 
 FILE *outreport;
 
 /* dimension of central image area to be sampled for test statistics */
 int XSAMPLE = 4100;
 int YSAMPLE = 4100;
 
 #define UNUSED(x) (void)(x)
 #define fp_tmpnam(suffix, rootname, tmpnam) _fp_tmpnam((char *)suffix, (char *)rootname, (char *)tmpnam)
 
 /*--------------------------------------------------------------------------*/
 int fp_noop (void)
 {
     fp_msg ("Input and output files are unchanged.\n");
     return(0);
 }
 /*--------------------------------------------------------------------------*/
 void fp_abort_output (fitsfile *infptr, fitsfile *outfptr, int stat)
 {
     int status = 0, hdunum;
     char  msg[SZ_STR];
 
     if (infptr)
     {
         fits_file_name(infptr, tempfilename, &status);
         fits_get_hdu_num(infptr, &hdunum);
 
         fits_close_file (infptr, &status);
 
         snprintf(msg, SZ_STR,"Error processing file: %s\n", tempfilename);
         fp_msg (msg);
         snprintf(msg, SZ_STR,"  in HDU number %d\n", hdunum);
         fp_msg (msg);
     }
     else
     {
         snprintf(msg, SZ_STR,"Error: Unable to process input file\n");
         fp_msg(msg);
     }
     fits_report_error (stderr, stat);
 
     if (outfptr) {
         fits_delete_file(outfptr, &status);
         fp_msg ("Input file is unchanged.\n");
     }
 }
 /*--------------------------------------------------------------------------*/
 int fp_version (void)
 {
     float version;
     char cfitsioversion[40];
 
     fp_msg (FPACK_VERSION);
     fits_get_version(&version);
     snprintf(cfitsioversion, 40," CFITSIO version %5.3f", version);
     fp_msg(cfitsioversion);
     fp_msg ("\n");
     return(0);
 }
 /*--------------------------------------------------------------------------*/
 int fp_access (char *filename)
 {
     /* test if a file exists */
 
     FILE *diskfile;
 
     diskfile = fopen(filename, "r");
 
     if (diskfile) {
         fclose(diskfile);
         return(0);
     } else {
         return(-1);
     }
 }
 /*--------------------------------------------------------------------------*/
 int _fp_tmpnam(char *suffix, char *rootname, char *tmpnam)
 {
     /* create temporary file name */
 
     int maxtry = 30, ii;
 
     if (strlen(suffix) + strlen(rootname) > SZ_STR-5) {
         fp_msg ("Error: filename is too long to create temporary file\n"); exit (-1);
     }
 
     strcpy (tmpnam, rootname);  /* start with rootname */
     strcat(tmpnam, suffix);     /* append the suffix */
 
     maxtry = SZ_STR - strlen(tmpnam) - 1;
 
     for (ii = 0; ii < maxtry; ii++) {
         if (fp_access(tmpnam)) break;  /* good, the file does not exist */
         if (strlen(tmpnam) > SZ_STR-2)
         {
             fp_msg ("\nCould not create temporary file name:\n");
             fp_msg (tmpnam);
             fp_msg ("\n");
             exit (-1);
         }
         strcat(tmpnam, "x");  /* append an x to the name, and try again */
     }
 
     if (ii == maxtry) {
         fp_msg ("\nCould not create temporary file name:\n");
         fp_msg (tmpnam);
         fp_msg ("\n");
         exit (-1);
     }
 
     return(0);
 }
 /*--------------------------------------------------------------------------*/
 int fp_init (fpstate *fpptr)
 {
     int ii;
 
     fpptr->comptype = RICE_1;
     fpptr->quantize_level = DEF_QLEVEL;
     fpptr->no_dither = 0;
     fpptr->dither_method = 1;
     fpptr->dither_offset = 0;
     fpptr->int_to_float = 0;
 
     /* thresholds when using the -i2f flag */
     fpptr->n3ratio = 2.0;  /* minimum ratio of image noise sigma / q */
     fpptr->n3min = 6.;     /* minimum noise sigma. */
 
     fpptr->scale = DEF_HCOMP_SCALE;
     fpptr->smooth = DEF_HCOMP_SMOOTH;
     fpptr->rescale_noise = DEF_RESCALE_NOISE;
     fpptr->ntile[0] = (long) -1;    /* -1 means extent of axis */
 
     for (ii=1; ii < MAX_COMPRESS_DIM; ii++)
         fpptr->ntile[ii] = (long) 1;
 
     fpptr->to_stdout = 0;
     fpptr->listonly = 0;
     fpptr->clobber = 0;
     fpptr->delete_input = 0;
     fpptr->do_not_prompt = 0;
     fpptr->do_checksums = 1;
     fpptr->do_gzip_file = 0;
     fpptr->do_tables = 0;  /* this is intended for testing purposes  */
     fpptr->do_images = 1;  /* can be turned off with -tableonly switch */
     fpptr->test_all = 0;
     fpptr->verbose = 0;
 
     fpptr->prefix[0] = 0;
     fpptr->extname[0] = 0;
     fpptr->delete_suffix = 0;
     fpptr->outfile[0] = 0;
 
     fpptr->firstfile = 1;
 
     /* magic number for initialization check, boolean for preflight
      */
     fpptr->initialized = FP_INIT_MAGIC;
     fpptr->preflight_checked = 0;
     return(0);
 }
 /*--------------------------------------------------------------------------*/
 int fp_list (int argc, char *argv[], fpstate fpvar)
 {
     fitsfile *infptr;
     char    infits[SZ_STR], msg[SZ_STR];
     int hdunum, iarg, stat=0;
     LONGLONG sizell;
 
     if (fpvar.initialized != FP_INIT_MAGIC) {
         fp_msg ("Error: internal initialization error\n"); exit (-1);
     }
 
     for (iarg=fpvar.firstfile; iarg < argc; iarg++) {
         strncpy (infits, argv[iarg], SZ_STR-1);
         infits[SZ_STR-1]=0;
 
         if (strchr (infits, '[') || strchr (infits, ']')) {
             fp_msg ("Error: section/extension notation not supported: ");
             fp_msg (infits); fp_msg ("\n"); exit (-1);
         }
 
         if (fp_access (infits) != 0) {
             fp_msg ("Error: can't find or read input file "); fp_msg (infits);
             fp_msg ("\n"); fp_noop (); exit (-1);
         }
 
         fits_open_file (&infptr, infits, READONLY, &stat);
         if (stat) { fits_report_error (stderr, stat); exit (stat); }
 
         /* move to the end of file, to get the total size in bytes */
         fits_get_num_hdus (infptr, &hdunum, &stat);
         fits_movabs_hdu (infptr, hdunum, NULL, &stat);
         fits_get_hduaddrll(infptr, NULL, NULL, &sizell, &stat);
 
 
         if (stat) {
             fp_abort_output(infptr, NULL, stat);
         }
 
         snprintf (msg, SZ_STR,"# %s (", infits); fp_msg (msg);
 
 #if defined(_MSC_VER)
         /* Microsoft Visual C++ 6.0 uses '%I64d' syntax  for 8-byte integers */
         snprintf(msg, SZ_STR,"%I64d bytes)\n", sizell); fp_msg (msg);
 #elif (USE_LL_SUFFIX == 1)
         snprintf(msg, SZ_STR,"%lld bytes)\n", sizell); fp_msg (msg);
 #else
         snprintf(msg, SZ_STR,"%ld bytes)\n", sizell); fp_msg (msg);
 #endif
         fp_info_hdu (infptr);
 
         fits_close_file (infptr, &stat);
         if (stat) { fits_report_error (stderr, stat); exit (stat); }
     }
     return(0);
 }
 /*--------------------------------------------------------------------------*/
 int fp_info_hdu (fitsfile *infptr)
 {
     long    naxes[9] = {1, 1, 1, 1, 1, 1, 1, 1, 1};
     char    msg[SZ_STR], val[SZ_CARD], com[SZ_CARD];
     int     naxis=0, hdutype, bitpix, hdupos, stat=0, ii;
     unsigned long   datasum, hdusum;
 
     fits_movabs_hdu (infptr, 1, NULL, &stat);
     if (stat) {
         fp_abort_output(infptr, NULL, stat);
     }
 
     for (hdupos=1; ! stat; hdupos++) {
         fits_get_hdu_type (infptr, &hdutype, &stat);
         if (stat) {
             fp_abort_output(infptr, NULL, stat);
         }
 
         /* fits_get_hdu_type calls unknown extensions "IMAGE_HDU"
          * so consult XTENSION keyword itself
          */
         fits_read_keyword (infptr, "XTENSION", val, com, &stat);
         if (stat == KEY_NO_EXIST) {
             /* in primary HDU which by definition is an "image" */
             stat=0; /* clear for later error handling */
 
         } else if (stat) {
             fp_abort_output(infptr, NULL, stat);
 
         } else if (hdutype == IMAGE_HDU) {
             /* that is, if XTENSION != "IMAGE" AND != "BINTABLE" */
             if (strncmp (val+1, "IMAGE", 5) &&
                     strncmp (val+1, "BINTABLE", 5)) {
 
                 /* assign something other than any of these */
                 hdutype = IMAGE_HDU + ASCII_TBL + BINARY_TBL;
             }
         }
 
         fits_get_chksum(infptr, &datasum, &hdusum, &stat);
 
         if (hdutype == IMAGE_HDU) {
             snprintf (msg, SZ_STR,"  %d IMAGE", hdupos); fp_msg (msg);
             snprintf (msg, SZ_STR," SUMS=%lu/%lu", (unsigned long) (~((int) hdusum)), datasum); fp_msg (msg);
 
             fits_get_img_param (infptr, 9, &bitpix, &naxis, naxes, &stat);
 
             snprintf (msg, SZ_STR," BITPIX=%d", bitpix); fp_msg (msg);
 
             if (naxis == 0) {
                 snprintf (msg, SZ_STR," [no_pixels]"); fp_msg (msg);
             } else if (naxis == 1) {
                 snprintf (msg, SZ_STR," [%ld]", naxes[1]); fp_msg (msg);
             } else {
                 snprintf (msg, SZ_STR," [%ld", naxes[0]); fp_msg (msg);
                 for (ii=1; ii < naxis; ii++) {
                     snprintf (msg, SZ_STR,"x%ld", naxes[ii]); fp_msg (msg);
                 }
                 fp_msg ("]");
             }
 
             if (fits_is_compressed_image (infptr, &stat)) {
                 fits_read_keyword (infptr, "ZCMPTYPE", val, com, &stat);
 
                 /* allow for quote in keyword value */
                 if (! strncmp (val+1, "RICE_1", 6))
                     fp_msg (" tiled_rice\n");
                 else if (! strncmp (val+1, "GZIP_1", 6))
                     fp_msg (" tiled_gzip_1\n");
                 else if (! strncmp (val+1, "GZIP_2", 6))
                     fp_msg (" tiled_gzip_2\n");
                 else if (! strncmp (val+1, "PLIO_1", 6))
                     fp_msg (" tiled_plio\n");
                 else if (! strncmp (val+1, "HCOMPRESS_1", 11))
                     fp_msg (" tiled_hcompress\n");
                 else
                     fp_msg (" unknown\n");
 
             } else
                 fp_msg (" not_tiled\n");
 
         } else if (hdutype == ASCII_TBL) {
             snprintf (msg, SZ_STR,"  %d ASCII_TBL", hdupos); fp_msg (msg);
             snprintf (msg, SZ_STR," SUMS=%lu/%lu\n", (unsigned long) (~((int) hdusum)), datasum); fp_msg (msg);
 
         } else if (hdutype == BINARY_TBL) {
             snprintf (msg, SZ_STR,"  %d BINARY_TBL", hdupos); fp_msg (msg);
             snprintf (msg, SZ_STR," SUMS=%lu/%lu\n", (unsigned long) (~((int) hdusum)), datasum); fp_msg (msg);
 
         } else {
             snprintf (msg, SZ_STR,"  %d OTHER", hdupos); fp_msg (msg);
             snprintf (msg, SZ_STR," SUMS=%lu/%lu",   (unsigned long) (~((int) hdusum)), datasum); fp_msg (msg);
             snprintf (msg, SZ_STR," %s\n", val); fp_msg (msg);
         }
 
         fits_movrel_hdu (infptr, 1, NULL, &stat);
     }
     return(0);
 }
 
 /*--------------------------------------------------------------------------*/
 int fp_preflight (int argc, char *argv[], int unpack, fpstate *fpptr)
 {
     char    infits[SZ_STR], outfits[SZ_STR];
     int iarg, namelen, nfiles = 0;
 
     if (fpptr->initialized != FP_INIT_MAGIC) {
         fp_msg ("Error: internal initialization error\n"); exit (-1);
     }
 
     for (iarg=fpptr->firstfile; iarg < argc; iarg++) {
 
         outfits[0] = '\0';
 
         if (strlen(argv[iarg]) > SZ_STR - 4) {  /* allow for .fz or .gz suffix */
             fp_msg ("Error: input file name\n   "); fp_msg (argv[iarg]);
             fp_msg ("\n   is too long\n"); fp_noop (); exit (-1);
         }
 
         strncpy (infits, argv[iarg], SZ_STR-1);
         if (infits[0] == '-' && infits[1] != '\0') {
             /* don't interpret this as intending to read input file from stdin */
             fp_msg ("Error: invalid input file name\n   "); fp_msg (argv[iarg]);
             fp_msg ("\n"); fp_noop (); exit (-1);
         }
 
         if (strchr (infits, '[') || strchr (infits, ']')) {
             fp_msg ("Error: section/extension notation not supported: ");
             fp_msg (infits); fp_msg ("\n"); fp_noop (); exit (-1);
         }
 
         if (unpack) {
             /* ********** This section applies to funpack ************ */
 
             /* check that input file  exists */
             if (infits[0] != '-') {  /* if not reading from stdin stream */
                 if (fp_access (infits) != 0) {  /* if not, then check if */
                     strcat(infits, ".fz");       /* a .fz version exsits */
                     if (fp_access (infits) != 0) {
                         namelen = strlen(infits);
                         infits[namelen - 3] = '\0';  /* remove the .fz suffix */
                         fp_msg ("Error: can't find or read input file "); fp_msg (infits);
                         fp_msg ("\n"); fp_noop (); exit (-1);
                     }
                 } else {   /* make sure a .fz version of the same file doesn't exist */
                     namelen = strlen(infits);
                     strcat(infits, ".fz");
                     if (fp_access (infits) == 0) {
                         infits[namelen] = '\0';  /* remove the .fz suffix */
                         fp_msg ("Error: ambiguous input file name.  Which file should be unpacked?:\n  ");
                         fp_msg (infits); fp_msg ("\n  ");
                         fp_msg (infits); fp_msg (".fz\n");
                         fp_noop (); exit (-1);
                     } else {
                         infits[namelen] = '\0';  /* remove the .fz suffix */
                     }
                 }
             }
 
             /* if writing to stdout, then we are all done */
             if (fpptr->to_stdout) {
                 continue;
             }
 
             if (fpptr->outfile[0]) {  /* user specified output file name */
                 nfiles++;
                 if (nfiles > 1) {
                     fp_msg ("Error: cannot use same output file name for multiple files:\n   ");
                     fp_msg (fpptr->outfile);
                     fp_msg ("\n"); fp_noop (); exit (-1);
                 }
 
                 /* check that output file doesn't exist */
                 if (fp_access (fpptr->outfile) == 0) {
                     fp_msg ("Error: output file already exists:\n ");
                     fp_msg (fpptr->outfile);
                     fp_msg ("\n "); fp_noop (); exit (-1);
                 }
                 continue;
             }
 
             /* construct output file name to test */
             if (fpptr->prefix[0]) {
                 if (strlen(fpptr->prefix) + strlen(infits) > SZ_STR - 1) {
                     fp_msg ("Error: output file name for\n   "); fp_msg (infits);
                     fp_msg ("\n   is too long with the prefix\n"); fp_noop (); exit (-1);
                 }
                 strcat(outfits,fpptr->prefix);
             }
 
             /* construct output file name */
             if (infits[0] == '-') {
                 strcpy(outfits, "output.fits");
             } else {
                 strcpy(outfits, infits);
             }
 
             /* remove .gz suffix, if present (output is not gzipped) */
             namelen = strlen(outfits);
             if ( !strcmp(".gz", outfits + namelen - 3) ) {
                 outfits[namelen - 3] = '\0';
             }
 
             /* check for .fz suffix that is sometimes required */
             /* and remove it if present */
             if (infits[0] != '-') {  /* if not reading from stdin stream */
                 namelen = strlen(outfits);
                 if ( !strcmp(".fz", outfits + namelen - 3) ) { /* suffix is present */
                     outfits[namelen - 3] = '\0';
                 } else if (fpptr->delete_suffix) {  /* required suffix is missing */
                     fp_msg ("Error: input compressed file "); fp_msg (infits);
                     fp_msg ("\n does not have the default .fz suffix.\n");
                     fp_noop (); exit (-1);
                 }
             }
 
             /* if infits != outfits, make sure outfits doesn't already exist */
             if (strcmp(infits, outfits)) {
                 if (fp_access (outfits) == 0) {
                     fp_msg ("Error: output file already exists:\n "); fp_msg (outfits);
                     fp_msg ("\n "); fp_noop (); exit (-1);
                 }
             }
 
             /* if gzipping the output, make sure .gz file doesn't exist */
             if (fpptr->do_gzip_file) {
                 if (strlen(outfits)+3 > SZ_STR-1)
                 {
                     fp_msg ("Error: output file name too long:\n "); fp_msg (outfits);
                     fp_msg ("\n "); fp_noop (); exit (-1);
                 }
                 strcat(outfits, ".gz");
                 if (fp_access (outfits) == 0) {
                     fp_msg ("Error: output file already exists:\n "); fp_msg (outfits);
                     fp_msg ("\n "); fp_noop (); exit (-1);
                 }
                 namelen = strlen(outfits);
                 outfits[namelen - 3] = '\0';  /* remove the .gz suffix again */
             }
         } else {
             /* ********** This section applies to fpack ************ */
 
             /* check that input file  exists */
             if (infits[0] != '-') {  /* if not reading from stdin stream */
                 if (fp_access (infits) != 0) {  /* if not, then check if */
                     if (strlen(infits)+3 > SZ_STR-1)
                     {
                         fp_msg ("Error: input file name too long:\n "); fp_msg (infits);
                         fp_msg ("\n "); fp_noop (); exit (-1);
                     }
                     strcat(infits, ".gz");     /* a gzipped version exsits */
                     if (fp_access (infits) != 0) {
                         namelen = strlen(infits);
                         infits[namelen - 3] = '\0';  /* remove the .gz suffix */
                         fp_msg ("Error: can't find or read input file "); fp_msg (infits);
                         fp_msg ("\n"); fp_noop (); exit (-1);
                     }
                 }
             }
 
             /* make sure the file to pack does not already have a .fz suffix */
             namelen = strlen(infits);
             if ( !strcmp(".fz", infits + namelen - 3) ) {
                 fp_msg ("Error: fpack input file already has '.fz' suffix\n" ); fp_msg (infits);
                 fp_msg ("\n"); fp_noop (); exit (-1);
             }
 
             /* if writing to stdout, or just testing the files, then we are all done */
             if (fpptr->to_stdout || fpptr->test_all) {
                 continue;
             }
 
             /* construct output file name */
             if (infits[0] == '-') {
                 strcpy(outfits, "input.fits");
             } else {
                 strcpy(outfits, infits);
             }
 
             /* remove .gz suffix, if present (output is not gzipped) */
             namelen = strlen(outfits);
             if ( !strcmp(".gz", outfits + namelen - 3) ) {
                 outfits[namelen - 3] = '\0';
             }
 
             /* remove .imh suffix (IRAF format image), and replace with .fits */
             namelen = strlen(outfits);
             if ( !strcmp(".imh", outfits + namelen - 4) ) {
                 outfits[namelen - 4] = '\0';
                 strcat(outfits, ".fits");
             }
 
             /* If not clobbering the input file, add .fz suffix to output name */
             if (! fpptr->clobber)
                 strcat(outfits, ".fz");
 
             /* if infits != outfits, make sure outfits doesn't already exist */
             if (strcmp(infits, outfits)) {
                 if (fp_access (outfits) == 0) {
                     fp_msg ("Error: output file already exists:\n "); fp_msg (outfits);
                     fp_msg ("\n "); fp_noop (); exit (-1);
                 }
             }
         }   /* end of fpack section */
     }
 
     fpptr->preflight_checked++;
     return(0);
 }
 
 /*--------------------------------------------------------------------------*/
 /* must run fp_preflight() before fp_loop()
  */
 int fp_loop (int argc, char *argv[], int unpack, char *output_filename, fpstate fpvar)
 {
     char    infits[SZ_STR], outfits[SZ_STR];
     char    temp[SZ_STR], answer[30];
     char    valchar[]="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz.#()+,-_@[]/^{}";
     int ichar=0, outlen=0, iarg, islossless, namelen, iraf_infile = 0, status = 0, ifail;
 
     if (fpvar.initialized != FP_INIT_MAGIC) {
         fp_msg ("Error: internal initialization error\n"); exit (-1);
     } else if (! fpvar.preflight_checked) {
         fp_msg ("Error: internal preflight error\n"); exit (-1);
     }
 
     if (fpvar.test_all && fpvar.outfile[0]) {
         outreport = fopen(fpvar.outfile, "w");
         fprintf(outreport," Filename Extension BITPIX NAXIS1 NAXIS2 Size N_nulls Minval Maxval Mean Sigm Noise1 Noise2 Noise3 Noise5 T_whole T_rowbyrow ");
         fprintf(outreport,"[Comp_ratio, Pack_cpu, Unpack_cpu, Lossless readtimes] (repeated for Rice, Hcompress, and GZIP)\n");
     }
 
 
     tempfilename[0] = '\0';
     tempfilename2[0] = '\0';
     tempfilename3[0] = '\0';
 
     /* set up signal handler to delete temporary file on abort */
 #ifdef SIGINT
     if (signal(SIGINT, SIG_IGN) != SIG_IGN) {
         (void) signal(SIGINT,  abort_fpack);
     }
 #endif
 
 #ifdef SIGTERM
     if (signal(SIGTERM, SIG_IGN) != SIG_IGN) {
         (void) signal(SIGTERM,  abort_fpack);
     }
 #endif
 
 #ifdef SIGHUP
     if (signal(SIGHUP, SIG_IGN) != SIG_IGN) {
         (void) signal(SIGHUP,  abort_fpack);
     }
 #endif
 
     for (iarg=fpvar.firstfile; iarg < argc; iarg++) {
 
         temp[0] = '\0';
         outfits[0] = '\0';
         islossless = 1;
 
         strncpy (infits, argv[iarg], SZ_STR - 1);
         infits[SZ_STR-1]=0;
 
         if (unpack) {
             /* ********** This section applies to funpack ************ */
 
             /* find input file */
             if (infits[0] != '-') {  /* if not reading from stdin stream */
                 if (fp_access (infits) != 0) {  /* if not, then */
                     strcat(infits, ".fz");       /* a .fz version must exsit */
                 }
             }
 
             if (fpvar.to_stdout) {
                 strcpy(outfits, "-");
 
             } else if (fpvar.outfile[0]) {  /* user specified output file name */
                 strcpy(outfits, fpvar.outfile);
 
             } else {
                 /* construct output file name */
                 if (fpvar.prefix[0]) {
                     strcat(outfits,fpvar.prefix);
                 }
 
                 /* construct output file name */
                 if (infits[0] == '-') {
                     strcpy(outfits, "output.fits");
                 } else {
                     /*strcpy(outfits, infits);*/
                     strcpy(outfits, output_filename);
                 }
 
                 /* remove .gz suffix, if present (output is not gzipped) */
                 namelen = strlen(outfits);
                 if ( !strcmp(".gz", outfits + namelen - 3) ) {
                     outfits[namelen - 3] = '\0';
                 }
 
                 /* check for .fz suffix that is sometimes required */
                 /* and remove it if present */
                 namelen = strlen(outfits);
                 if ( !strcmp(".fz", outfits + namelen - 3) ) { /* suffix is present */
                     outfits[namelen - 3] = '\0';
                 }
             }
 
         } else {
             /* ********** This section applies to fpack ************ */
 
             if (fpvar.to_stdout) {
                 strcpy(outfits, "-");
             } else if (! fpvar.test_all) {
 
                 /* construct output file name */
                 if (infits[0] == '-') {
                     strcpy(outfits, "input.fits");
                 } else {
                     strcpy(outfits, output_filename);
                 }
 
                 /* remove .gz suffix, if present (output is not gzipped) */
                 namelen = strlen(outfits);
                 if ( !strcmp(".gz", outfits + namelen - 3) ) {
                     outfits[namelen - 3] = '\0';
                 }
 
                 /* remove .imh suffix (IRAF format image), and replace with .fits */
                 namelen = strlen(outfits);
                 if ( !strcmp(".imh", outfits + namelen - 4) ) {
                     outfits[namelen - 4] = '\0';
                     strcat(outfits, ".fits");
                     iraf_infile = 1;  /* this is an IRAF format input file */
                     /* change the output name to "NAME.fits.fz" */
                 }
 
                 /* If not clobbering the input file, add .fz suffix to output name */
                 if (! fpvar.clobber)
                     strcat(outfits, ".fz");
             }
         }
 
         strncpy(temp, outfits, SZ_STR-1);
         temp[SZ_STR-1]=0;
 
         if (infits[0] != '-') {  /* if not reading from stdin stream */
             if (!strcmp(infits, outfits) ) {  /* are input and output names the same? */
 
                 /* clobber the input file with the output file with the same name */
                 if (! fpvar.clobber) {
                     fp_msg ("\nError: must use -F flag to clobber input file.\n");
                     exit (-1);
                 }
 
                 /* create temporary file name in the output directory (same as input directory)*/
                 fp_tmpnam("Tmp1", infits, outfits);
 
                 strcpy(tempfilename, outfits);  /* store temp file name, in case of abort */
             }
         }
 
 
         /* *************** now do the real work ********************* */
 
         if (fpvar.verbose && ! fpvar.to_stdout)
             printf("%s ", infits);
 
         if (fpvar.test_all) {   /* compare all the algorithms */
 
             /* create 2 temporary file names, in the CWD */
             fp_tmpnam("Tmpfile1", "", tempfilename);
             fp_tmpnam("Tmpfile2", "", tempfilename2);
 
             fp_test (infits, tempfilename, tempfilename2, fpvar);
 
             remove(tempfilename);
             tempfilename[0] = '\0';   /* clear the temp file name */
             remove(tempfilename2);
             tempfilename2[0] = '\0';
             continue;
 
         } else if (unpack) {
             if (fpvar.to_stdout) {
                 /* unpack the input file to the stdout stream */
                 fp_unpack (infits, outfits, fpvar);
             } else {
                 /* unpack to temporary file, so other tasks can't open it until it is renamed */
 
                 /* create  temporary file name, in the output directory */
                 fp_tmpnam("Tmp2", outfits, tempfilename2);
 
                 /* unpack the input file to the temporary file */
                 fp_unpack (infits, tempfilename2, fpvar);
 
                 /* rename the temporary file to it's real name */
                 ifail = rename(tempfilename2, outfits);
                 if (ifail) {
                     fp_msg("Failed to rename temporary file name:\n  ");
                     fp_msg(tempfilename2);
                     fp_msg(" -> ");
                     fp_msg(outfits);
                     fp_msg("\n");
                     exit (-1);
                 } else {
                     tempfilename2[0] = '\0';  /* clear temporary file name */
                 }
             }
         }  else {
             fp_pack (infits, outfits, fpvar, &islossless);
         }
 
         if (fpvar.to_stdout) {
             continue;
         }
 
         /* ********** clobber and/or delete files, if needed ************** */
 
         if (!strcmp(infits, temp) && fpvar.clobber ) {
 
             if (!islossless && ! fpvar.do_not_prompt) {
                 fp_msg ("\nFile ");
                 fp_msg (infits);
                 fp_msg ("\nwas compressed with a LOSSY method.  Overwrite the\n");
                 fp_msg ("original file with the compressed version? (Y/N) ");
                 if (fgets(answer, 29, stdin) && answer[0] != 'Y' && answer[0] != 'y') {
                     fp_msg ("\noriginal file NOT overwritten!\n");
                     remove(outfits);
                     continue;
                 }
             }
 
             if (iraf_infile) {  /* special case of deleting an IRAF format header and pixel file */
                 if (fits_delete_iraf_file(infits, &status)) {
                     fp_msg("\nError deleting IRAF .imh and .pix files.\n");
                     fp_msg(infits); fp_msg ("\n"); exit (-1);
                 }
             }
 
 #if defined(unix) || defined(__unix__)  || defined(__unix)
             /* rename clobbers input on Unix platforms */
             if (rename (outfits, temp) != 0) {
                 fp_msg ("\nError renaming tmp file to ");
                 fp_msg (temp); fp_msg ("\n"); exit (-1);
             }
 #else
             /* rename DOES NOT clobber existing files on Windows platforms */
             /* so explicitly remove any existing file before renaming the file */
             remove(temp);
             if (rename (outfits, temp) != 0) {
                 fp_msg ("\nError renaming tmp file to ");
                 fp_msg (temp); fp_msg ("\n"); exit (-1);
             }
 #endif
 
             tempfilename[0] = '\0';  /* clear temporary file name */
             strcpy(outfits, temp);
 
         } else if (fpvar.clobber || fpvar.delete_input) {      /* delete the input file */
             if (!islossless && !fpvar.do_not_prompt) {  /* user did not turn off delete prompt */
                 fp_msg ("\nFile ");
                 fp_msg (infits);
                 fp_msg ("\nwas compressed with a LOSSY method.  \n");
                 fp_msg ("Delete the original file? (Y/N) ");
                 if (fgets(answer, 29, stdin) && answer[0] != 'Y' && answer[0] != 'y') {  /* user abort */
                     fp_msg ("\noriginal file NOT deleted!\n");
                 } else {
                     if (iraf_infile) {  /* special case of deleting an IRAF format header and pixel file */
                         if (fits_delete_iraf_file(infits, &status)) {
                             fp_msg("\nError deleting IRAF .imh and .pix files.\n");
                             fp_msg(infits); fp_msg ("\n"); exit (-1);
                         }
                     }  else if (remove(infits) != 0) {  /* normal case of deleting input FITS file */
                         fp_msg ("\nError deleting input file ");
                         fp_msg (infits); fp_msg ("\n"); exit (-1);
                     }
                 }
             } else {   /* user said don't prompt, so just delete the input file */
                 if (iraf_infile) {  /* special case of deleting an IRAF format header and pixel file */
                     if (fits_delete_iraf_file(infits, &status)) {
                         fp_msg("\nError deleting IRAF .imh and .pix files.\n");
                         fp_msg(infits); fp_msg ("\n"); exit (-1);
                     }
                 }  else if (remove(infits) != 0) {  /* normal case of deleting input FITS file */
                     fp_msg ("\nError deleting input file ");
                     fp_msg (infits); fp_msg ("\n"); exit (-1);
                 }
             }
         }
         iraf_infile = 0;
 
         if (fpvar.do_gzip_file) {       /* gzip the output file */
             strcpy(temp, "gzip -1 ");
             outlen = strlen(outfits);
             if (outlen + 8 > SZ_STR-1)
             {
                 fp_msg("\nError: Output file name is too long.\n");
                 exit(-1);
             }
             for (ichar=0; ichar < outlen; ++ichar)
             {
                 if (!strchr(valchar, outfits[ichar]))
                 {
                     fp_msg("\n Error: Invalid characters in output file name.\n");
                     exit(-1);
                 }
             }
             strcat(temp,outfits);
             int rc = system(temp);
             UNUSED(rc);
             strcat(outfits, ".gz");    /* only possibible with funpack */
         }
 
         if (fpvar.verbose && ! fpvar.to_stdout)
             printf("-> %s\n", outfits);
 
     }
 
     if (fpvar.test_all && fpvar.outfile[0])
         fclose(outreport);
     return(0);
 }
 
 /*--------------------------------------------------------------------------*/
 /* fp_pack assumes the output file does not exist (checked by preflight)
  */
 int fp_pack (char *infits, char *outfits, fpstate fpvar, int *islossless)
 {
     fitsfile *infptr, *outfptr;
     int stat=0;
 
     fits_open_file (&infptr, infits, READONLY, &stat);
     if (stat)
     {
         fits_report_error (stderr, stat);
         return -1;
     }
 
     fits_create_file (&outfptr, outfits, &stat);
     if (stat)
     {
         fp_abort_output(infptr, outfptr, stat);
         return -1;
     }
 
     while (! stat) {
 
         /*  LOOP OVER EACH HDU */
 
         fits_set_lossy_int (outfptr, fpvar.int_to_float, &stat);
         fits_set_compression_type (outfptr, fpvar.comptype, &stat);
         fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
 
         if (fpvar.no_dither)
             fits_set_quantize_method(outfptr, -1, &stat);
         else
             fits_set_quantize_method(outfptr, fpvar.dither_method, &stat);
 
         fits_set_quantize_level (outfptr, fpvar.quantize_level, &stat);
         fits_set_dither_offset(outfptr, fpvar.dither_offset, &stat);
         fits_set_hcomp_scale (outfptr, fpvar.scale, &stat);
         fits_set_hcomp_smooth (outfptr, fpvar.smooth, &stat);
 
         fp_pack_hdu (infptr, outfptr, fpvar, islossless, &stat);
 
         if (fpvar.do_checksums) {
             fits_write_chksum (outfptr, &stat);
         }
 
         fits_movrel_hdu (infptr, 1, NULL, &stat);
     }
 
     if (stat == END_OF_FILE) stat = 0;
 
     /* set checksum for case of newly created primary HDU    */
 
     if (fpvar.do_checksums) {
         fits_movabs_hdu (outfptr, 1, NULL, &stat);
         fits_write_chksum (outfptr, &stat);
     }
 
     if (stat) {
         fp_abort_output(infptr, outfptr, stat);
     }
 
     fits_close_file (outfptr, &stat);
     fits_close_file (infptr, &stat);
 
     return(0);
 }
 
 /*--------------------------------------------------------------------------*/
 
 int fp_pack_fits_to_fits (fitsfile *infptr, fitsfile **outfits, fpstate fpvar, int *islossless)
 {
     fitsfile *outfptr;
     int stat=0;
     size_t outbufferSize = 2880;
     void *outbuffer = (char *)malloc(outbufferSize);
 
     fits_create_memfile(&outfptr, &outbuffer, &outbufferSize, 2880, realloc, &stat);
     if (stat)
     {
         fp_abort_output(infptr, outfptr, stat);
         return -1;
     }
 
     while (! stat) {
 
         /*  LOOP OVER EACH HDU */
 
         fits_set_lossy_int (outfptr, fpvar.int_to_float, &stat);
         fits_set_compression_type (outfptr, fpvar.comptype, &stat);
         fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
 
         if (fpvar.no_dither)
             fits_set_quantize_method(outfptr, -1, &stat);
         else
             fits_set_quantize_method(outfptr, fpvar.dither_method, &stat);
 
         fits_set_quantize_level (outfptr, fpvar.quantize_level, &stat);
         fits_set_dither_offset(outfptr, fpvar.dither_offset, &stat);
         fits_set_hcomp_scale (outfptr, fpvar.scale, &stat);
         fits_set_hcomp_smooth (outfptr, fpvar.smooth, &stat);
 
         fp_pack_hdu (infptr, outfptr, fpvar, islossless, &stat);
 
         if (fpvar.do_checksums) {
             fits_write_chksum (outfptr, &stat);
         }
 
         fits_movrel_hdu (infptr, 1, NULL, &stat);
     }
 
     if (stat == END_OF_FILE) stat = 0;
 
     /* set checksum for case of newly created primary HDU    */
 
     if (fpvar.do_checksums) {
         fits_movabs_hdu (outfptr, 1, NULL, &stat);
         fits_write_chksum (outfptr, &stat);
     }
 
     if (stat) {
         fp_abort_output(infptr, outfptr, stat);
     }
 
     fits_close_file (infptr, &stat);
     *outfits = outfptr;
 
     return(0);
 }
 
 /*--------------------------------------------------------------------------*/
 /* fp_unpack assumes the output file does not exist
  */
 int fp_unpack (char *infits, char *outfits, fpstate fpvar)
 {
     fitsfile *infptr, *outfptr;
     int stat=0, hdutype, extnum, single = 0;
     char *loc, *hduloc = 0, hduname[SZ_STR] = { 0 };
 
     fits_open_file (&infptr, infits, READONLY, &stat);
     fits_create_file (&outfptr, outfits, &stat);
 
     if (stat) {
         fp_abort_output(infptr, outfptr, stat);
     }
 
     if (fpvar.extname[0]) {  /* unpack a list of HDUs? */
 
         /* move to the first HDU in the list */
         hduloc = fpvar.extname;
         loc = strchr(hduloc, ','); /* look for 'comma' delimiter between names */
 
         if (loc)
             *loc = '\0';  /* terminate the first name in the string */
 
         strcpy(hduname, hduloc);  /* copy the first name into temporary string */
 
         if (loc)
             hduloc = loc + 1;  /* advance to the beginning of the next name, if any */
         else {
             hduloc += strlen(hduname);  /* end of the list */
             single = 1;  /* only 1 HDU is being unpacked */
         }
 
         if (isdigit( (int) hduname[0]) ) {
             extnum = strtol(hduname, &loc, 10); /* read the string as an integer */
 
             /* check for junk following the integer */
             if (*loc == '\0' )  /* no junk, so move to this HDU number (+1) */
             {
                 fits_movabs_hdu(infptr, extnum + 1, &hdutype, &stat);  /* move to HDU number */
                 if (hdutype != IMAGE_HDU)
                     stat = NOT_IMAGE;
 
             } else {  /* the string is not an integer, so must be the column name */
                 hdutype = IMAGE_HDU;
                 fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
             }
         }
         else
         {
             /* move to the named image extension */
             hdutype = IMAGE_HDU;
             fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
         }
     }
 
     if (stat) {
         fp_msg ("Unable to find and move to extension '");
         fp_msg(hduname);
         fp_msg("'\n");
         fp_abort_output(infptr, outfptr, stat);
     }
 
     while (! stat) {
 
         if (single)
             stat = -1;  /* special status flag to force output primary array */
 
         fp_unpack_hdu (infptr, outfptr, fpvar, &stat);
 
         if (fpvar.do_checksums) {
             fits_write_chksum (outfptr, &stat);
         }
 
         /* move to the next HDU */
         if (fpvar.extname[0]) {  /* unpack a list of HDUs? */
 
             if (!(*hduloc)) {
                 stat = END_OF_FILE;  /* we reached the end of the list */
             } else {
                 /* parse the next HDU name and move to it */
                 loc = strchr(hduloc, ',');
 
                 if (loc)         /* look for 'comma' delimiter between names */
                     *loc = '\0';  /* terminate the first name in the string */
 
                 strcpy(hduname, hduloc);  /* copy the next name into temporary string */
 
                 if (loc)
                     hduloc = loc + 1;  /* advance to the beginning of the next name, if any */
                 else
                     *hduloc = '\0';  /* end of the list */
 
                 if (isdigit( (int) hduname[0]) ) {
                     extnum = strtol(hduname, &loc, 10); /* read the string as an integer */
 
                     /* check for junk following the integer */
                     if (*loc == '\0' )   /* no junk, so move to this HDU number (+1) */
                     {
                         fits_movabs_hdu(infptr, extnum + 1, &hdutype, &stat);  /* move to HDU number */
                         if (hdutype != IMAGE_HDU)
                             stat = NOT_IMAGE;
 
                     } else {  /* the string is not an integer, so must be the column name */
                         hdutype = IMAGE_HDU;
                         fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
                     }
 
                 } else {
                     /* move to the named image extension */
                     hdutype = IMAGE_HDU;
                     fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
                 }
 
                 if (stat) {
                     fp_msg ("Unable to find and move to extension '");
                     fp_msg(hduname);
                     fp_msg("'\n");
                 }
             }
         } else {
             /* increment to the next HDU */
             fits_movrel_hdu (infptr, 1, NULL, &stat);
         }
     }
 
     if (stat == END_OF_FILE) stat = 0;
 
     /* set checksum for case of newly created primary HDU
          */
     if (fpvar.do_checksums) {
         fits_movabs_hdu (outfptr, 1, NULL, &stat);
         fits_write_chksum (outfptr, &stat);
     }
 
 
     if (stat) {
         fp_abort_output(infptr, outfptr, stat);
     }
 
     fits_close_file (outfptr, &stat);
     fits_close_file (infptr, &stat);
 
     return(0);
 }
 
 /*--------------------------------------------------------------------------*/
 /* fp_unpack assumes the output file does not exist
  */
 int fp_unpack_file_to_fits (char *infits, fitsfile **outfits, fpstate fpvar)
 {
     fitsfile *infptr, *outfptr;
     int stat=0, hdutype, extnum, single = 0;
     char *loc, *hduloc = 0, hduname[SZ_STR] = { 0 };
     size_t outbufferSize = 2880;
     void *outbuffer = (char *)malloc(outbufferSize);
 
     fits_open_file (&infptr, infits, READONLY, &stat);
     fits_create_memfile(&outfptr, &outbuffer, &outbufferSize, 2880, realloc, &stat);
 
     if (stat) {
         fp_abort_output(infptr, outfptr, stat);
     }
 
     if (fpvar.extname[0]) {  /* unpack a list of HDUs? */
 
         /* move to the first HDU in the list */
         hduloc = fpvar.extname;
         loc = strchr(hduloc, ','); /* look for 'comma' delimiter between names */
 
         if (loc)
             *loc = '\0';  /* terminate the first name in the string */
 
         strcpy(hduname, hduloc);  /* copy the first name into temporary string */
 
         if (loc)
             hduloc = loc + 1;  /* advance to the beginning of the next name, if any */
         else {
             hduloc += strlen(hduname);  /* end of the list */
             single = 1;  /* only 1 HDU is being unpacked */
         }
 
         if (isdigit( (int) hduname[0]) ) {
             extnum = strtol(hduname, &loc, 10); /* read the string as an integer */
 
             /* check for junk following the integer */
             if (*loc == '\0' )  /* no junk, so move to this HDU number (+1) */
             {
                 fits_movabs_hdu(infptr, extnum + 1, &hdutype, &stat);  /* move to HDU number */
                 if (hdutype != IMAGE_HDU)
                     stat = NOT_IMAGE;
 
             } else {  /* the string is not an integer, so must be the column name */
                 hdutype = IMAGE_HDU;
                 fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
             }
         }
         else
         {
             /* move to the named image extension */
             hdutype = IMAGE_HDU;
             fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
         }
     }
 
     if (stat) {
         fp_msg ("Unable to find and move to extension '");
         fp_msg(hduname);
         fp_msg("'\n");
         fp_abort_output(infptr, outfptr, stat);
     }
 
     while (! stat) {
 
         if (single)
             stat = -1;  /* special status flag to force output primary array */
 
         fp_unpack_hdu (infptr, outfptr, fpvar, &stat);
 
         if (fpvar.do_checksums) {
             fits_write_chksum (outfptr, &stat);
         }
 
         /* move to the next HDU */
         if (fpvar.extname[0]) {  /* unpack a list of HDUs? */
 
             if (!(*hduloc)) {
                 stat = END_OF_FILE;  /* we reached the end of the list */
             } else {
                 /* parse the next HDU name and move to it */
                 loc = strchr(hduloc, ',');
 
                 if (loc)         /* look for 'comma' delimiter between names */
                     *loc = '\0';  /* terminate the first name in the string */
 
                 strcpy(hduname, hduloc);  /* copy the next name into temporary string */
 
                 if (loc)
                     hduloc = loc + 1;  /* advance to the beginning of the next name, if any */
                 else
                     *hduloc = '\0';  /* end of the list */
 
                 if (isdigit( (int) hduname[0]) ) {
                     extnum = strtol(hduname, &loc, 10); /* read the string as an integer */
 
                     /* check for junk following the integer */
                     if (*loc == '\0' )   /* no junk, so move to this HDU number (+1) */
                     {
                         fits_movabs_hdu(infptr, extnum + 1, &hdutype, &stat);  /* move to HDU number */
                         if (hdutype != IMAGE_HDU)
                             stat = NOT_IMAGE;
 
                     } else {  /* the string is not an integer, so must be the column name */
                         hdutype = IMAGE_HDU;
                         fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
                     }
 
                 } else {
                     /* move to the named image extension */
                     hdutype = IMAGE_HDU;
                     fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
                 }
 
                 if (stat) {
                     fp_msg ("Unable to find and move to extension '");
                     fp_msg(hduname);
                     fp_msg("'\n");
                 }
             }
         } else {
             /* increment to the next HDU */
             fits_movrel_hdu (infptr, 1, NULL, &stat);
         }
     }
 
     if (stat == END_OF_FILE) stat = 0;
 
     /* set checksum for case of newly created primary HDU
          */
     if (fpvar.do_checksums) {
         fits_movabs_hdu (outfptr, 1, NULL, &stat);
         fits_write_chksum (outfptr, &stat);
     }
 
 
     if (stat) {
         fp_abort_output(infptr, outfptr, stat);
     }
 
     fits_close_file (infptr, &stat);
     *outfits = outfptr;
 
     return(0);
 }
 
 /*--------------------------------------------------------------------------*/
 /* fp_unpack_memroy is like fp_unpack but unpacks in RAM.
  */
 int fp_unpack_data_to_data (const char *inputBuffer, size_t inputBufferSize, unsigned char **outputBuffer,
                             size_t *outputBufferSize, fpstate fpvar)
 {
     fitsfile *infptr, *outfptr;
     int stat=0, hdutype, extnum, single = 0;
     char *loc, *hduloc = 0, hduname[SZ_STR] = { 0 };
 
     fits_open_memfile(&infptr, "", READONLY, &inputBuffer, &inputBufferSize, 2880, NULL, &stat);
     fits_create_memfile(&outfptr, outputBuffer, outputBufferSize, 100000, realloc, &stat);
 
     if (stat) {
         fp_abort_output(infptr, outfptr, stat);
     }
 
     if (fpvar.extname[0]) {  /* unpack a list of HDUs? */
 
         /* move to the first HDU in the list */
         hduloc = fpvar.extname;
         loc = strchr(hduloc, ','); /* look for 'comma' delimiter between names */
 
         if (loc)
             *loc = '\0';  /* terminate the first name in the string */
 
         strcpy(hduname, hduloc);  /* copy the first name into temporary string */
 
         if (loc)
             hduloc = loc + 1;  /* advance to the beginning of the next name, if any */
         else {
             hduloc += strlen(hduname);  /* end of the list */
             single = 1;  /* only 1 HDU is being unpacked */
         }
 
         if (isdigit( (int) hduname[0]) ) {
             extnum = strtol(hduname, &loc, 10); /* read the string as an integer */
 
             /* check for junk following the integer */
             if (*loc == '\0' )  /* no junk, so move to this HDU number (+1) */
             {
                 fits_movabs_hdu(infptr, extnum + 1, &hdutype, &stat);  /* move to HDU number */
                 if (hdutype != IMAGE_HDU)
                     stat = NOT_IMAGE;
 
             } else {  /* the string is not an integer, so must be the column name */
                 hdutype = IMAGE_HDU;
                 fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
             }
         }
         else
         {
             /* move to the named image extension */
             hdutype = IMAGE_HDU;
             fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
         }
     }
 
     if (stat) {
         fp_msg ("Unable to find and move to extension '");
         fp_msg(hduname);
         fp_msg("'\n");
         fp_abort_output(infptr, outfptr, stat);
     }
 
     while (! stat) {
 
         if (single)
             stat = -1;  /* special status flag to force output primary array */
 
         fp_unpack_hdu (infptr, outfptr, fpvar, &stat);
 
         if (fpvar.do_checksums) {
             fits_write_chksum (outfptr, &stat);
         }
 
         /* move to the next HDU */
         if (fpvar.extname[0]) {  /* unpack a list of HDUs? */
 
             if (!(*hduloc)) {
                 stat = END_OF_FILE;  /* we reached the end of the list */
             } else {
                 /* parse the next HDU name and move to it */
                 loc = strchr(hduloc, ',');
 
                 if (loc)         /* look for 'comma' delimiter between names */
                     *loc = '\0';  /* terminate the first name in the string */
 
                 strcpy(hduname, hduloc);  /* copy the next name into temporary string */
 
                 if (loc)
                     hduloc = loc + 1;  /* advance to the beginning of the next name, if any */
                 else
                     *hduloc = '\0';  /* end of the list */
 
                 if (isdigit( (int) hduname[0]) ) {
                     extnum = strtol(hduname, &loc, 10); /* read the string as an integer */
 
                     /* check for junk following the integer */
                     if (*loc == '\0' )   /* no junk, so move to this HDU number (+1) */
                     {
                         fits_movabs_hdu(infptr, extnum + 1, &hdutype, &stat);  /* move to HDU number */
                         if (hdutype != IMAGE_HDU)
                             stat = NOT_IMAGE;
 
                     } else {  /* the string is not an integer, so must be the column name */
                         hdutype = IMAGE_HDU;
                         fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
                     }
 
                 } else {
                     /* move to the named image extension */
                     hdutype = IMAGE_HDU;
                     fits_movnam_hdu(infptr, hdutype, hduname, 0, &stat);
                 }
 
                 if (stat) {
                     fp_msg ("Unable to find and move to extension '");
                     fp_msg(hduname);
                     fp_msg("'\n");
                 }
             }
         } else {
             /* increment to the next HDU */
             fits_movrel_hdu (infptr, 1, NULL, &stat);
         }
     }
 
     if (stat == END_OF_FILE) stat = 0;
 
     /* set checksum for case of newly created primary HDU
          */
     if (fpvar.do_checksums) {
         fits_movabs_hdu (outfptr, 1, NULL, &stat);
         fits_write_chksum (outfptr, &stat);
     }
 
     if (stat) {
         fp_abort_output(infptr, outfptr, stat);
     }
 
     fits_close_file (outfptr, &stat);
     fits_close_file (infptr, &stat);
     return(0);
 }
 
 /*--------------------------------------------------------------------------*/
 /* fp_test assumes the output files do not exist
  */
 int fp_test (char *infits, char *outfits, char *outfits2, fpstate fpvar)
 {
     fitsfile *inputfptr, *infptr, *outfptr, *outfptr2, *tempfile;
 
     long    naxes[9] = {1, 1, 1, 1, 1, 1, 1, 1, 1};
     int stat=0, totpix=0, naxis=0, ii, hdutype, bitpix = 0, extnum = 0, len;
     int     tstatus = 0, hdunum, rescale_flag, bpix = 8, ncols;
     char    dtype[8], dimen[100];
     double  bscale, rescale, noisemin;
     long headstart, datastart, dataend;
     float origdata = 0., whole_cpu, whole_elapse, row_elapse, row_cpu, xbits;
 
     LONGLONG nrows;
     /* structure to hold image statistics (defined in fpack.h) */
     imgstats imagestats = { 0 };
 
     fits_open_file (&inputfptr, infits, READONLY, &stat);
     fits_create_file (&outfptr, outfits, &stat);
     fits_create_file (&outfptr2, outfits2, &stat);
 
     if (stat) { fits_report_error (stderr, stat); exit (stat); }
 
     while (! stat) {
 
         /*  LOOP OVER EACH HDU */
         rescale_flag = 0;
         fits_get_hdu_type (inputfptr, &hdutype, &stat);
 
         if (hdutype == IMAGE_HDU) {
             fits_get_img_param (inputfptr, 9, &bitpix, &naxis, naxes, &stat);
             for (totpix=1, ii=0; ii < 9; ii++) totpix *= naxes[ii];
         }
 
         if (!fits_is_compressed_image (inputfptr,  &stat) && hdutype == IMAGE_HDU &&
                 naxis != 0 && totpix != 0 && fpvar.do_images) {
 
             /* rescale a scaled integer image to reduce noise? */
             if (fpvar.rescale_noise != 0. && bitpix > 0 && bitpix < LONGLONG_IMG) {
 
                 tstatus = 0;
                 fits_read_key(inputfptr, TDOUBLE, "BSCALE", &bscale, 0, &tstatus);
 
                 if (tstatus == 0 && bscale != 1.0) {  /* image must be scaled */
 
                     if (bitpix == LONG_IMG)
                         fp_i4stat(inputfptr, naxis, naxes, &imagestats, &stat);
                     else
                         fp_i2stat(inputfptr, naxis, naxes, &imagestats, &stat);
 
                     /* use the minimum of the MAD 2nd, 3rd, and 5th order noise estimates */
                     noisemin = imagestats.noise3;
                     if (imagestats.noise2 != 0. && imagestats.noise2 < noisemin) noisemin = imagestats.noise2;
                     if (imagestats.noise5 != 0. && imagestats.noise5 < noisemin) noisemin = imagestats.noise5;
 
                     rescale = noisemin / fpvar.rescale_noise;
                     if (rescale > 1.0) {
 
                         /* all the criteria are met, so create a temporary file that */
                         /* contains a rescaled version of the image, in CWD */
 
                         /* create temporary file name */
                         fp_tmpnam("Tmpfile3", "", tempfilename3);
 
                         fits_create_file(&tempfile, tempfilename3, &stat);
 
                         fits_get_hdu_num(inputfptr, &hdunum);
                         if (hdunum != 1) {
 
                             /* the input hdu is an image extension, so create dummy primary */
                             fits_create_img(tempfile, 8, 0, naxes, &stat);
                         }
 
                         fits_copy_header(inputfptr, tempfile, &stat); /* copy the header */
 
                         /* rescale the data, so that it will compress more efficiently */
                         if (bitpix == LONG_IMG)
                             fp_i4rescale(inputfptr, naxis, naxes, rescale, tempfile, &stat);
                         else
                             fp_i2rescale(inputfptr, naxis, naxes, rescale, tempfile, &stat);
 
                         /* scale the BSCALE keyword by the inverse factor */
 
                         bscale = bscale * rescale;
                         fits_update_key(tempfile, TDOUBLE, "BSCALE", &bscale, 0, &stat);
 
                         /* rescan the header, to reset the actual scaling parameters */
                         fits_set_hdustruc(tempfile, &stat);
 
                         infptr = tempfile;
                         rescale_flag = 1;
                     }
                 }
             }
 
             if (!rescale_flag)   /* just compress the input file, without rescaling */
                 infptr = inputfptr;
 
             /* compute basic statistics about the input image */
             if (bitpix == BYTE_IMG) {
                 bpix = 8;
                 strncpy(dtype, "8  ", sizeof(dtype)/sizeof(dtype[0]));
                 fp_i2stat(infptr, naxis, naxes, &imagestats, &stat);
             } else if (bitpix == SHORT_IMG) {
                 bpix = 16;
                 strncpy(dtype, "16 ", sizeof(dtype)/sizeof(dtype[0]));
                 fp_i2stat(infptr, naxis, naxes, &imagestats, &stat);
             } else if (bitpix == LONG_IMG) {
                 bpix = 32;
                 strncpy(dtype, "32 ", sizeof(dtype)/sizeof(dtype[0]));
                 fp_i4stat(infptr, naxis, naxes, &imagestats, &stat);
             } else if (bitpix == LONGLONG_IMG) {
                 bpix = 64;
                 strncpy(dtype, "64 ", sizeof(dtype)/sizeof(dtype[0]));
             } else if (bitpix == FLOAT_IMG)   {
                 bpix = 32;
                 strncpy(dtype, "-32", sizeof(dtype)/sizeof(dtype[0]));
                 fp_r4stat(infptr, naxis, naxes, &imagestats, &stat);
             } else if (bitpix == DOUBLE_IMG)  {
                 bpix = 64;
                 strncpy(dtype, "-64", sizeof(dtype)/sizeof(dtype[0]));
                 fp_r4stat(infptr, naxis, naxes, &imagestats, &stat);
             }
             else dtype[0] = '\0';
 
             /* use the minimum of the MAD 2nd, 3rd, and 5th order noise estimates */
             noisemin = imagestats.noise3;
             if (imagestats.noise2 != 0. && imagestats.noise2 < noisemin) noisemin = imagestats.noise2;
             if (imagestats.noise5 != 0. && imagestats.noise5 < noisemin) noisemin = imagestats.noise5;
 
             xbits = (float) (log10(noisemin)/.301 + 1.792);
 
             printf("\n File: %s\n", infits);
             printf("  Ext BITPIX Dimens.   Nulls    Min    Max     Mean    Sigma  Noise2  Noise3  Noise5  Nbits   MaxR\n");
 
             printf("  %3d  %s", extnum, dtype);
             snprintf(dimen,100," (%ld", naxes[0]);
             len =strlen(dimen);
             for (ii = 1; ii < naxis; ii++) {
                 if (len < 99)
                     snprintf(dimen+len,100-len,",%ld", naxes[ii]);
                 len =strlen(dimen);
             }
             if (strlen(dimen)<99)
                 strcat(dimen, ")");
             printf("%-12s",dimen);
 
             fits_get_hduaddr(inputfptr, &headstart, &datastart, &dataend, &stat);
             origdata = (float) ((dataend - datastart)/1000000.);
 
             /* get elapsed and cpu times need to read the uncompressed image */
             fits_read_image_speed (infptr, &whole_elapse, &whole_cpu,
                                    &row_elapse, &row_cpu, &stat);
 
             printf(" %5d %6.0f %6.0f %8.1f %#8.2g %#7.3g %#7.3g %#7.3g %#5.1f %#6.2f\n",
                    imagestats.n_nulls, imagestats.minval, imagestats.maxval,
                    imagestats.mean, imagestats.sigma,
                    imagestats.noise2, imagestats.noise3, imagestats.noise5, xbits, bpix/xbits);
 
             printf("\n       Type   Ratio       Size (MB)     Pk (Sec) UnPk Exact ElpN CPUN  Elp1  CPU1\n");
 
             printf("       Native                                             %5.3f %5.3f %5.3f %5.3f\n",
                    whole_elapse, whole_cpu, row_elapse, row_cpu);
 
             if (fpvar.outfile[0]) {
                 fprintf(outreport,
                         " %s  %d %d %ld %ld %#10.4g %d %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g %#10.4g",
                         infits, extnum, bitpix, naxes[0], naxes[1], origdata, imagestats.n_nulls, imagestats.minval,
                         imagestats.maxval, imagestats.mean, imagestats.sigma,
                         imagestats.noise1, imagestats.noise2, imagestats.noise3, imagestats.noise5, whole_elapse, whole_cpu, row_elapse, row_cpu);
             }
 
             fits_set_lossy_int (outfptr, fpvar.int_to_float, &stat);
             if ( (bitpix > 0) && (fpvar.int_to_float != 0) ) {
 
                 if ( (noisemin < (fpvar.n3ratio * fpvar.quantize_level) ) ||
                      (noisemin < fpvar.n3min)) {
 
                     /* image contains too little noise to quantize effectively */
                     fits_set_lossy_int (outfptr, 0, &stat);
                     fits_get_hdu_num(infptr, &hdunum);
 
                     printf("    HDU %d does not meet noise criteria to be quantized, so losslessly compressed.\n", hdunum);
                 }
             }
 
             /* test compression ratio and speed for each algorithm */
 
             if (fpvar.quantize_level != 0) {
 
                 fits_set_compression_type (outfptr, RICE_1, &stat);
                 fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
                 if (fpvar.no_dither)
                     fits_set_quantize_method(outfptr, -1, &stat);
                 else
                     fits_set_quantize_method(outfptr, fpvar.dither_method, &stat);
 
                 fits_set_quantize_level (outfptr, fpvar.quantize_level, &stat);
                 fits_set_dither_offset(outfptr, fpvar.dither_offset, &stat);
                 fits_set_hcomp_scale (outfptr, fpvar.scale, &stat);
                 fits_set_hcomp_smooth (outfptr, fpvar.smooth, &stat);
 
                 fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
             }
 
             if (fpvar.quantize_level != 0) {
                 \
                 fits_set_compression_type (outfptr, HCOMPRESS_1, &stat);
                 fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
 
                 if (fpvar.no_dither)
                     fits_set_quantize_method(outfptr, -1, &stat);
                 else
                     fits_set_quantize_method(outfptr, fpvar.dither_method, &stat);
 
                 fits_set_quantize_level (outfptr, fpvar.quantize_level, &stat);
                 fits_set_dither_offset(outfptr, fpvar.dither_offset, &stat);
                 fits_set_hcomp_scale (outfptr, fpvar.scale, &stat);
                 fits_set_hcomp_smooth (outfptr, fpvar.smooth, &stat);
 
                 fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
             }
 
             if (fpvar.comptype == GZIP_2) {
                 fits_set_compression_type (outfptr, GZIP_2, &stat);
             } else {
                 fits_set_compression_type (outfptr, GZIP_1, &stat);
             }
 
             fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
 
             if (fpvar.no_dither)
                 fits_set_quantize_method(outfptr, -1, &stat);
             else
                 fits_set_quantize_method(outfptr, fpvar.dither_method, &stat);
 
             fits_set_quantize_level (outfptr, fpvar.quantize_level, &stat);
             fits_set_dither_offset(outfptr, fpvar.dither_offset, &stat);
             fits_set_hcomp_scale (outfptr, fpvar.scale, &stat);
             fits_set_hcomp_smooth (outfptr, fpvar.smooth, &stat);
 
             fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
 
             /*
         fits_set_compression_type (outfptr, BZIP2_1, &stat);
         fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
         fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
 */
             /*
         fits_set_compression_type (outfptr, PLIO_1, &stat);
         fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
         fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
 */
             /*
                 if (bitpix == SHORT_IMG || bitpix == LONG_IMG) {
           fits_set_compression_type (outfptr, NOCOMPRESS, &stat);
           fits_set_tile_dim (outfptr, 6, fpvar.ntile, &stat);
           fp_test_hdu(infptr, outfptr, outfptr2, fpvar, &stat);
         }
 */
             if (fpvar.outfile[0])
                 fprintf(outreport,"\n");
 
             /* delete the temporary file */
             if (rescale_flag)  {
                 fits_delete_file (infptr, &stat);
                 tempfilename3[0] = '\0';   /* clear the temp filename */
             }
         } else if ( (hdutype == BINARY_TBL) && fpvar.do_tables) {
 
             fits_get_num_rowsll(inputfptr, &nrows, &stat);
             fits_get_num_cols(inputfptr, &ncols, &stat);
 #if defined(_MSC_VER)
             /* Microsoft Visual C++ 6.0 uses '%I64d' syntax  for 8-byte integers */
             printf("\n File: %s, HDU %d,  %d cols X %I64d rows\n", infits, extnum, ncols, nrows);
 #elif (USE_LL_SUFFIX == 1)
             printf("\n File: %s, HDU %d,  %d cols X %lld rows\n", infits, extnum, ncols, nrows);
 #else
             printf("\n File: %s, HDU %d,  %d cols X %ld rows\n", infits, extnum, ncols, nrows);
 #endif
             fp_test_table(inputfptr, outfptr, outfptr2, fpvar, &stat);
 
         } else {
             fits_copy_hdu (inputfptr, outfptr, 0, &stat);
             fits_copy_hdu (inputfptr, outfptr2, 0, &stat);
         }
 
         fits_movrel_hdu (inputfptr, 1, NULL, &stat);
         extnum++;
     }
 
 
     if (stat == END_OF_FILE) stat = 0;
 
     fits_close_file (outfptr2, &stat);
     fits_close_file (outfptr, &stat);
     fits_close_file (inputfptr, &stat);
 
     if (stat) {
         fits_report_error (stderr, stat);
     }
     return(0);
 }
 /*--------------------------------------------------------------------------*/
 int fp_pack_hdu (fitsfile *infptr, fitsfile *outfptr, fpstate fpvar,
                  int *islossless, int *status)
 {
     fitsfile *tempfile;
     long    naxes[9] = {1, 1, 1, 1, 1, 1, 1, 1, 1};
     int stat=0, totpix=0, naxis=0, ii, hdutype, bitpix;
     int tstatus, hdunum;
     double  bscale, rescale;
 
     char    outfits[SZ_STR], fzalgor[FLEN_VALUE];
     long    headstart, datastart, dataend, datasize;
     double  noisemin;
     /* structure to hold image statistics (defined in fpack.h) */
     imgstats imagestats;
 
     if (*status) return(0);
 
     fits_get_hdu_type (infptr, &hdutype, &stat);
 
     if (hdutype == IMAGE_HDU) {
         fits_get_img_param (infptr, 9, &bitpix, &naxis, naxes, &stat);
         for (totpix=1, ii=0; ii < 9; ii++) totpix *= naxes[ii];
     }
 
     /* check directive keyword to see if this HDU should not be compressed */
     tstatus = 0;
     if (!fits_read_key(infptr, TSTRING, "FZALGOR", fzalgor, NULL, &tstatus) ) {
         if (!strcmp(fzalgor, "NONE") || !strcmp(fzalgor, "none") ) {
             fits_copy_hdu (infptr, outfptr, 0, &stat);
 
             *status = stat;
             return(0);
         }
     }
 
     /* =============================================================== */
     /* This block is only for  binary table compression */
     if (hdutype == BINARY_TBL && fpvar.do_tables) {
 
         fits_get_hduaddr(infptr, &headstart, &datastart, &dataend, status);
         datasize = dataend - datastart;
 
         if (datasize <= 2880) {
             /* data is less than 1 FITS block in size, so don't compress */
             fits_copy_hdu (infptr, outfptr, 0, &stat);
         } else {
             fits_compress_table (infptr, outfptr, &stat);
         }
 
         *status = stat;
         return(0);
     }
     /* =============================================================== */
 
     /* If this is not a non-null image HDU, just copy it verbatim */
     if (fits_is_compressed_image (infptr,  &stat) || hdutype != IMAGE_HDU ||
             naxis == 0 || totpix == 0 || !fpvar.do_images) {
         fits_copy_hdu (infptr, outfptr, 0, &stat);
 
     } else {  /* remaining code deals only with IMAGE HDUs */
 
         /* special case: rescale a scaled integer image to reduce noise? */
         if (fpvar.rescale_noise != 0. && bitpix > 0 && bitpix < LONGLONG_IMG) {
 
             tstatus = 0;
             fits_read_key(infptr, TDOUBLE, "BSCALE", &bscale, 0, &tstatus);
             if (tstatus == 0 && bscale != 1.0) {  /* image must be scaled */
 
                 if (bitpix == LONG_IMG)
                     fp_i4stat(infptr, naxis, naxes, &imagestats, &stat);
                 else
                     fp_i2stat(infptr, naxis, naxes, &imagestats, &stat);
 
                 /* use the minimum of the MAD 2nd, 3rd, and 5th order noise estimates */
                 noisemin = imagestats.noise3;
                 if (imagestats.noise2 != 0. && imagestats.noise2 < noisemin) noisemin = imagestats.noise2;
                 if (imagestats.noise5 != 0. && imagestats.noise5 < noisemin) noisemin = imagestats.noise5;
 
                 rescale = noisemin / fpvar.rescale_noise;
                 if (rescale > 1.0) {
 
                     /* all the criteria are met, so create a temporary file that */
                     /* contains a rescaled version of the image, in output directory */
 
                     /* create temporary file name */
                     fits_file_name(outfptr, outfits, &stat);  /* get the output file name */
                     fp_tmpnam("Tmp3", outfits, tempfilename3);
 
                     fits_create_file(&tempfile, tempfilename3, &stat);
 
                     fits_get_hdu_num(infptr, &hdunum);
                     if (hdunum != 1) {
 
                         /* the input hdu is an image extension, so create dummy primary */
                         fits_create_img(tempfile, 8, 0, naxes, &stat);
                     }
 
                     fits_copy_header(infptr, tempfile, &stat); /* copy the header */
 
                     /* rescale the data, so that it will compress more efficiently */
                     if (bitpix == LONG_IMG)
                         fp_i4rescale(infptr, naxis, naxes, rescale, tempfile, &stat);
                     else
                         fp_i2rescale(infptr, naxis, naxes, rescale, tempfile, &stat);
 
 
                     /* scale the BSCALE keyword by the inverse factor */
 
                     bscale = bscale * rescale;
                     fits_update_key(tempfile, TDOUBLE, "BSCALE", &bscale, 0, &stat);
 
                     /* rescan the header, to reset the actual scaling parameters */
                     fits_set_hdustruc(tempfile, &stat);
 
                     fits_img_compress (tempfile, outfptr, &stat);
                     fits_delete_file  (tempfile, &stat);
                     tempfilename3[0] = '\0';   /* clear the temp filename */
                     *islossless = 0;  /* used a lossy compression method */
 
                     *status = stat;
                     return(0);
                 }
             }
         }
 
         /* if requested to do lossy compression of integer images (by */
         /* converting to float), then check if this HDU qualifies */
         if ( (bitpix > 0) && (fpvar.int_to_float != 0) ) {
 
             if (bitpix >= LONG_IMG)
                 fp_i4stat(infptr, naxis, naxes, &imagestats, &stat);
             else
                 fp_i2stat(infptr, naxis, naxes, &imagestats, &stat);
 
             /* rescan the image header to reset scaling values (changed by fp_iNstat) */
             ffrhdu(infptr, &hdutype, &stat);
 
             /* use the minimum of the MAD 2nd, 3rd, and 5th order noise estimates */
             noisemin = imagestats.noise3;
             if (imagestats.noise2 != 0. && imagestats.noise2 < noisemin) noisemin = imagestats.noise2;
             if (imagestats.noise5 != 0. && imagestats.noise5 < noisemin) noisemin = imagestats.noise5;
 
             if ( (noisemin < (fpvar.n3ratio * fpvar.quantize_level) ) ||
                  (imagestats.noise3 < fpvar.n3min)) {
 
                 /* image contains too little noise to quantize effectively */
                 fits_set_lossy_int (outfptr, 0, &stat);
 
                 fits_get_hdu_num(infptr, &hdunum);
 
                 printf("    HDU %d does not meet noise criteria to be quantized, so losslessly compressed.\n", hdunum);
 
             } else {
                 /* compressed image is not identical to original */
                 *islossless = 0;
             }
         }
 
         /* finally, do the actual image compression */
         fits_img_compress (infptr, outfptr, &stat);
 
         if (bitpix < 0 ||
                 (fpvar.comptype == HCOMPRESS_1 && fpvar.scale != 0.)) {
 
             /* compressed image is not identical to original */
             *islossless = 0;
         }
     }
 
     *status = stat;
     return(0);
 }
 
 /*--------------------------------------------------------------------------*/
 int fp_unpack_hdu (fitsfile *infptr, fitsfile *outfptr, fpstate fpvar, int *status)
 {
     UNUSED(fpvar);
 
     int hdutype, lval;
 
     if (*status > 0) return(0);
 
     fits_get_hdu_type (infptr, &hdutype, status);
 
     /* =============================================================== */
     /* This block is only for beta testing of binary table compression */
     if (hdutype == BINARY_TBL) {
 
         fits_read_key(infptr, TLOGICAL, "ZTABLE", &lval, NULL, status);
 
         if (*status == 0 && lval != 0) {
             /*  uncompress the table */
             fits_uncompress_table (infptr, outfptr, status);
         } else {
             if (*status == KEY_NO_EXIST)  /* table is not compressed */
                 *status = 0;
             fits_copy_hdu (infptr, outfptr, 0, status);
         }
 
         return(0);
         /* =============================================================== */
 
     } else if (fits_is_compressed_image (infptr,  status)) {
         /* uncompress the compressed image HDU */
         fits_img_decompress (infptr, outfptr, status);
     } else {
         /* not a compressed image HDU, so just copy it to the output */
         fits_copy_hdu (infptr, outfptr, 0, status);
     }
 
     return(0);
 }
 /*--------------------------------------------------------------------------*/
 int fits_read_image_speed (fitsfile *infptr, float *whole_elapse,
                            float *whole_cpu, float *row_elapse, float *row_cpu, int *status)
 {
     unsigned char *carray, cnull = 0;
     short *sarray, snull=0;
     int bitpix, naxis, anynull, *iarray, inull = 0;
     long ii, naxes[9], fpixel[9]={1,1,1,1,1,1,1,1,1}, lpixel[9]={1,1,1,1,1,1,1,1,1};
     long inc[9]={1,1,1,1,1,1,1,1,1} ;
     float *earray, enull = 0, filesize;
     double *darray, dnull = 0;
 
     if (*status) return(*status);
 
     fits_get_img_param (infptr, 9, &bitpix, &naxis, naxes, status);
 
     if (naxis != 2)return(*status);
 
     lpixel[0] = naxes[0];
     lpixel[1] = naxes[1];
 
     /* filesize in MB */
     filesize = (float) (naxes[0] * abs(bitpix) / 8000000. * naxes[1]);
 
     /* measure time required to read the raw image */
     fits_set_bscale(infptr, 1.0, 0.0, status);
     *whole_elapse = 0.;
     *whole_cpu = 0;
 
     if (bitpix == BYTE_IMG) {
         carray = calloc(naxes[1]*naxes[0], sizeof(char));
 
         /* remove any cached uncompressed tile
           (dangerous to directly modify the structure!) */
         /*       (infptr->Fptr)->tilerow = 0; */
 
         marktime(status);
         fits_read_subset(infptr, TBYTE, fpixel, lpixel, inc, &cnull,
                          carray, &anynull, status);
 
         /* get elapsped times */
         gettime(whole_elapse, whole_cpu, status);
 
         /* now read the image again, row by row */
         if (row_elapse) {
 
             /* remove any cached uncompressed tile
             (dangerous to directly modify the structure!) */
             /*        (infptr->Fptr)->tilerow = 0; */
 
             marktime(status);
             for (ii = 0; ii < naxes[1]; ii++) {
                 fpixel[1] = ii+1;
                 fits_read_pix(infptr, TBYTE, fpixel, naxes[0], &cnull,
                         carray, &anynull, status);
             }
             /* get elapsped times */
             gettime(row_elapse, row_cpu, status);
         }
         free(carray);
 
     } else if (bitpix == SHORT_IMG) {
         sarray = calloc(naxes[0]*naxes[1], sizeof(short));
 
         marktime(status);
         fits_read_subset(infptr, TSHORT, fpixel, lpixel, inc, &snull,
                          sarray, &anynull, status);
 
         gettime(whole_elapse, whole_cpu, status);   /* get elapsped times */
 
         /* now read the image again, row by row */
         if (row_elapse) {
             marktime(status);
             for (ii = 0; ii < naxes[1]; ii++) {
 
                 fpixel[1] = ii+1;
                 fits_read_pix(infptr, TSHORT, fpixel, naxes[0], &snull,
                         sarray, &anynull, status);
             }
             /* get elapsped times */
             gettime(row_elapse, row_cpu, status);
         }
 
         free(sarray);
 
     } else if (bitpix == LONG_IMG) {
         iarray = calloc(naxes[0]*naxes[1], sizeof(int));
 
         marktime(status);
 
         fits_read_subset(infptr, TINT, fpixel, lpixel, inc, &inull,
                          iarray, &anynull, status);
 
         /* get elapsped times */
         gettime(whole_elapse, whole_cpu, status);
 
 
         /* now read the image again, row by row */
         if (row_elapse) {
             marktime(status);
             for (ii = 0; ii < naxes[1]; ii++) {
                 fpixel[1] = ii+1;
                 fits_read_pix(infptr, TINT, fpixel, naxes[0], &inull,
                         iarray, &anynull, status);
             }
             /* get elapsped times */
             gettime(row_elapse, row_cpu, status);
         }
 
 
         free(iarray);
 
     } else if (bitpix == FLOAT_IMG)   {
         earray = calloc(naxes[1]*naxes[0], sizeof(float));
 
         marktime(status);
 
         fits_read_subset(infptr, TFLOAT, fpixel, lpixel, inc, &enull,
                          earray, &anynull, status);
 
         /* get elapsped times */
         gettime(whole_elapse, whole_cpu, status);
 
         /* now read the image again, row by row */
         if (row_elapse) {
             marktime(status);
             for (ii = 0; ii < naxes[1]; ii++) {
                 fpixel[1] = ii+1;
                 fits_read_pix(infptr, TFLOAT, fpixel, naxes[0], &enull,
                         earray, &anynull, status);
             }
             /* get elapsped times */
             gettime(row_elapse, row_cpu, status);
         }
 
         free(earray);
 
     } else if (bitpix == DOUBLE_IMG)  {
         darray = calloc(naxes[1]*naxes[0], sizeof(double));
 
         marktime(status);
 
         fits_read_subset(infptr, TDOUBLE, fpixel, lpixel, inc, &dnull,
                          darray, &anynull, status);
 
         /* get elapsped times */
         gettime(whole_elapse, whole_cpu, status);
 
         /* now read the image again, row by row */
         if (row_elapse) {
             marktime(status);
             for (ii = 0; ii < naxes[1]; ii++) {
                 fpixel[1] = ii+1;
                 fits_read_pix(infptr, TDOUBLE, fpixel, naxes[0], &dnull,
                         darray, &anynull, status);
             }
             /* get elapsped times */
             gettime(row_elapse, row_cpu, status);
         }
 
         free(darray);
     }
 
     if (whole_elapse) *whole_elapse = *whole_elapse / filesize;
     if (row_elapse)   *row_elapse   = *row_elapse / filesize;
     if (whole_cpu)    *whole_cpu    = *whole_cpu / filesize;
     if (row_cpu)      *row_cpu      = *row_cpu / filesize;
 
     return(*status);
 }
 /*--------------------------------------------------------------------------*/
 int fp_test_hdu (fitsfile *infptr, fitsfile *outfptr, fitsfile *outfptr2,
                  fpstate fpvar, int *status)
 {
     /*   This routine is only used for performance testing of image HDUs. */
     /*   Use fp_test_table for testing binary table HDUs.    */
 
     int stat = 0, hdutype, comptype;
     char ctype[20], lossless[4];
     long headstart, datastart, dataend;
     float origdata = 0., compressdata = 0.;
     float compratio = 0., packcpu = 0., unpackcpu = 0.;
     float elapse, whole_elapse, row_elapse, whole_cpu, row_cpu;
     unsigned long datasum1, datasum2, hdusum;
 
     if (*status) return(0);
 
     origdata = 0;
     compressdata = 0;
     compratio = 0.;
     lossless[0] = '\0';
 
     fits_get_compression_type(outfptr, &comptype, &stat);
     if (comptype == RICE_1)
         strcpy(ctype, "RICE");
     else if (comptype == GZIP_1)
         strcpy(ctype, "GZIP1");
     else if (comptype == GZIP_2)
         strcpy(ctype, "GZIP2");/*
     else if (comptype == BZIP2_1)
         strcpy(ctype, "BZIP2");
 */
     else if (comptype == PLIO_1)
         strcpy(ctype, "PLIO");
     else if (comptype == HCOMPRESS_1)
         strcpy(ctype, "HCOMP");
     else if (comptype == NOCOMPRESS)
         strcpy(ctype, "NONE");
     else {
         fp_msg ("Error: unsupported image compression type ");
         *status = DATA_COMPRESSION_ERR;
         return(0);
     }
 
     /* -------------- COMPRESS the image ------------------ */
 
     marktime(&stat);
 
     fits_img_compress (infptr, outfptr, &stat);
 
     /* get elapsped times */
     gettime(&elapse, &packcpu, &stat);
 
     /* get elapsed and cpu times need to read the compressed image */
     fits_read_image_speed (outfptr, &whole_elapse, &whole_cpu,
                            &row_elapse, &row_cpu, &stat);
 
     if (!stat) {
 
         /* -------------- UNCOMPRESS the image ------------------ */
 
         /* remove any cached uncompressed tile
           (dangerous to directly modify the structure!) */
         /*        (outfptr->Fptr)->tilerow = 0; */
         marktime(&stat);
 
         fits_img_decompress (outfptr, outfptr2, &stat);
 
         /* get elapsped times */
         gettime(&elapse, &unpackcpu, &stat);
 
         /* ----------------------------------------------------- */
 
 
         /* get sizes of original and compressed images */
 
         fits_get_hduaddr(infptr, &headstart, &datastart, &dataend, &stat);
         origdata = (float) ((dataend - datastart)/1000000.);
 
         fits_get_hduaddr(outfptr, &headstart, &datastart, &dataend, &stat);
         compressdata = (float) ((dataend - datastart)/1000000.);
 
         if (compressdata != 0)
             compratio = (float) origdata / (float) compressdata;
 
         /* is this uncompressed image identical to the original? */
 
         fits_get_chksum(infptr, &datasum1, &hdusum, &stat);
         fits_get_chksum(outfptr2, &datasum2, &hdusum, &stat);
 
         if ( datasum1 == datasum2) {
             strcpy(lossless, "Yes");
         } else {
             strcpy(lossless, "No");
         }
 
         printf("       %-5s %6.2f %7.2f ->%7.2f %7.2f %7.2f %s %5.3f %5.3f %5.3f %5.3f\n",
                ctype, compratio, origdata, compressdata,
                packcpu, unpackcpu, lossless, whole_elapse, whole_cpu,
                row_elapse, row_cpu);
 
 
         if (fpvar.outfile[0]) {
             fprintf(outreport," %6.3f %5.2f %5.2f %s %7.3f %7.3f %7.3f %7.3f",
                     compratio, packcpu, unpackcpu, lossless,  whole_elapse, whole_cpu,
                     row_elapse, row_cpu);
         }
 
         /* delete the output HDUs to concerve disk space */
 
         fits_delete_hdu(outfptr, &hdutype, &stat);
         fits_delete_hdu(outfptr2, &hdutype, &stat);
 
     } else {
         printf("       %-5s     (unable to compress image)\n", ctype);
     }
 
     /* try to recover from any compression errors */
     if (stat == DATA_COMPRESSION_ERR) stat = 0;
 
     *status = stat;
     return(0);
 }
 /*--------------------------------------------------------------------------*/
 int fp_test_table (fitsfile *infptr, fitsfile *outfptr, fitsfile *outfptr2,
                    fpstate fpvar, int *status)
 {
     /* this routine is for performance testing of the table compression methods */
     UNUSED(fpvar);
     UNUSED(outfptr2);
 
     int stat = 0, hdutype, tstatus = 0;
     char fzalgor[FLEN_VALUE];
     LONGLONG headstart, datastart, dataend;
     float elapse, cpu;
 
     if (*status) return(0);
 
     /* check directive keyword to see if this HDU should not be compressed */
     if (!fits_read_key(infptr, TSTRING, "FZALGOR", fzalgor, NULL, &tstatus) ) {
         if (!strcmp(fzalgor, "NONE")  || !strcmp(fzalgor, "none")) {
             return(0);
         }
     }
 
     fits_get_hduaddrll(infptr, &headstart, &datastart, &dataend, status);
 
     /* can't compress small tables with less than 2880 bytes of data */
     if (dataend - datastart <= 2880) {
         return(0);
     }
 
     marktime(&stat);
     stat= -999;  /* set special flag value */
     fits_compress_table (infptr, outfptr,  &stat);
 
     /* get elapsped times */
     gettime(&elapse, &cpu, &stat);
 
     fits_delete_hdu(outfptr, &hdutype, &stat);
 
     printf("\nElapsed time = %f, cpu = %f\n", elapse, cpu);
 
     fits_report_error (stderr, stat);
 
     return(0);
 }
 /*--------------------------------------------------------------------------*/
 int marktime(int *status)
 {
 #if defined(unix) || defined(__unix__)  || defined(__unix)
     struct  timeval tv;
     /*        struct  timezone tz; */
 
     /*        gettimeofday (&tv, &tz); */
     gettimeofday (&tv, NULL);
 
     startsec = tv.tv_sec;
     startmilli = tv.tv_usec/1000;
 
     scpu = clock();
 #else
     /* don't support high timing precision on Windows machines */
     startsec = 0;
     startmilli = 0;
 
     scpu = clock();
 #endif
     return( *status );
 }
 /*--------------------------------------------------------------------------*/
 int gettime(float *elapse, float *elapscpu, int *status)
 {
 #if defined(unix) || defined(__unix__)  || defined(__unix)
     struct  timeval tv;
     /*        struct  timezone tz; */
     int stopmilli;
     long stopsec;
 
     /*        gettimeofday (&tv, &tz); */
     gettimeofday (&tv, NULL);
     ecpu = clock();
 
     stopmilli = tv.tv_usec/1000;
     stopsec = tv.tv_sec;
 
     *elapse = (stopsec - startsec) + (stopmilli - startmilli)/1000.;
     *elapscpu = (ecpu - scpu) * 1.0 / CLOCKTICKS;
     /*
 printf(" (start: %ld + %d), stop: (%ld + %d) elapse: %f\n ",
 startsec,startmilli,stopsec, stopmilli, *elapse);
 */
 #else
     /* set the elapsed time the same as the CPU time on Windows machines */
     *elapscpu = (float) ((ecpu - scpu) * 1.0 / CLOCKTICKS);
     *elapse = *elapscpu;
 #endif
     return( *status );
 }
 /*--------------------------------------------------------------------------*/
 int fp_i2stat(fitsfile *infptr, int naxis, long *naxes, imgstats *imagestats, int *status)
 {
     /*
     read the central XSAMPLE by YSAMPLE region of pixels in the int*2 image,
     and then compute basic statistics: min, max, mean, sigma, mean diff, etc.
 */
 
     long fpixel[9] = {1,1,1,1,1,1,1,1,1};
     long lpixel[9] = {1,1,1,1,1,1,1,1,1};
     long inc[9]    = {1,1,1,1,1,1,1,1,1};
     long i1, i2, npix, ngood, nx, ny;
     short *intarray, minvalue, maxvalue, nullvalue;
     int anynul, tstatus, checknull = 1;
     double mean, sigma, noise1, noise2, noise3, noise5;
 
     /* select the middle XSAMPLE by YSAMPLE area of the image */
     i1 = naxes[0]/2 - (XSAMPLE/2 - 1);
     i2 = naxes[0]/2 + (XSAMPLE/2);
     if (i1 < 1) i1 = 1;
     if (i2 > naxes[0]) i2 = naxes[0];
     fpixel[0] = i1;
     lpixel[0] = i2;
     nx = i2 - i1 +1;
 
     if (naxis > 1) {
         i1 = naxes[1]/2 - (YSAMPLE/2 - 1);
         i2 = naxes[1]/2 + (YSAMPLE/2);
         if (i1 < 1) i1 = 1;
         if (i2 > naxes[1]) i2 = naxes[1];
         fpixel[1] = i1;
         lpixel[1] = i2;
     }
     ny = i2 - i1 +1;
 
     npix = nx * ny;
 
     /* if there are higher dimensions, read the middle plane of the cube */
     if (naxis > 2) {
         fpixel[2] = naxes[2]/2 + 1;
         lpixel[2] = naxes[2]/2 + 1;
     }
 
     intarray = calloc(npix, sizeof(short));
     if (!intarray) {
         *status = MEMORY_ALLOCATION;
         return(*status);
     }
 
     /* turn off any scaling of the integer pixel values */
     fits_set_bscale(infptr, 1.0, 0.0, status);
 
     fits_read_subset_sht(infptr, 0, naxis, naxes, fpixel, lpixel, inc,
                          0, intarray, &anynul, status);
 
     /* read the null value keyword (BLANK) if present */
     tstatus = 0;
     fits_read_key(infptr, TSHORT, "BLANK", &nullvalue, 0, &tstatus);
     if (tstatus) {
         nullvalue = 0;
         checknull = 0;
     }
 
     /* compute statistics of the image */
 
     fits_img_stats_short(intarray, nx, ny, checknull, nullvalue,
                          &ngood, &minvalue, &maxvalue, &mean, &sigma, &noise1, &noise2, &noise3, &noise5, status);
 
     imagestats->n_nulls = npix - ngood;
     imagestats->minval = minvalue;
     imagestats->maxval = maxvalue;
     imagestats->mean = mean;
     imagestats->sigma = sigma;
     imagestats->noise1 = noise1;
     imagestats->noise2 = noise2;
     imagestats->noise3 = noise3;
     imagestats->noise5 = noise5;
 
     free(intarray);
     return(*status);
 }
 /*--------------------------------------------------------------------------*/
 int fp_i4stat(fitsfile *infptr, int naxis, long *naxes, imgstats *imagestats, int *status)
 {
     /*
     read the central XSAMPLE by YSAMPLE region of pixels in the int*2 image,
     and then compute basic statistics: min, max, mean, sigma, mean diff, etc.
 */
 
     long fpixel[9] = {1,1,1,1,1,1,1,1,1};
     long lpixel[9] = {1,1,1,1,1,1,1,1,1};
     long inc[9]    = {1,1,1,1,1,1,1,1,1};
     long i1, i2, npix, ngood, nx, ny;
     int *intarray, minvalue, maxvalue, nullvalue;
     int anynul, tstatus, checknull = 1;
     double mean, sigma, noise1, noise2, noise3, noise5;
 
     /* select the middle XSAMPLE by YSAMPLE area of the image */
     i1 = naxes[0]/2 - (XSAMPLE/2 - 1);
     i2 = naxes[0]/2 + (XSAMPLE/2);
     if (i1 < 1) i1 = 1;
     if (i2 > naxes[0]) i2 = naxes[0];
     fpixel[0] = i1;
     lpixel[0] = i2;
     nx = i2 - i1 +1;
 
     if (naxis > 1) {
         i1 = naxes[1]/2 - (YSAMPLE/2 - 1);
         i2 = naxes[1]/2 + (YSAMPLE/2);
         if (i1 < 1) i1 = 1;
         if (i2 > naxes[1]) i2 = naxes[1];
         fpixel[1] = i1;
         lpixel[1] = i2;
     }
     ny = i2 - i1 +1;
 
     npix = nx * ny;
 
     /* if there are higher dimensions, read the middle plane of the cube */
     if (naxis > 2) {
         fpixel[2] = naxes[2]/2 + 1;
         lpixel[2] = naxes[2]/2 + 1;
     }
 
     intarray = calloc(npix, sizeof(int));
     if (!intarray) {
         *status = MEMORY_ALLOCATION;
         return(*status);
     }
 
     /* turn off any scaling of the integer pixel values */
     fits_set_bscale(infptr, 1.0, 0.0, status);
 
     fits_read_subset_int(infptr, 0, naxis, naxes, fpixel, lpixel, inc,
                          0, intarray, &anynul, status);
 
     /* read the null value keyword (BLANK) if present */
     tstatus = 0;
     fits_read_key(infptr, TINT, "BLANK", &nullvalue, 0, &tstatus);
     if (tstatus) {
         nullvalue = 0;
         checknull = 0;
     }
 
     /* compute statistics of the image */
 
     fits_img_stats_int(intarray, nx, ny, checknull, nullvalue,
                        &ngood, &minvalue, &maxvalue, &mean, &sigma, &noise1, &noise2, &noise3, &noise5, status);
 
     imagestats->n_nulls = npix - ngood;
     imagestats->minval = minvalue;
     imagestats->maxval = maxvalue;
     imagestats->mean = mean;
     imagestats->sigma = sigma;
     imagestats->noise1 = noise1;
     imagestats->noise2 = noise2;
     imagestats->noise3 = noise3;
     imagestats->noise5 = noise5;
 
     free(intarray);
     return(*status);
 }
 /*--------------------------------------------------------------------------*/
 int fp_r4stat(fitsfile *infptr, int naxis, long *naxes, imgstats *imagestats, int *status)
 {
     /*
     read the central XSAMPLE by YSAMPLE region of pixels in the int*2 image,
     and then compute basic statistics: min, max, mean, sigma, mean diff, etc.
 */
 
     long fpixel[9] = {1,1,1,1,1,1,1,1,1};
     long lpixel[9] = {1,1,1,1,1,1,1,1,1};
     long inc[9]    = {1,1,1,1,1,1,1,1,1};
     long i1, i2, npix, ngood, nx, ny;
     float *array, minvalue, maxvalue, nullvalue = FLOATNULLVALUE;
     int anynul,checknull = 1;
     double mean, sigma, noise1, noise2, noise3, noise5;
 
     /* select the middle XSAMPLE by YSAMPLE area of the image */
     i1 = naxes[0]/2 - (XSAMPLE/2 - 1);
     i2 = naxes[0]/2 + (XSAMPLE/2);
     if (i1 < 1) i1 = 1;
     if (i2 > naxes[0]) i2 = naxes[0];
     fpixel[0] = i1;
     lpixel[0] = i2;
     nx = i2 - i1 +1;
 
     if (naxis > 1) {
         i1 = naxes[1]/2 - (YSAMPLE/2 - 1);
         i2 = naxes[1]/2 + (YSAMPLE/2);
         if (i1 < 1) i1 = 1;
         if (i2 > naxes[1]) i2 = naxes[1];
         fpixel[1] = i1;
         lpixel[1] = i2;
     }
     ny = i2 - i1 +1;
 
     npix = nx * ny;
 
     /* if there are higher dimensions, read the middle plane of the cube */
     if (naxis > 2) {
         fpixel[2] = naxes[2]/2 + 1;
         lpixel[2] = naxes[2]/2 + 1;
     }
 
     array = calloc(npix, sizeof(float));
     if (!array) {
         *status = MEMORY_ALLOCATION;
         return(*status);
     }
 
     fits_read_subset_flt(infptr, 0, naxis, naxes, fpixel, lpixel, inc,
                          nullvalue, array, &anynul, status);
 
     /* are there any null values in the array? */
     if (!anynul) {
         nullvalue = 0.;
         checknull = 0;
     }
 
     /* compute statistics of the image */
 
     fits_img_stats_float(array, nx, ny, checknull, nullvalue,
                          &ngood, &minvalue, &maxvalue, &mean, &sigma, &noise1, &noise2, &noise3, &noise5, status);
 
     imagestats->n_nulls = npix - ngood;
     imagestats->minval = minvalue;
     imagestats->maxval = maxvalue;
     imagestats->mean = mean;
     imagestats->sigma = sigma;
     imagestats->noise1 = noise1;
     imagestats->noise2 = noise2;
     imagestats->noise3 = noise3;
     imagestats->noise5 = noise5;
 
     free(array);
     return(*status);
 }
 /*--------------------------------------------------------------------------*/
 int fp_i2rescale(fitsfile *infptr, int naxis, long *naxes, double rescale,
                  fitsfile *outfptr, int *status)
 {
     /*
     divide the integer pixel values in the input file by rescale,
     and write back out to the output file..
 */
 
     long ii, jj, nelem = 1, nx, ny;
     short *intarray, nullvalue;
     int anynul, tstatus, checknull = 1;
 
     nx = naxes[0];
     ny = 1;
 
     for (ii = 1; ii < naxis; ii++) {
         ny = ny * naxes[ii];
     }
 
     intarray = calloc(nx, sizeof(short));
     if (!intarray) {
         *status = MEMORY_ALLOCATION;
         return(*status);
     }
 
     /* read the null value keyword (BLANK) if present */
     tstatus = 0;
     fits_read_key(infptr, TSHORT, "BLANK", &nullvalue, 0, &tstatus);
     if (tstatus) {
         checknull = 0;
     }
 
     /* turn off any scaling of the integer pixel values */
     fits_set_bscale(infptr,  1.0, 0.0, status);
     fits_set_bscale(outfptr, 1.0, 0.0, status);
 
     for (ii = 0; ii < ny; ii++) {
 
         fits_read_img_sht(infptr, 1, nelem, nx,
                           0, intarray, &anynul, status);
 
         if (checknull) {
             for (jj = 0; jj < nx; jj++) {
                 if (intarray[jj] != nullvalue)
                     intarray[jj] = NSHRT( (intarray[jj] / rescale) );
             }
         } else {
             for (jj = 0; jj < nx; jj++)
                 intarray[jj] = NSHRT( (intarray[jj] / rescale) );
         }
 
         fits_write_img_sht(outfptr, 1, nelem, nx, intarray, status);
 
         nelem += nx;
     }
 
     free(intarray);
     return(*status);
 }
 /*--------------------------------------------------------------------------*/
 int fp_i4rescale(fitsfile *infptr, int naxis, long *naxes, double rescale,
                  fitsfile *outfptr, int *status)
 {
     /*
     divide the integer pixel values in the input file by rescale,
     and write back out to the output file..
 */
 
     long ii, jj, nelem = 1, nx, ny;
     int *intarray, nullvalue;
     int anynul, tstatus, checknull = 1;
 
     nx = naxes[0];
     ny = 1;
 
     for (ii = 1; ii < naxis; ii++) {
         ny = ny * naxes[ii];
     }
 
     intarray = calloc(nx, sizeof(int));
     if (!intarray) {
         *status = MEMORY_ALLOCATION;
         return(*status);
     }
 
     /* read the null value keyword (BLANK) if present */
     tstatus = 0;
     fits_read_key(infptr, TINT, "BLANK", &nullvalue, 0, &tstatus);
     if (tstatus) {
         checknull = 0;
     }
 
     /* turn off any scaling of the integer pixel values */
     fits_set_bscale(infptr,  1.0, 0.0, status);
     fits_set_bscale(outfptr, 1.0, 0.0, status);
 
     for (ii = 0; ii < ny; ii++) {
 
         fits_read_img_int(infptr, 1, nelem, nx,
                           0, intarray, &anynul, status);
 
         if (checknull) {
             for (jj = 0; jj < nx; jj++) {
                 if (intarray[jj] != nullvalue)
                     intarray[jj] = NINT( (intarray[jj] / rescale) );
             }
         } else {
             for (jj = 0; jj < nx; jj++)
                 intarray[jj] = NINT( (intarray[jj] / rescale) );
         }
 
         fits_write_img_int(outfptr, 1, nelem, nx, intarray, status);
 
         nelem += nx;
     }
 
     free(intarray);
     return(*status);
 }
 /* ========================================================================
  * Signal and error handler.
  */
 void abort_fpack(int sig)
 {
     /* clean up by deleting temporary files */
     UNUSED(sig);
 
     if (tempfilename[0]) {
         remove(tempfilename);
     }
     if (tempfilename2[0]) {
         remove(tempfilename2);
     }
     if (tempfilename3[0]) {
         remove(tempfilename3);
     }
     exit(-1);
 }