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