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