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