"Fossies" - the Fresh Open Source Software Archive

Member "cfitsio-4.0.0/putcoli.c" (20 May 2021, 35439 Bytes) of package /linux/misc/cfitsio-4.0.0.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "putcoli.c" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 3440_vs_3450.

    1 /*  This file, putcoli.c, contains routines that write data elements to    */
    2 /*  a FITS image or table, with short datatype.                            */
    3 
    4 /*  The FITSIO software was written by William Pence at the High Energy    */
    5 /*  Astrophysic Science Archive Research Center (HEASARC) at the NASA      */
    6 /*  Goddard Space Flight Center.                                           */
    7 
    8 #include <limits.h>
    9 #include <string.h>
   10 #include <stdlib.h>
   11 #include "fitsio2.h"
   12 
   13 /*--------------------------------------------------------------------------*/
   14 int ffppri( fitsfile *fptr,  /* I - FITS file pointer                       */
   15             long  group,     /* I - group to write (1 = 1st group)          */
   16             LONGLONG  firstelem, /* I - first vector element to write (1 = 1st) */
   17             LONGLONG  nelem,     /* I - number of values to write               */
   18             short *array,    /* I - array of values that are written        */
   19             int  *status)    /* IO - error status                           */
   20 /*
   21   Write an array of values to the primary array. Data conversion
   22   and scaling will be performed if necessary (e.g, if the datatype of
   23   the FITS array is not the same as the array being written).
   24 */
   25 {
   26     long row;
   27     short nullvalue;
   28 
   29     /*
   30       the primary array is represented as a binary table:
   31       each group of the primary array is a row in the table,
   32       where the first column contains the group parameters
   33       and the second column contains the image itself.
   34     */
   35 
   36     if (fits_is_compressed_image(fptr, status))
   37     {
   38         /* this is a compressed image in a binary table */
   39 
   40 
   41         fits_write_compressed_pixels(fptr, TSHORT, firstelem, nelem,
   42             0, array, &nullvalue, status);
   43         return(*status);
   44     }
   45 
   46     row=maxvalue(1,group);
   47 
   48     ffpcli(fptr, 2, row, firstelem, nelem, array, status);
   49     return(*status);
   50 }
   51 /*--------------------------------------------------------------------------*/
   52 int ffppni( fitsfile *fptr,  /* I - FITS file pointer                       */
   53             long  group,     /* I - group to write(1 = 1st group)           */
   54             LONGLONG  firstelem, /* I - first vector element to write(1 = 1st)  */
   55             LONGLONG  nelem,     /* I - number of values to write               */
   56             short *array,    /* I - array of values that are written        */
   57             short nulval,    /* I - undefined pixel value                   */
   58             int  *status)    /* IO - error status                           */
   59 /*
   60   Write an array of values to the primary array. Data conversion
   61   and scaling will be performed if necessary (e.g, if the datatype of the
   62   FITS array is not the same as the array being written).  Any array values
   63   that are equal to the value of nulval will be replaced with the null
   64   pixel value that is appropriate for this column.
   65 */
   66 {
   67     long row;
   68     short nullvalue;
   69 
   70     /*
   71       the primary array is represented as a binary table:
   72       each group of the primary array is a row in the table,
   73       where the first column contains the group parameters
   74       and the second column contains the image itself.
   75     */
   76 
   77     if (fits_is_compressed_image(fptr, status))
   78     {
   79         /* this is a compressed image in a binary table */
   80 
   81         nullvalue = nulval;  /* set local variable */
   82         fits_write_compressed_pixels(fptr, TSHORT, firstelem, nelem,
   83             1, array, &nullvalue, status);
   84         return(*status);
   85     }
   86 
   87     row=maxvalue(1,group);
   88 
   89     ffpcni(fptr, 2, row, firstelem, nelem, array, nulval, status);
   90     return(*status);
   91 }
   92 /*--------------------------------------------------------------------------*/
   93 int ffp2di(fitsfile *fptr,   /* I - FITS file pointer                     */
   94            long  group,      /* I - group to write(1 = 1st group)         */
   95            LONGLONG  ncols,      /* I - number of pixels in each row of array */
   96            LONGLONG  naxis1,     /* I - FITS image NAXIS1 value               */
   97            LONGLONG  naxis2,     /* I - FITS image NAXIS2 value               */
   98            short *array,     /* I - array to be written                   */
   99            int  *status)     /* IO - error status                         */
  100 /*
  101   Write an entire 2-D array of values to the primary array. Data conversion
  102   and scaling will be performed if necessary (e.g, if the datatype of the
  103   FITS array is not the same as the array being written).
  104 */
  105 {
  106     /* call the 3D writing routine, with the 3rd dimension = 1 */
  107 
  108     ffp3di(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
  109 
  110     return(*status);
  111 }
  112 /*--------------------------------------------------------------------------*/
  113 int ffp3di(fitsfile *fptr,   /* I - FITS file pointer                     */
  114            long  group,      /* I - group to write(1 = 1st group)         */
  115            LONGLONG  ncols,      /* I - number of pixels in each row of array */
  116            LONGLONG  nrows,      /* I - number of rows in each plane of array */
  117            LONGLONG  naxis1,     /* I - FITS image NAXIS1 value               */
  118            LONGLONG  naxis2,     /* I - FITS image NAXIS2 value               */
  119            LONGLONG  naxis3,     /* I - FITS image NAXIS3 value               */
  120            short *array,     /* I - array to be written                   */
  121            int  *status)     /* IO - error status                         */
  122 /*
  123   Write an entire 3-D cube of values to the primary array. Data conversion
  124   and scaling will be performed if necessary (e.g, if the datatype of the
  125   FITS array is not the same as the array being written).
  126 */
  127 {
  128     long tablerow, ii, jj;
  129     long fpixel[3]= {1,1,1}, lpixel[3];
  130     LONGLONG nfits, narray;
  131     /*
  132       the primary array is represented as a binary table:
  133       each group of the primary array is a row in the table,
  134       where the first column contains the group parameters
  135       and the second column contains the image itself.
  136     */
  137            
  138     if (fits_is_compressed_image(fptr, status))
  139     {
  140         /* this is a compressed image in a binary table */
  141         lpixel[0] = (long) ncols;
  142         lpixel[1] = (long) nrows;
  143         lpixel[2] = (long) naxis3;
  144        
  145         fits_write_compressed_img(fptr, TSHORT, fpixel, lpixel,
  146             0,  array, NULL, status);
  147     
  148         return(*status);
  149     }
  150 
  151     tablerow=maxvalue(1,group);
  152 
  153     if (ncols == naxis1 && nrows == naxis2)  /* arrays have same size? */
  154     {
  155       /* all the image pixels are contiguous, so write all at once */
  156       ffpcli(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
  157       return(*status);
  158     }
  159 
  160     if (ncols < naxis1 || nrows < naxis2)
  161        return(*status = BAD_DIMEN);
  162 
  163     nfits = 1;   /* next pixel in FITS image to write to */
  164     narray = 0;  /* next pixel in input array to be written */
  165 
  166     /* loop over naxis3 planes in the data cube */
  167     for (jj = 0; jj < naxis3; jj++)
  168     {
  169       /* loop over the naxis2 rows in the FITS image, */
  170       /* writing naxis1 pixels to each row            */
  171 
  172       for (ii = 0; ii < naxis2; ii++)
  173       {
  174        if (ffpcli(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
  175          return(*status);
  176 
  177        nfits += naxis1;
  178        narray += ncols;
  179       }
  180       narray += (nrows - naxis2) * ncols;
  181     }
  182     return(*status);
  183 }
  184 /*--------------------------------------------------------------------------*/
  185 int ffpssi(fitsfile *fptr,   /* I - FITS file pointer                       */
  186            long  group,      /* I - group to write(1 = 1st group)           */
  187            long  naxis,      /* I - number of data axes in array            */
  188            long  *naxes,     /* I - size of each FITS axis                  */
  189            long  *fpixel,    /* I - 1st pixel in each axis to write (1=1st) */
  190            long  *lpixel,    /* I - last pixel in each axis to write        */
  191            short *array,     /* I - array to be written                     */
  192            int  *status)     /* IO - error status                           */
  193 /*
  194   Write a subsection of pixels to the primary array or image.
  195   A subsection is defined to be any contiguous rectangular
  196   array of pixels within the n-dimensional FITS data file.
  197   Data conversion and scaling will be performed if necessary 
  198   (e.g, if the datatype of the FITS array is not the same as
  199   the array being written).
  200 */
  201 {
  202     long tablerow;
  203     LONGLONG fpix[7], dimen[7], astart, pstart;
  204     LONGLONG off2, off3, off4, off5, off6, off7;
  205     LONGLONG st10, st20, st30, st40, st50, st60, st70;
  206     LONGLONG st1, st2, st3, st4, st5, st6, st7;
  207     long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
  208 
  209     if (*status > 0)
  210         return(*status);
  211 
  212     if (fits_is_compressed_image(fptr, status))
  213     {
  214         /* this is a compressed image in a binary table */
  215 
  216         fits_write_compressed_img(fptr, TSHORT, fpixel, lpixel,
  217             0,  array, NULL, status);
  218 
  219         return(*status);
  220     }
  221 
  222     if (naxis < 1 || naxis > 7)
  223       return(*status = BAD_DIMEN);
  224 
  225     tablerow=maxvalue(1,group);
  226 
  227      /* calculate the size and number of loops to perform in each dimension */
  228     for (ii = 0; ii < 7; ii++)
  229     {
  230       fpix[ii]=1;
  231       irange[ii]=1;
  232       dimen[ii]=1;
  233     }
  234 
  235     for (ii = 0; ii < naxis; ii++)
  236     {    
  237       fpix[ii]=fpixel[ii];
  238       irange[ii]=lpixel[ii]-fpixel[ii]+1;
  239       dimen[ii]=naxes[ii];
  240     }
  241 
  242     i1=irange[0];
  243 
  244     /* compute the pixel offset between each dimension */
  245     off2 =     dimen[0];
  246     off3 = off2 * dimen[1];
  247     off4 = off3 * dimen[2];
  248     off5 = off4 * dimen[3];
  249     off6 = off5 * dimen[4];
  250     off7 = off6 * dimen[5];
  251 
  252     st10 = fpix[0];
  253     st20 = (fpix[1] - 1) * off2;
  254     st30 = (fpix[2] - 1) * off3;
  255     st40 = (fpix[3] - 1) * off4;
  256     st50 = (fpix[4] - 1) * off5;
  257     st60 = (fpix[5] - 1) * off6;
  258     st70 = (fpix[6] - 1) * off7;
  259 
  260     /* store the initial offset in each dimension */
  261     st1 = st10;
  262     st2 = st20;
  263     st3 = st30;
  264     st4 = st40;
  265     st5 = st50;
  266     st6 = st60;
  267     st7 = st70;
  268 
  269     astart = 0;
  270 
  271     for (i7 = 0; i7 < irange[6]; i7++)
  272     {
  273      for (i6 = 0; i6 < irange[5]; i6++)
  274      {
  275       for (i5 = 0; i5 < irange[4]; i5++)
  276       {
  277        for (i4 = 0; i4 < irange[3]; i4++)
  278        {
  279         for (i3 = 0; i3 < irange[2]; i3++)
  280         {
  281          pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
  282 
  283          for (i2 = 0; i2 < irange[1]; i2++)
  284          {
  285            if (ffpcli(fptr, 2, tablerow, pstart, i1, &array[astart],
  286               status) > 0)
  287               return(*status);
  288 
  289            astart += i1;
  290            pstart += off2;
  291          }
  292          st2 = st20;
  293          st3 = st3+off3;    
  294         }
  295         st3 = st30;
  296         st4 = st4+off4;
  297        }
  298        st4 = st40;
  299        st5 = st5+off5;
  300       }
  301       st5 = st50;
  302       st6 = st6+off6;
  303      }
  304      st6 = st60;
  305      st7 = st7+off7;
  306     }
  307     return(*status);
  308 }
  309 /*--------------------------------------------------------------------------*/
  310 int ffpgpi( fitsfile *fptr,   /* I - FITS file pointer                      */
  311             long  group,      /* I - group to write(1 = 1st group)          */
  312             long  firstelem,  /* I - first vector element to write(1 = 1st) */
  313             long  nelem,      /* I - number of values to write              */
  314             short *array,     /* I - array of values that are written       */
  315             int  *status)     /* IO - error status                          */
  316 /*
  317   Write an array of group parameters to the primary array. Data conversion
  318   and scaling will be performed if necessary (e.g, if the datatype of
  319   the FITS array is not the same as the array being written).
  320 */
  321 {
  322     long row;
  323 
  324     /*
  325       the primary array is represented as a binary table:
  326       each group of the primary array is a row in the table,
  327       where the first column contains the group parameters
  328       and the second column contains the image itself.
  329     */
  330 
  331     row=maxvalue(1,group);
  332 
  333     ffpcli(fptr, 1L, row, firstelem, nelem, array, status);
  334     return(*status);
  335 }
  336 /*--------------------------------------------------------------------------*/
  337 int ffpcli( fitsfile *fptr,  /* I - FITS file pointer                       */
  338             int  colnum,     /* I - number of column to write (1 = 1st col) */
  339             LONGLONG  firstrow,  /* I - first row to write (1 = 1st row)        */
  340             LONGLONG  firstelem, /* I - first vector element to write (1 = 1st) */
  341             LONGLONG  nelem,     /* I - number of values to write               */
  342             short *array,    /* I - array of values to write                */
  343             int  *status)    /* IO - error status                           */
  344 /*
  345   Write an array of values to a column in the current FITS HDU.
  346   The column number may refer to a real column in an ASCII or binary table, 
  347   or it may refer to a virtual column in a 1 or more grouped FITS primary
  348   array.  FITSIO treats a primary array as a binary table with
  349   2 vector columns: the first column contains the group parameters (often
  350   with length = 0) and the second column contains the array of image pixels.
  351   Each row of the table represents a group in the case of multigroup FITS
  352   images.
  353 
  354   The input array of values will be converted to the datatype of the column 
  355   and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
  356 */
  357 {
  358     int tcode, maxelem2, hdutype, writeraw;
  359     long twidth, incre;
  360     long ntodo;
  361     LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull, maxelem;
  362     double scale, zero;
  363     char tform[20], cform[20];
  364     char message[FLEN_ERRMSG];
  365 
  366     char snull[20];   /*  the FITS null value  */
  367 
  368     double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
  369     void *buffer;
  370 
  371     if (*status > 0)           /* inherit input status value if > 0 */
  372         return(*status);
  373 
  374     buffer = cbuff;
  375 
  376     /*---------------------------------------------------*/
  377     /*  Check input and get parameters about the column: */
  378     /*---------------------------------------------------*/
  379     if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
  380         tform, &twidth, &tcode, &maxelem2, &startpos,  &elemnum, &incre,
  381         &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
  382         return(*status);
  383     maxelem = maxelem2;
  384 
  385     if (tcode == TSTRING)   
  386          ffcfmt(tform, cform);     /* derive C format for writing strings */
  387 
  388     /*
  389       if there is no scaling and the native machine format is not byteswapped,
  390       then we can simply write the raw data bytes into the FITS file if the
  391       datatype of the FITS column is the same as the input values.  Otherwise,
  392       we must convert the raw values into the scaled and/or machine dependent
  393       format in a temporary buffer that has been allocated for this purpose.
  394     */
  395     if (scale == 1. && zero == 0. &&
  396        MACHINE == NATIVE && tcode == TSHORT)
  397     {
  398         writeraw = 1;
  399         if (nelem < (LONGLONG)INT32_MAX) {
  400             maxelem = nelem;
  401         } else {
  402             maxelem = INT32_MAX/2;
  403         }
  404     }
  405     else
  406         writeraw = 0;
  407 
  408     /*---------------------------------------------------------------------*/
  409     /*  Now write the pixels to the FITS column.                           */
  410     /*  First call the ffXXfYY routine to  (1) convert the datatype        */
  411     /*  if necessary, and (2) scale the values by the FITS TSCALn and      */
  412     /*  TZEROn linear scaling parameters into a temporary buffer.          */
  413     /*---------------------------------------------------------------------*/
  414     remain = nelem;           /* remaining number of values to write  */
  415     next = 0;                 /* next element in array to be written  */
  416     rownum = 0;               /* row number, relative to firstrow     */
  417 
  418     while (remain)
  419     {
  420         /* limit the number of pixels to process a one time to the number that
  421            will fit in the buffer space or to the number of pixels that remain
  422            in the current vector, which ever is smaller.
  423         */
  424         ntodo = (long) minvalue(remain, maxelem);      
  425         ntodo = (long) minvalue(ntodo, (repeat - elemnum));
  426 
  427         wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
  428 
  429         ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
  430 
  431         switch (tcode) 
  432         {
  433             case (TSHORT):
  434               if (writeraw)
  435               {
  436                 /* write raw input bytes without conversion */
  437                 ffpi2b(fptr, ntodo, incre, &array[next], status);
  438               }
  439               else
  440               {
  441                 /* convert the raw data before writing to FITS file */
  442                 ffi2fi2(&array[next], ntodo, scale, zero,
  443                         (short *) buffer, status);
  444                 ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
  445               }
  446 
  447               break;
  448 
  449             case (TLONGLONG):
  450 
  451                 ffi2fi8(&array[next], ntodo, scale, zero,
  452                         (LONGLONG *) buffer, status);
  453                 ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
  454                 break;
  455 
  456              case (TBYTE):
  457 
  458                 ffi2fi1(&array[next], ntodo, scale, zero,
  459                         (unsigned char *) buffer, status);
  460                 ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
  461                 break;
  462 
  463             case (TLONG):
  464 
  465                 ffi2fi4(&array[next], ntodo, scale, zero,
  466                         (INT32BIT *) buffer, status);
  467                 ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
  468                 break;
  469 
  470             case (TFLOAT):
  471 
  472                 ffi2fr4(&array[next], ntodo, scale, zero,
  473                         (float *) buffer, status);
  474                 ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
  475                 break;
  476 
  477             case (TDOUBLE):
  478                 ffi2fr8(&array[next], ntodo, scale, zero,
  479                         (double *) buffer, status);
  480                 ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
  481                 break;
  482 
  483             case (TSTRING):  /* numerical column in an ASCII table */
  484 
  485                 if (cform[1] != 's')  /*  "%s" format is a string */
  486                 {
  487                   ffi2fstr(&array[next], ntodo, scale, zero, cform,
  488                           twidth, (char *) buffer, status);
  489 
  490 
  491                   if (incre == twidth)    /* contiguous bytes */
  492                      ffpbyt(fptr, ntodo * twidth, buffer, status);
  493                   else
  494                      ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
  495                             status);
  496 
  497                   break;
  498                 }
  499                 /* can't write to string column, so fall thru to default: */
  500 
  501             default:  /*  error trap  */
  502                 snprintf(message,FLEN_ERRMSG, 
  503                     "Cannot write numbers to column %d which has format %s",
  504                       colnum,tform);
  505                 ffpmsg(message);
  506                 if (hdutype == ASCII_TBL)
  507                     return(*status = BAD_ATABLE_FORMAT);
  508                 else
  509                     return(*status = BAD_BTABLE_FORMAT);
  510 
  511         } /* End of switch block */
  512 
  513         /*-------------------------*/
  514         /*  Check for fatal error  */
  515         /*-------------------------*/
  516         if (*status > 0)  /* test for error during previous write operation */
  517         {
  518          snprintf(message,FLEN_ERRMSG,
  519           "Error writing elements %.0f thru %.0f of input data array (ffpcli).",
  520              (double) (next+1), (double) (next+ntodo));
  521          ffpmsg(message);
  522          return(*status);
  523         }
  524 
  525         /*--------------------------------------------*/
  526         /*  increment the counters for the next loop  */
  527         /*--------------------------------------------*/
  528         remain -= ntodo;
  529         if (remain)
  530         {
  531             next += ntodo;
  532             elemnum += ntodo;
  533             if (elemnum == repeat)  /* completed a row; start on next row */
  534             {
  535                 elemnum = 0;
  536                 rownum++;
  537             }
  538         }
  539     }  /*  End of main while Loop  */
  540 
  541 
  542     /*--------------------------------*/
  543     /*  check for numerical overflow  */
  544     /*--------------------------------*/
  545     if (*status == OVERFLOW_ERR)
  546     {
  547        ffpmsg(
  548        "Numerical overflow during type conversion while writing FITS data.");
  549        *status = NUM_OVERFLOW;
  550     }
  551 
  552     return(*status);
  553 }
  554 /*--------------------------------------------------------------------------*/
  555 int ffpcni( fitsfile *fptr,  /* I - FITS file pointer                       */
  556             int  colnum,     /* I - number of column to write (1 = 1st col) */
  557             LONGLONG  firstrow,  /* I - first row to write (1 = 1st row)        */
  558             LONGLONG  firstelem, /* I - first vector element to write (1 = 1st) */
  559             LONGLONG  nelem,     /* I - number of values to write               */
  560             short *array,    /* I - array of values to write                */
  561             short  nulvalue, /* I - value used to flag undefined pixels     */
  562             int  *status)    /* IO - error status                           */
  563 /*
  564   Write an array of elements to the specified column of a table.  Any input
  565   pixels equal to the value of nulvalue will be replaced by the appropriate
  566   null value in the output FITS file. 
  567 
  568   The input array of values will be converted to the datatype of the column 
  569   and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
  570 */
  571 {
  572     tcolumn *colptr;
  573     LONGLONG  ngood = 0, nbad = 0, ii;
  574     LONGLONG repeat, first, fstelm, fstrow;
  575     int tcode, overflow = 0;
  576 
  577     if (*status > 0)
  578         return(*status);
  579 
  580     /* reset position to the correct HDU if necessary */
  581     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
  582     {
  583         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
  584     }
  585     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
  586     {
  587         if ( ffrdef(fptr, status) > 0)               /* rescan header */
  588             return(*status);
  589     }
  590 
  591     colptr  = (fptr->Fptr)->tableptr;   /* point to first column */
  592     colptr += (colnum - 1);     /* offset to correct column structure */
  593 
  594     tcode  = colptr->tdatatype;
  595 
  596     if (tcode > 0)
  597        repeat = colptr->trepeat;  /* repeat count for this column */
  598     else
  599        repeat = firstelem -1 + nelem;  /* variable length arrays */
  600 
  601     /* if variable length array, first write the whole input vector, 
  602        then go back and fill in the nulls */
  603     if (tcode < 0) {
  604       if (ffpcli(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
  605         if (*status == NUM_OVERFLOW) 
  606     {
  607       /* ignore overflows, which are possibly the null pixel values */
  608       /*  overflow = 1;   */
  609       *status = 0;
  610     } else { 
  611           return(*status);
  612     }
  613       }
  614     }
  615 
  616     /* absolute element number in the column */
  617     first = (firstrow - 1) * repeat + firstelem;
  618 
  619     for (ii = 0; ii < nelem; ii++)
  620     {
  621       if (array[ii] != nulvalue)  /* is this a good pixel? */
  622       {
  623          if (nbad)  /* write previous string of bad pixels */
  624          {
  625             fstelm = ii - nbad + first;  /* absolute element number */
  626             fstrow = (fstelm - 1) / repeat + 1;  /* starting row number */
  627             fstelm = fstelm - (fstrow - 1) * repeat;  /* relative number */
  628 
  629             if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
  630                 return(*status);
  631 
  632             nbad=0;
  633          }
  634 
  635          ngood = ngood +1;  /* the consecutive number of good pixels */
  636       }
  637       else
  638       {
  639          if (ngood)  /* write previous string of good pixels */
  640          {
  641             fstelm = ii - ngood + first;  /* absolute element number */
  642             fstrow = (fstelm - 1) / repeat + 1;  /* starting row number */
  643             fstelm = fstelm - (fstrow - 1) * repeat;  /* relative number */
  644 
  645             if (tcode > 0) {  /* variable length arrays have already been written */
  646               if (ffpcli(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
  647                 status) > 0) {
  648         if (*status == NUM_OVERFLOW) 
  649         {
  650           overflow = 1;
  651           *status = 0;
  652         } else { 
  653                   return(*status);
  654         }
  655           }
  656         }
  657             ngood=0;
  658          }
  659 
  660          nbad = nbad +1;  /* the consecutive number of bad pixels */
  661       }
  662     }
  663 
  664     /* finished loop;  now just write the last set of pixels */
  665 
  666     if (ngood)  /* write last string of good pixels */
  667     {
  668       fstelm = ii - ngood + first;  /* absolute element number */
  669       fstrow = (fstelm - 1) / repeat + 1;  /* starting row number */
  670       fstelm = fstelm - (fstrow - 1) * repeat;  /* relative number */
  671 
  672       if (tcode > 0) {  /* variable length arrays have already been written */
  673         ffpcli(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
  674       }
  675     }
  676     else if (nbad) /* write last string of bad pixels */
  677     {
  678       fstelm = ii - nbad + first;  /* absolute element number */
  679       fstrow = (fstelm - 1) / repeat + 1;  /* starting row number */
  680       fstelm = fstelm - (fstrow - 1) * repeat;  /* relative number */
  681 
  682       ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
  683     }
  684 
  685     if (*status <= 0) {
  686       if (overflow) {
  687         *status = NUM_OVERFLOW;
  688       }
  689     }
  690 
  691     return(*status);
  692 }
  693 /*--------------------------------------------------------------------------*/
  694 int ffi2fi1(short *input,          /* I - array of values to be converted  */
  695             long ntodo,            /* I - number of elements in the array  */
  696             double scale,          /* I - FITS TSCALn or BSCALE value      */
  697             double zero,           /* I - FITS TZEROn or BZERO  value      */
  698             unsigned char *output, /* O - output array of converted values */
  699             int *status)           /* IO - error status                    */
  700 /*
  701   Copy input to output prior to writing output to a FITS file.
  702   Do datatype conversion and scaling if required
  703 */
  704 {
  705     long ii;
  706     double dvalue;
  707 
  708     if (scale == 1. && zero == 0.)
  709     {       
  710         for (ii = 0; ii < ntodo; ii++)
  711         {
  712             if (input[ii] < 0)
  713             {
  714                 *status = OVERFLOW_ERR;
  715                 output[ii] = 0;
  716             }
  717             else if (input[ii] > UCHAR_MAX)
  718             {
  719                 *status = OVERFLOW_ERR;
  720                 output[ii] = UCHAR_MAX;
  721             }
  722             else
  723                 output[ii] = (unsigned char) input[ii];
  724         }
  725     }
  726     else
  727     {
  728         for (ii = 0; ii < ntodo; ii++)
  729         {
  730             dvalue = (input[ii] - zero) / scale;
  731 
  732             if (dvalue < DUCHAR_MIN)
  733             {
  734                 *status = OVERFLOW_ERR;
  735                 output[ii] = 0;
  736             }
  737             else if (dvalue > DUCHAR_MAX)
  738             {
  739                 *status = OVERFLOW_ERR;
  740                 output[ii] = UCHAR_MAX;
  741             }
  742             else
  743                 output[ii] = (unsigned char) (dvalue + .5);
  744         }
  745     }
  746     return(*status);
  747 }
  748 /*--------------------------------------------------------------------------*/
  749 int ffi2fi2(short *input,       /* I - array of values to be converted  */
  750             long ntodo,         /* I - number of elements in the array  */
  751             double scale,       /* I - FITS TSCALn or BSCALE value      */
  752             double zero,        /* I - FITS TZEROn or BZERO  value      */
  753             short *output,      /* O - output array of converted values */
  754             int *status)        /* IO - error status                    */
  755 /*
  756   Copy input to output prior to writing output to a FITS file.
  757   Do datatype conversion and scaling if required
  758 */
  759 {
  760     long ii;
  761     double dvalue;
  762 
  763     if (scale == 1. && zero == 0.)
  764     {       
  765         memcpy(output, input, ntodo * sizeof(short) );
  766     }
  767     else
  768     {
  769         for (ii = 0; ii < ntodo; ii++)
  770         {
  771             dvalue = (input[ii] - zero) / scale;
  772 
  773             if (dvalue < DSHRT_MIN)
  774             {
  775                 *status = OVERFLOW_ERR;
  776                 output[ii] = SHRT_MIN;
  777             }
  778             else if (dvalue > DSHRT_MAX)
  779             {
  780                 *status = OVERFLOW_ERR;
  781                 output[ii] = SHRT_MAX;
  782             }
  783             else
  784             {
  785                 if (dvalue >= 0)
  786                     output[ii] = (short) (dvalue + .5);
  787                 else
  788                     output[ii] = (short) (dvalue - .5);
  789             }
  790         }
  791     }
  792     return(*status);
  793 }
  794 /*--------------------------------------------------------------------------*/
  795 int ffi2fi4(short *input,      /* I - array of values to be converted  */
  796             long ntodo,        /* I - number of elements in the array  */
  797             double scale,      /* I - FITS TSCALn or BSCALE value      */
  798             double zero,       /* I - FITS TZEROn or BZERO  value      */
  799             INT32BIT *output,  /* O - output array of converted values */
  800             int *status)       /* IO - error status                    */
  801 /*
  802   Copy input to output prior to writing output to a FITS file.
  803   Do datatype conversion and scaling if required
  804 */
  805 {
  806     long ii;
  807     double dvalue;
  808 
  809     if (scale == 1. && zero == 0.)
  810     {       
  811         for (ii = 0; ii < ntodo; ii++)
  812             output[ii] = (INT32BIT) input[ii];   /* just copy input to output */
  813     }
  814     else
  815     {
  816         for (ii = 0; ii < ntodo; ii++)
  817         {
  818             dvalue = (input[ii] - zero) / scale;
  819 
  820             if (dvalue < DINT_MIN)
  821             {
  822                 *status = OVERFLOW_ERR;
  823                 output[ii] = INT32_MIN;
  824             }
  825             else if (dvalue > DINT_MAX)
  826             {
  827                 *status = OVERFLOW_ERR;
  828                 output[ii] = INT32_MAX;
  829             }
  830             else
  831             {
  832                 if (dvalue >= 0)
  833                     output[ii] = (INT32BIT) (dvalue + .5);
  834                 else
  835                     output[ii] = (INT32BIT) (dvalue - .5);
  836             }
  837         }
  838     }
  839     return(*status);
  840 }
  841 /*--------------------------------------------------------------------------*/
  842 int ffi2fi8(short *input,      /* I - array of values to be converted  */
  843             long ntodo,        /* I - number of elements in the array  */
  844             double scale,      /* I - FITS TSCALn or BSCALE value      */
  845             double zero,       /* I - FITS TZEROn or BZERO  value      */
  846             LONGLONG *output,  /* O - output array of converted values */
  847             int *status)       /* IO - error status                    */
  848 /*
  849   Copy input to output prior to writing output to a FITS file.
  850   Do datatype conversion and scaling if required
  851 */
  852 {
  853     long ii;
  854     double dvalue;
  855 
  856     if (scale == 1. && zero ==  9223372036854775808.)
  857     {       
  858         /* Writing to unsigned long long column. Input values must not be negative */
  859         /* Instead of subtracting 9223372036854775808, it is more efficient */
  860         /* and more precise to just flip the sign bit with the XOR operator */
  861 
  862         for (ii = 0; ii < ntodo; ii++) {
  863            if (input[ii] < 0) {
  864               *status = OVERFLOW_ERR;
  865               output[ii] = LONGLONG_MIN;
  866            } else {
  867               output[ii] =  ((LONGLONG) input[ii]) ^ 0x8000000000000000;
  868            }
  869         }
  870     }
  871     else if (scale == 1. && zero == 0.)
  872     {       
  873         for (ii = 0; ii < ntodo; ii++)
  874                 output[ii] = input[ii];
  875     }
  876     else
  877     {
  878         for (ii = 0; ii < ntodo; ii++)
  879         {
  880             dvalue = (input[ii] - zero) / scale;
  881 
  882             if (dvalue < DLONGLONG_MIN)
  883             {
  884                 *status = OVERFLOW_ERR;
  885                 output[ii] = LONGLONG_MIN;
  886             }
  887             else if (dvalue > DLONGLONG_MAX)
  888             {
  889                 *status = OVERFLOW_ERR;
  890                 output[ii] = LONGLONG_MAX;
  891             }
  892             else
  893             {
  894                 if (dvalue >= 0)
  895                     output[ii] = (LONGLONG) (dvalue + .5);
  896                 else
  897                     output[ii] = (LONGLONG) (dvalue - .5);
  898             }
  899         }
  900     }
  901     return(*status);
  902 }
  903 /*--------------------------------------------------------------------------*/
  904 int ffi2fr4(short *input,      /* I - array of values to be converted  */
  905             long ntodo,        /* I - number of elements in the array  */
  906             double scale,      /* I - FITS TSCALn or BSCALE value      */
  907             double zero,       /* I - FITS TZEROn or BZERO  value      */
  908             float *output,     /* O - output array of converted values */
  909             int *status)       /* IO - error status                    */
  910 /*
  911   Copy input to output prior to writing output to a FITS file.
  912   Do datatype conversion and scaling if required.
  913 */
  914 {
  915     long ii;
  916 
  917     if (scale == 1. && zero == 0.)
  918     {       
  919         for (ii = 0; ii < ntodo; ii++)
  920                 output[ii] = (float) input[ii];
  921     }
  922     else
  923     {
  924         for (ii = 0; ii < ntodo; ii++)
  925             output[ii] = (float) ((input[ii] - zero) / scale);
  926     }
  927     return(*status);
  928 }
  929 /*--------------------------------------------------------------------------*/
  930 int ffi2fr8(short *input,      /* I - array of values to be converted  */
  931             long ntodo,        /* I - number of elements in the array  */
  932             double scale,      /* I - FITS TSCALn or BSCALE value      */
  933             double zero,       /* I - FITS TZEROn or BZERO  value      */
  934             double *output,    /* O - output array of converted values */
  935             int *status)       /* IO - error status                    */
  936 /*
  937   Copy input to output prior to writing output to a FITS file.
  938   Do datatype conversion and scaling if required.
  939 */
  940 {
  941     long ii;
  942 
  943     if (scale == 1. && zero == 0.)
  944     {       
  945         for (ii = 0; ii < ntodo; ii++)
  946                 output[ii] = (double) input[ii];
  947     }
  948     else
  949     {
  950         for (ii = 0; ii < ntodo; ii++)
  951             output[ii] = (input[ii] - zero) / scale;
  952     }
  953     return(*status);
  954 }
  955 /*--------------------------------------------------------------------------*/
  956 int ffi2fstr(short *input,     /* I - array of values to be converted  */
  957             long ntodo,        /* I - number of elements in the array  */
  958             double scale,      /* I - FITS TSCALn or BSCALE value      */
  959             double zero,       /* I - FITS TZEROn or BZERO  value      */
  960             char *cform,       /* I - format for output string values  */
  961             long twidth,       /* I - width of each field, in chars    */
  962             char *output,      /* O - output array of converted values */
  963             int *status)       /* IO - error status                    */
  964 /*
  965   Copy input to output prior to writing output to a FITS file.
  966   Do scaling if required.
  967 */
  968 {
  969     long ii;
  970     double dvalue;
  971     char *cptr;
  972     
  973     cptr = output;
  974 
  975     if (scale == 1. && zero == 0.)
  976     {       
  977         for (ii = 0; ii < ntodo; ii++)
  978         {
  979            sprintf(output, cform, (double) input[ii]);
  980            output += twidth;
  981 
  982            if (*output)  /* if this char != \0, then overflow occurred */
  983               *status = OVERFLOW_ERR;
  984         }
  985     }
  986     else
  987     {
  988         for (ii = 0; ii < ntodo; ii++)
  989         {
  990           dvalue = (input[ii] - zero) / scale;
  991           sprintf(output, cform, dvalue);
  992           output += twidth;
  993 
  994           if (*output)  /* if this char != \0, then overflow occurred */
  995             *status = OVERFLOW_ERR;
  996         }
  997     }
  998 
  999     /* replace any commas with periods (e.g., in French locale) */
 1000     while ((cptr = strchr(cptr, ','))) *cptr = '.';
 1001 
 1002     return(*status);
 1003 }