1 /*  This file, putcolk.c, contains routines that write data elements to    */
2 /*  a FITS image or table, with 'unsigned int' 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 /*--------------------------------------------------------------------------*/
ffppruk(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,unsigned int * array,int * status)14 int ffppruk(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 int   *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 int 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, TUINT, firstelem, nelem,
41             0, array, &nullvalue, status);
42         return(*status);
43     }
44 
45     row=maxvalue(1,group);
46 
47     ffpcluk(fptr, 2, row, firstelem, nelem, array, status);
48     return(*status);
49 }
50 /*--------------------------------------------------------------------------*/
ffppnuk(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,unsigned int * array,unsigned int nulval,int * status)51 int ffppnuk(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 int   *array,    /* I - array of values that are written        */
56    unsigned int   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 int 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, TUINT, firstelem, nelem,
82             1, array, &nullvalue, status);
83         return(*status);
84     }
85 
86     row=maxvalue(1,group);
87 
88     ffpcnuk(fptr, 2, row, firstelem, nelem, array, nulval, status);
89     return(*status);
90 }
91 /*--------------------------------------------------------------------------*/
ffp2duk(fitsfile * fptr,long group,LONGLONG ncols,LONGLONG naxis1,LONGLONG naxis2,unsigned int * array,int * status)92 int ffp2duk(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 int   *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     ffp3duk(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
108 
109     return(*status);
110 }
111 /*--------------------------------------------------------------------------*/
ffp3duk(fitsfile * fptr,long group,LONGLONG ncols,LONGLONG nrows,LONGLONG naxis1,LONGLONG naxis2,LONGLONG naxis3,unsigned int * array,int * status)112 int ffp3duk(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 int   *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, TUINT, 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       ffpcluk(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 (ffpcluk(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 /*--------------------------------------------------------------------------*/
ffpssuk(fitsfile * fptr,long group,long naxis,long * naxes,long * fpixel,long * lpixel,unsigned int * array,int * status)184 int ffpssuk(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 int  *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, TUINT, 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 (ffpcluk(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 /*--------------------------------------------------------------------------*/
ffpgpuk(fitsfile * fptr,long group,long firstelem,long nelem,unsigned int * array,int * status)309 int ffpgpuk(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 int   *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     ffpcluk(fptr, 1L, row, firstelem, nelem, array, status);
333     return(*status);
334 }
335 /*--------------------------------------------------------------------------*/
ffpcluk(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,unsigned int * array,int * status)336 int ffpcluk(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 int   *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
348   with 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     /* call the 'short' or 'long' version of this routine, if possible */
374     if (sizeof(int) == sizeof(short))
375         ffpclui(fptr, colnum, firstrow, firstelem, nelem,
376               (unsigned short *) array, status);
377     else if (sizeof(int) == sizeof(long))
378         ffpcluj(fptr, colnum, firstrow, firstelem, nelem,
379               (unsigned long *) array, status);
380     else
381     {
382     /*
383       This is a special case: sizeof(int) is not equal to sizeof(short) or
384       sizeof(long).  This occurs on Alpha OSF systems where short = 2 bytes,
385       int = 4 bytes, and long = 8 bytes.
386     */
387 
388     buffer = cbuff;
389 
390     /*---------------------------------------------------*/
391     /*  Check input and get parameters about the column: */
392     /*---------------------------------------------------*/
393     if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
394         tform, &twidth, &tcode, &maxelem, &startpos,  &elemnum, &incre,
395         &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
396         return(*status);
397 
398     if (tcode == TSTRING)
399          ffcfmt(tform, cform);     /* derive C format for writing strings */
400 
401     /*---------------------------------------------------------------------*/
402     /*  Now write the pixels to the FITS column.                           */
403     /*  First call the ffXXfYY routine to  (1) convert the datatype        */
404     /*  if necessary, and (2) scale the values by the FITS TSCALn and      */
405     /*  TZEROn linear scaling parameters into a temporary buffer.          */
406     /*---------------------------------------------------------------------*/
407     remain = nelem;           /* remaining number of values to write  */
408     next = 0;                 /* next element in array to be written  */
409     rownum = 0;               /* row number, relative to firstrow     */
410 
411     while (remain)
412     {
413         /* limit the number of pixels to process a one time to the number that
414            will fit in the buffer space or to the number of pixels that remain
415            in the current vector, which ever is smaller.
416         */
417         ntodo = (long) minvalue(remain, maxelem);
418         ntodo = (long) minvalue(ntodo, (repeat - elemnum));
419 
420         wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
421 
422         ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
423 
424         switch (tcode)
425         {
426             case (TLONG):
427                 /* convert the raw data before writing to FITS file */
428                 ffuintfi4(&array[next], ntodo, scale, zero,
429                         (INT32BIT *) buffer, status);
430                 ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
431                 break;
432 
433             case (TLONGLONG):
434 
435                 ffuintfi8(&array[next], ntodo, scale, zero,
436                         (LONGLONG *) buffer, status);
437                 ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
438                 break;
439 
440             case (TBYTE):
441 
442                 ffuintfi1(&array[next], ntodo, scale, zero,
443                         (unsigned char *) buffer, status);
444                 ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
445                 break;
446 
447             case (TSHORT):
448 
449                 ffuintfi2(&array[next], ntodo, scale, zero,
450                         (short *) buffer, status);
451                 ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
452                 break;
453 
454             case (TFLOAT):
455 
456                 ffuintfr4(&array[next], ntodo, scale, zero,
457                         (float *) buffer, status);
458                 ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
459                 break;
460 
461             case (TDOUBLE):
462                 ffuintfr8(&array[next], ntodo, scale, zero,
463                        (double *) buffer, status);
464                 ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
465                 break;
466 
467             case (TSTRING):  /* numerical column in an ASCII table */
468 
469                 if (cform[1] != 's')  /*  "%s" format is a string */
470                 {
471                   ffuintfstr(&array[next], ntodo, scale, zero, cform,
472                           twidth, (char *) buffer, status);
473 
474                   if (incre == twidth)    /* contiguous bytes */
475                      ffpbyt(fptr, ntodo * twidth, buffer, status);
476                   else
477                      ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
478                             status);
479 
480                   break;
481                 }
482                 /* can't write to string column, so fall thru to default: */
483 
484             default:  /*  error trap  */
485                 snprintf(message,FLEN_ERRMSG,
486                      "Cannot write numbers to column %d which has format %s",
487                       colnum,tform);
488                 ffpmsg(message);
489                 if (hdutype == ASCII_TBL)
490                     return(*status = BAD_ATABLE_FORMAT);
491                 else
492                     return(*status = BAD_BTABLE_FORMAT);
493 
494         } /* End of switch block */
495 
496         /*-------------------------*/
497         /*  Check for fatal error  */
498         /*-------------------------*/
499         if (*status > 0)  /* test for error during previous write operation */
500         {
501           snprintf(message,FLEN_ERRMSG,
502           "Error writing elements %.0f thru %.0f of input data array (ffpcluk).",
503               (double) (next+1), (double) (next+ntodo));
504           ffpmsg(message);
505           return(*status);
506         }
507 
508         /*--------------------------------------------*/
509         /*  increment the counters for the next loop  */
510         /*--------------------------------------------*/
511         remain -= ntodo;
512         if (remain)
513         {
514             next += ntodo;
515             elemnum += ntodo;
516             if (elemnum == repeat)  /* completed a row; start on next row */
517             {
518                 elemnum = 0;
519                 rownum++;
520             }
521         }
522     }  /*  End of main while Loop  */
523 
524 
525     /*--------------------------------*/
526     /*  check for numerical overflow  */
527     /*--------------------------------*/
528     if (*status == OVERFLOW_ERR)
529     {
530         ffpmsg(
531         "Numerical overflow during type conversion while writing FITS data.");
532         *status = NUM_OVERFLOW;
533     }
534 
535     }   /* end of Dec ALPHA special case */
536 
537     return(*status);
538 }
539 /*--------------------------------------------------------------------------*/
ffpcnuk(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,unsigned int * array,unsigned int nulvalue,int * status)540 int ffpcnuk(fitsfile *fptr,  /* I - FITS file pointer                       */
541             int  colnum,     /* I - number of column to write (1 = 1st col) */
542             LONGLONG  firstrow,  /* I - first row to write (1 = 1st row)        */
543             LONGLONG  firstelem, /* I - first vector element to write (1 = 1st) */
544             LONGLONG  nelem,     /* I - number of values to write               */
545    unsigned int   *array,    /* I - array of values to write                */
546    unsigned int    nulvalue, /* I - value used to flag undefined pixels     */
547             int  *status)    /* IO - error status                           */
548 /*
549   Write an array of elements to the specified column of a table.  Any input
550   pixels equal to the value of nulvalue will be replaced by the appropriate
551   null value in the output FITS file.
552 
553   The input array of values will be converted to the datatype of the column
554   and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
555 */
556 {
557     tcolumn *colptr;
558     LONGLONG  ngood = 0, nbad = 0, ii;
559     LONGLONG repeat, first, fstelm, fstrow;
560     int tcode, overflow = 0;
561 
562     if (*status > 0)
563         return(*status);
564 
565     /* reset position to the correct HDU if necessary */
566     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
567     {
568         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
569     }
570     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
571     {
572         if ( ffrdef(fptr, status) > 0)               /* rescan header */
573             return(*status);
574     }
575 
576     colptr  = (fptr->Fptr)->tableptr;   /* point to first column */
577     colptr += (colnum - 1);     /* offset to correct column structure */
578 
579     tcode  = colptr->tdatatype;
580 
581     if (tcode > 0)
582        repeat = colptr->trepeat;  /* repeat count for this column */
583     else
584        repeat = firstelem -1 + nelem;  /* variable length arrays */
585 
586     /* if variable length array, first write the whole input vector,
587        then go back and fill in the nulls */
588     if (tcode < 0) {
589       if (ffpcluk(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
590         if (*status == NUM_OVERFLOW)
591 	{
592 	  /* ignore overflows, which are possibly the null pixel values */
593 	  /*  overflow = 1;   */
594 	  *status = 0;
595 	} else {
596           return(*status);
597 	}
598       }
599     }
600 
601     /* absolute element number in the column */
602     first = (firstrow - 1) * repeat + firstelem;
603 
604     for (ii = 0; ii < nelem; ii++)
605     {
606       if (array[ii] != nulvalue)  /* is this a good pixel? */
607       {
608          if (nbad)  /* write previous string of bad pixels */
609          {
610             fstelm = ii - nbad + first;  /* absolute element number */
611             fstrow = (fstelm - 1) / repeat + 1;  /* starting row number */
612             fstelm = fstelm - (fstrow - 1) * repeat;  /* relative number */
613 
614             if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
615                 return(*status);
616 
617             nbad=0;
618          }
619 
620          ngood = ngood +1;  /* the consecutive number of good pixels */
621       }
622       else
623       {
624          if (ngood)  /* write previous string of good pixels */
625          {
626             fstelm = ii - ngood + first;  /* absolute element number */
627             fstrow = (fstelm - 1) / repeat + 1;  /* starting row number */
628             fstelm = fstelm - (fstrow - 1) * repeat;  /* relative number */
629 
630             if (tcode > 0) {  /* variable length arrays have already been written */
631               if (ffpcluk(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
632                 status) > 0) {
633 		if (*status == NUM_OVERFLOW)
634 		{
635 		  overflow = 1;
636 		  *status = 0;
637 		} else {
638                   return(*status);
639 		}
640 	      }
641 	    }
642             ngood=0;
643          }
644 
645          nbad = nbad +1;  /* the consecutive number of bad pixels */
646       }
647     }
648 
649     /* finished loop;  now just write the last set of pixels */
650 
651     if (ngood)  /* write last string of good pixels */
652     {
653       fstelm = ii - ngood + first;  /* absolute element number */
654       fstrow = (fstelm - 1) / repeat + 1;  /* starting row number */
655       fstelm = fstelm - (fstrow - 1) * repeat;  /* relative number */
656 
657       if (tcode > 0) {  /* variable length arrays have already been written */
658         ffpcluk(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
659       }
660     }
661     else if (nbad) /* write last string of bad pixels */
662     {
663       fstelm = ii - nbad + first;  /* absolute element number */
664       fstrow = (fstelm - 1) / repeat + 1;  /* starting row number */
665       fstelm = fstelm - (fstrow - 1) * repeat;  /* relative number */
666 
667       ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
668     }
669 
670     if (*status <= 0) {
671       if (overflow) {
672         *status = NUM_OVERFLOW;
673       }
674     }
675 
676     return(*status);
677 }
678 /*--------------------------------------------------------------------------*/
ffuintfi1(unsigned int * input,long ntodo,double scale,double zero,unsigned char * output,int * status)679 int ffuintfi1(unsigned int *input, /* I - array of values to be converted  */
680             long ntodo,            /* I - number of elements in the array  */
681             double scale,          /* I - FITS TSCALn or BSCALE value      */
682             double zero,           /* I - FITS TZEROn or BZERO  value      */
683             unsigned char *output, /* O - output array of converted values */
684             int *status)           /* IO - error status                    */
685 /*
686   Copy input to output prior to writing output to a FITS file.
687   Do datatype conversion and scaling if required.
688 */
689 {
690     long ii;
691     double dvalue;
692 
693     if (scale == 1. && zero == 0.)
694     {
695         for (ii = 0; ii < ntodo; ii++)
696         {
697             if (input[ii] > UCHAR_MAX)
698             {
699                 *status = OVERFLOW_ERR;
700                 output[ii] = UCHAR_MAX;
701             }
702             else
703                 output[ii] = input[ii];
704         }
705     }
706     else
707     {
708         for (ii = 0; ii < ntodo; ii++)
709         {
710             dvalue = (input[ii] - zero) / scale;
711 
712             if (dvalue < DUCHAR_MIN)
713             {
714                 *status = OVERFLOW_ERR;
715                 output[ii] = 0;
716             }
717             else if (dvalue > DUCHAR_MAX)
718             {
719                 *status = OVERFLOW_ERR;
720                 output[ii] = UCHAR_MAX;
721             }
722             else
723                 output[ii] = (unsigned char) (dvalue + .5);
724         }
725     }
726     return(*status);
727 }
728 /*--------------------------------------------------------------------------*/
ffuintfi2(unsigned int * input,long ntodo,double scale,double zero,short * output,int * status)729 int ffuintfi2(unsigned int *input,  /* I - array of values to be converted  */
730             long ntodo,        /* I - number of elements in the array  */
731             double scale,      /* I - FITS TSCALn or BSCALE value      */
732             double zero,       /* I - FITS TZEROn or BZERO  value      */
733             short *output,     /* O - output array of converted values */
734             int *status)       /* IO - error status                    */
735 /*
736   Copy input to output prior to writing output to a FITS file.
737   Do datatype conversion and scaling if required.
738 */
739 {
740     long ii;
741     double dvalue;
742 
743     if (scale == 1. && zero == 0.)
744     {
745         for (ii = 0; ii < ntodo; ii++)
746         {
747             if (input[ii] > SHRT_MAX)
748             {
749                 *status = OVERFLOW_ERR;
750                 output[ii] = SHRT_MAX;
751             }
752             else
753                 output[ii] = input[ii];
754         }
755     }
756     else
757     {
758         for (ii = 0; ii < ntodo; ii++)
759         {
760             dvalue = (input[ii] - zero) / scale;
761 
762             if (dvalue < DSHRT_MIN)
763             {
764                 *status = OVERFLOW_ERR;
765                 output[ii] = SHRT_MIN;
766             }
767             else if (dvalue > DSHRT_MAX)
768             {
769                 *status = OVERFLOW_ERR;
770                 output[ii] = SHRT_MAX;
771             }
772             else
773             {
774                 if (dvalue >= 0)
775                     output[ii] = (short) (dvalue + .5);
776                 else
777                     output[ii] = (short) (dvalue - .5);
778             }
779         }
780     }
781     return(*status);
782 }
783 /*--------------------------------------------------------------------------*/
ffuintfi4(unsigned int * input,long ntodo,double scale,double zero,INT32BIT * output,int * status)784 int ffuintfi4(unsigned int *input,  /* I - array of values to be converted  */
785             long ntodo,        /* I - number of elements in the array  */
786             double scale,      /* I - FITS TSCALn or BSCALE value      */
787             double zero,       /* I - FITS TZEROn or BZERO  value      */
788             INT32BIT *output,  /* O - output array of converted values */
789             int *status)       /* IO - error status                    */
790 /*
791   Copy input to output prior to writing output to a FITS file.
792   Do datatype conversion and scaling if required
793 */
794 {
795     long ii;
796     double dvalue;
797 
798     if (scale == 1. && zero == 2147483648.)
799     {
800         /* Instead of subtracting 2147483648, it is more efficient */
801         /* to just flip the sign bit with the XOR operator */
802 
803         for (ii = 0; ii < ntodo; ii++)
804              output[ii] =  ( *(int *) &input[ii] ) ^ 0x80000000;
805     }
806     else if (scale == 1. && zero == 0.)
807     {
808         for (ii = 0; ii < ntodo; ii++)
809         {
810             if (input[ii] > INT32_MAX)
811             {
812                 *status = OVERFLOW_ERR;
813                 output[ii] = INT32_MAX;
814             }
815             else
816                 output[ii] = input[ii];
817         }
818     }
819     else
820     {
821         for (ii = 0; ii < ntodo; ii++)
822         {
823             dvalue = (input[ii] - zero) / scale;
824 
825             if (dvalue < DINT_MIN)
826             {
827                 *status = OVERFLOW_ERR;
828                 output[ii] = INT32_MIN;
829             }
830             else if (dvalue > DINT_MAX)
831             {
832                 *status = OVERFLOW_ERR;
833                 output[ii] = INT32_MAX;
834             }
835             else
836             {
837                 if (dvalue >= 0)
838                     output[ii] = (INT32BIT) (dvalue + .5);
839                 else
840                     output[ii] = (INT32BIT) (dvalue - .5);
841             }
842         }
843     }
844     return(*status);
845 }
846 /*--------------------------------------------------------------------------*/
ffuintfi8(unsigned int * input,long ntodo,double scale,double zero,LONGLONG * output,int * status)847 int ffuintfi8(unsigned int *input,  /* I - array of values to be converted  */
848             long ntodo,             /* I - number of elements in the array  */
849             double scale,           /* I - FITS TSCALn or BSCALE value      */
850             double zero,            /* I - FITS TZEROn or BZERO  value      */
851             LONGLONG *output,       /* O - output array of converted values */
852             int *status)            /* IO - error status                    */
853 /*
854   Copy input to output prior to writing output to a FITS file.
855   Do datatype conversion and scaling if required
856 */
857 {
858     long ii;
859     double dvalue;
860 
861     if (scale == 1. && zero ==  9223372036854775808.)
862     {
863         /* Writing to unsigned long long column. */
864         /* Instead of subtracting 9223372036854775808, it is more efficient */
865         /* and more precise to just flip the sign bit with the XOR operator */
866 
867         /* no need to check range limits because all unsigned int values */
868 	/* are valid ULONGLONG values. */
869 
870         for (ii = 0; ii < ntodo; ii++) {
871              output[ii] =  ((LONGLONG) input[ii]) ^ 0x8000000000000000;
872         }
873     }
874     else if (scale == 1. && zero == 0.)
875     {
876         for (ii = 0; ii < ntodo; ii++) {
877                 output[ii] = input[ii];
878         }
879     }
880     else
881     {
882         for (ii = 0; ii < ntodo; ii++)
883         {
884             dvalue = (input[ii] - zero) / scale;
885 
886             if (dvalue < DLONGLONG_MIN)
887             {
888                 *status = OVERFLOW_ERR;
889                 output[ii] = LONGLONG_MIN;
890             }
891             else if (dvalue > DLONGLONG_MAX)
892             {
893                 *status = OVERFLOW_ERR;
894                 output[ii] = LONGLONG_MAX;
895             }
896             else
897             {
898                 if (dvalue >= 0)
899                     output[ii] = (LONGLONG) (dvalue + .5);
900                 else
901                     output[ii] = (LONGLONG) (dvalue - .5);
902             }
903         }
904     }
905     return(*status);
906 }
907 /*--------------------------------------------------------------------------*/
ffuintfr4(unsigned int * input,long ntodo,double scale,double zero,float * output,int * status)908 int ffuintfr4(unsigned int *input,  /* I - array of values to be converted  */
909             long ntodo,        /* I - number of elements in the array  */
910             double scale,      /* I - FITS TSCALn or BSCALE value      */
911             double zero,       /* I - FITS TZEROn or BZERO  value      */
912             float *output,     /* O - output array of converted values */
913             int *status)       /* IO - error status                    */
914 /*
915   Copy input to output prior to writing output to a FITS file.
916   Do datatype conversion and scaling if required.
917 */
918 {
919     long ii;
920 
921     if (scale == 1. && zero == 0.)
922     {
923         for (ii = 0; ii < ntodo; ii++)
924                 output[ii] = (float) input[ii];
925     }
926     else
927     {
928         for (ii = 0; ii < ntodo; ii++)
929             output[ii] = (float) ((input[ii] - zero) / scale);
930     }
931     return(*status);
932 }
933 /*--------------------------------------------------------------------------*/
ffuintfr8(unsigned int * input,long ntodo,double scale,double zero,double * output,int * status)934 int ffuintfr8(unsigned int *input,  /* I - array of values to be converted  */
935             long ntodo,        /* I - number of elements in the array  */
936             double scale,      /* I - FITS TSCALn or BSCALE value      */
937             double zero,       /* I - FITS TZEROn or BZERO  value      */
938             double *output,    /* O - output array of converted values */
939             int *status)       /* IO - error status                    */
940 /*
941   Copy input to output prior to writing output to a FITS file.
942   Do datatype conversion and scaling if required.
943 */
944 {
945     long ii;
946 
947     if (scale == 1. && zero == 0.)
948     {
949         for (ii = 0; ii < ntodo; ii++)
950                 output[ii] = (double) input[ii];
951     }
952     else
953     {
954         for (ii = 0; ii < ntodo; ii++)
955             output[ii] = (input[ii] - zero) / scale;
956     }
957     return(*status);
958 }
959 /*--------------------------------------------------------------------------*/
ffuintfstr(unsigned int * input,long ntodo,double scale,double zero,char * cform,long twidth,char * output,int * status)960 int ffuintfstr(unsigned int *input, /* I - array of values to be converted  */
961             long ntodo,        /* I - number of elements in the array  */
962             double scale,      /* I - FITS TSCALn or BSCALE value      */
963             double zero,       /* I - FITS TZEROn or BZERO  value      */
964             char *cform,       /* I - format for output string values  */
965             long twidth,       /* I - width of each field, in chars    */
966             char *output,      /* O - output array of converted values */
967             int *status)       /* IO - error status                    */
968 /*
969   Copy input to output prior to writing output to a FITS file.
970   Do scaling if required.
971 */
972 {
973     long ii;
974     double dvalue;
975     char *cptr;
976 
977     cptr = output;
978 
979     if (scale == 1. && zero == 0.)
980     {
981         for (ii = 0; ii < ntodo; ii++)
982         {
983            sprintf(output, cform, (double) input[ii]);
984            output += twidth;
985 
986            if (*output)  /* if this char != \0, then overflow occurred */
987               *status = OVERFLOW_ERR;
988         }
989     }
990     else
991     {
992         for (ii = 0; ii < ntodo; ii++)
993         {
994           dvalue = (input[ii] - zero) / scale;
995           sprintf(output, cform, dvalue);
996           output += twidth;
997 
998           if (*output)  /* if this char != \0, then overflow occurred */
999             *status = OVERFLOW_ERR;
1000         }
1001     }
1002 
1003     /* replace any commas with periods (e.g., in French locale) */
1004     while ((cptr = strchr(cptr, ','))) *cptr = '.';
1005 
1006     return(*status);
1007 }
1008