"Fossies" - the Fresh Open Source Software Archive

Member "cfitsio-4.0.0/putcolb.c" (20 May 2021, 37536 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 "putcolb.c" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 3.49_vs_4.0.0.

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