"Fossies" - the Fresh Open Source Software Archive

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