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