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