1 /* This file, putcolj.c, contains routines that write data elements to */
2 /* a FITS image or table, with long 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 /*--------------------------------------------------------------------------*/
ffpprj(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,long * array,int * status)14 int ffpprj( 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 long *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 long 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, TLONG, firstelem, nelem,
41 0, array, &nullvalue, status);
42 return(*status);
43 }
44
45 row=maxvalue(1,group);
46
47 ffpclj(fptr, 2, row, firstelem, nelem, array, status);
48 return(*status);
49 }
50 /*--------------------------------------------------------------------------*/
ffppnj(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,long * array,long nulval,int * status)51 int ffppnj( 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 long *array, /* I - array of values that are written */
56 long 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 long 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, TLONG, firstelem, nelem,
82 1, array, &nullvalue, status);
83 return(*status);
84 }
85
86 row=maxvalue(1,group);
87
88 ffpcnj(fptr, 2, row, firstelem, nelem, array, nulval, status);
89 return(*status);
90 }
91 /*--------------------------------------------------------------------------*/
ffp2dj(fitsfile * fptr,long group,LONGLONG ncols,LONGLONG naxis1,LONGLONG naxis2,long * array,int * status)92 int ffp2dj(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 long *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
106 /* call the 3D writing routine, with the 3rd dimension = 1 */
107
108 ffp3dj(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
109
110 return(*status);
111 }
112 /*--------------------------------------------------------------------------*/
ffp3dj(fitsfile * fptr,long group,LONGLONG ncols,LONGLONG nrows,LONGLONG naxis1,LONGLONG naxis2,LONGLONG naxis3,long * array,int * status)113 int ffp3dj(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 long *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, TLONG, 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 ffpclj(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 (ffpclj(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 /*--------------------------------------------------------------------------*/
ffpssj(fitsfile * fptr,long group,long naxis,long * naxes,long * fpixel,long * lpixel,long * array,int * status)185 int ffpssj(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 long *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, TLONG, 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 (ffpclj(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 /*--------------------------------------------------------------------------*/
ffpgpj(fitsfile * fptr,long group,long firstelem,long nelem,long * array,int * status)310 int ffpgpj( 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 long *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 ffpclj(fptr, 1L, row, firstelem, nelem, array, status);
334 return(*status);
335 }
336 /*--------------------------------------------------------------------------*/
ffpclj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,long * array,int * status)337 int ffpclj( 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 long *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
349 with 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 == TLONG && LONGSIZE == 32)
397 {
398 writeraw = 1;
399 if (nelem < (LONGLONG)INT32_MAX) {
400 maxelem = nelem;
401 } else {
402 maxelem = INT32_MAX/8;
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 (TLONG):
434 if (writeraw)
435 {
436 /* write raw input bytes without conversion */
437 ffpi4b(fptr, ntodo, incre, (INT32BIT *) &array[next], status);
438 }
439 else
440 {
441 /* convert the raw data before writing to FITS file */
442 ffi4fi4(&array[next], ntodo, scale, zero,
443 (INT32BIT *) buffer, status);
444 ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
445 }
446
447 break;
448
449 case (TLONGLONG):
450
451 ffi4fi8(&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 ffi4fi1(&array[next], ntodo, scale, zero,
459 (unsigned char *) buffer, status);
460 ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
461 break;
462
463 case (TSHORT):
464
465 ffi4fi2(&array[next], ntodo, scale, zero,
466 (short *) buffer, status);
467 ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
468 break;
469
470 case (TFLOAT):
471
472 ffi4fr4(&array[next], ntodo, scale, zero,
473 (float *) buffer, status);
474 ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
475 break;
476
477 case (TDOUBLE):
478 ffi4fr8(&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 ffi4fstr(&array[next], ntodo, scale, zero, cform,
488 twidth, (char *) buffer, status);
489
490 if (incre == twidth) /* contiguous bytes */
491 ffpbyt(fptr, ntodo * twidth, buffer, status);
492 else
493 ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
494 status);
495
496 break;
497 }
498 /* can't write to string column, so fall thru to default: */
499
500 default: /* error trap */
501 snprintf(message, FLEN_ERRMSG,
502 "Cannot write numbers to column %d which has format %s",
503 colnum,tform);
504 ffpmsg(message);
505 if (hdutype == ASCII_TBL)
506 return(*status = BAD_ATABLE_FORMAT);
507 else
508 return(*status = BAD_BTABLE_FORMAT);
509
510 } /* End of switch block */
511
512 /*-------------------------*/
513 /* Check for fatal error */
514 /*-------------------------*/
515 if (*status > 0) /* test for error during previous write operation */
516 {
517 snprintf(message,FLEN_ERRMSG,
518 "Error writing elements %.0f thru %.0f of input data array (ffpclj).",
519 (double) (next+1), (double) (next+ntodo));
520 ffpmsg(message);
521 return(*status);
522 }
523
524 /*--------------------------------------------*/
525 /* increment the counters for the next loop */
526 /*--------------------------------------------*/
527 remain -= ntodo;
528 if (remain)
529 {
530 next += ntodo;
531 elemnum += ntodo;
532 if (elemnum == repeat) /* completed a row; start on next row */
533 {
534 elemnum = 0;
535 rownum++;
536 }
537 }
538 } /* End of main while Loop */
539
540
541 /*--------------------------------*/
542 /* check for numerical overflow */
543 /*--------------------------------*/
544 if (*status == OVERFLOW_ERR)
545 {
546 ffpmsg(
547 "Numerical overflow during type conversion while writing FITS data.");
548 *status = NUM_OVERFLOW;
549 }
550
551 return(*status);
552 }
553 /*--------------------------------------------------------------------------*/
ffpcnj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,long * array,long nulvalue,int * status)554 int ffpcnj( fitsfile *fptr, /* I - FITS file pointer */
555 int colnum, /* I - number of column to write (1 = 1st col) */
556 LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
557 LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
558 LONGLONG nelem, /* I - number of values to write */
559 long *array, /* I - array of values to write */
560 long nulvalue, /* I - value used to flag undefined pixels */
561 int *status) /* IO - error status */
562 /*
563 Write an array of elements to the specified column of a table. Any input
564 pixels equal to the value of nulvalue will be replaced by the appropriate
565 null value in the output FITS file.
566
567 The input array of values will be converted to the datatype of the column
568 and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
569 */
570 {
571 tcolumn *colptr;
572 LONGLONG ngood = 0, nbad = 0, ii;
573 LONGLONG repeat, first, fstelm, fstrow;
574 int tcode, overflow = 0;
575
576 if (*status > 0)
577 return(*status);
578
579 /* reset position to the correct HDU if necessary */
580 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
581 {
582 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
583 }
584 else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
585 {
586 if ( ffrdef(fptr, status) > 0) /* rescan header */
587 return(*status);
588 }
589
590 colptr = (fptr->Fptr)->tableptr; /* point to first column */
591 colptr += (colnum - 1); /* offset to correct column structure */
592
593 tcode = colptr->tdatatype;
594
595 if (tcode > 0)
596 repeat = colptr->trepeat; /* repeat count for this column */
597 else
598 repeat = firstelem -1 + nelem; /* variable length arrays */
599
600 /* if variable length array, first write the whole input vector,
601 then go back and fill in the nulls */
602 if (tcode < 0) {
603 if (ffpclj(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
604 if (*status == NUM_OVERFLOW)
605 {
606 /* ignore overflows, which are possibly the null pixel values */
607 /* overflow = 1; */
608 *status = 0;
609 } else {
610 return(*status);
611 }
612 }
613 }
614
615 /* absolute element number in the column */
616 first = (firstrow - 1) * repeat + firstelem;
617
618 for (ii = 0; ii < nelem; ii++)
619 {
620 if (array[ii] != nulvalue) /* is this a good pixel? */
621 {
622 if (nbad) /* write previous string of bad pixels */
623 {
624 fstelm = ii - nbad + first; /* absolute element number */
625 fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
626 fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
627
628 if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
629 return(*status);
630
631 nbad=0;
632 }
633
634 ngood = ngood + 1; /* the consecutive number of good pixels */
635 }
636 else
637 {
638 if (ngood) /* write previous string of good pixels */
639 {
640 fstelm = ii - ngood + first; /* absolute element number */
641 fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
642 fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
643
644 if (tcode > 0) { /* variable length arrays have already been written */
645 if (ffpclj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
646 status) > 0) {
647 if (*status == NUM_OVERFLOW)
648 {
649 overflow = 1;
650 *status = 0;
651 } else {
652 return(*status);
653 }
654 }
655 }
656 ngood=0;
657 }
658
659 nbad = nbad +1; /* the consecutive number of bad pixels */
660 }
661 }
662
663 /* finished loop; now just write the last set of pixels */
664
665 if (ngood) /* write last string of good pixels */
666 {
667 fstelm = ii - ngood + first; /* absolute element number */
668 fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
669 fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
670
671 if (tcode > 0) { /* variable length arrays have already been written */
672 ffpclj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
673 }
674 }
675 else if (nbad) /* write last string of bad pixels */
676 {
677 fstelm = ii - nbad + first; /* absolute element number */
678 fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
679 fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
680
681 ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
682 }
683
684 if (*status <= 0) {
685 if (overflow) {
686 *status = NUM_OVERFLOW;
687 }
688 }
689
690 return(*status);
691 }
692 /*--------------------------------------------------------------------------*/
ffi4fi1(long * input,long ntodo,double scale,double zero,unsigned char * output,int * status)693 int ffi4fi1(long *input, /* I - array of values to be converted */
694 long ntodo, /* I - number of elements in the array */
695 double scale, /* I - FITS TSCALn or BSCALE value */
696 double zero, /* I - FITS TZEROn or BZERO value */
697 unsigned char *output, /* O - output array of converted values */
698 int *status) /* IO - error status */
699 /*
700 Copy input to output prior to writing output to a FITS file.
701 Do datatype conversion and scaling if required.
702 */
703 {
704 long ii;
705 double dvalue;
706
707 if (scale == 1. && zero == 0.)
708 {
709 for (ii = 0; ii < ntodo; ii++)
710 {
711 if (input[ii] < 0)
712 {
713 *status = OVERFLOW_ERR;
714 output[ii] = 0;
715 }
716 else if (input[ii] > UCHAR_MAX)
717 {
718 *status = OVERFLOW_ERR;
719 output[ii] = UCHAR_MAX;
720 }
721 else
722 output[ii] = (unsigned char) input[ii];
723 }
724 }
725 else
726 {
727 for (ii = 0; ii < ntodo; ii++)
728 {
729 dvalue = (input[ii] - zero) / scale;
730
731 if (dvalue < DUCHAR_MIN)
732 {
733 *status = OVERFLOW_ERR;
734 output[ii] = 0;
735 }
736 else if (dvalue > DUCHAR_MAX)
737 {
738 *status = OVERFLOW_ERR;
739 output[ii] = UCHAR_MAX;
740 }
741 else
742 output[ii] = (unsigned char) (dvalue + .5);
743 }
744 }
745 return(*status);
746 }
747 /*--------------------------------------------------------------------------*/
ffi4fi2(long * input,long ntodo,double scale,double zero,short * output,int * status)748 int ffi4fi2(long *input, /* I - array of values to be converted */
749 long ntodo, /* I - number of elements in the array */
750 double scale, /* I - FITS TSCALn or BSCALE value */
751 double zero, /* I - FITS TZEROn or BZERO value */
752 short *output, /* O - output array of converted values */
753 int *status) /* IO - error status */
754 /*
755 Copy input to output prior to writing output to a FITS file.
756 Do datatype conversion and scaling if required.
757 */
758 {
759 long ii;
760 double dvalue;
761
762 if (scale == 1. && zero == 0.)
763 {
764 for (ii = 0; ii < ntodo; ii++)
765 {
766 if (input[ii] < SHRT_MIN)
767 {
768 *status = OVERFLOW_ERR;
769 output[ii] = SHRT_MIN;
770 }
771 else if (input[ii] > SHRT_MAX)
772 {
773 *status = OVERFLOW_ERR;
774 output[ii] = SHRT_MAX;
775 }
776 else
777 output[ii] = (short) input[ii];
778 }
779 }
780 else
781 {
782 for (ii = 0; ii < ntodo; ii++)
783 {
784 dvalue = (input[ii] - zero) / scale;
785
786 if (dvalue < DSHRT_MIN)
787 {
788 *status = OVERFLOW_ERR;
789 output[ii] = SHRT_MIN;
790 }
791 else if (dvalue > DSHRT_MAX)
792 {
793 *status = OVERFLOW_ERR;
794 output[ii] = SHRT_MAX;
795 }
796 else
797 {
798 if (dvalue >= 0)
799 output[ii] = (short) (dvalue + .5);
800 else
801 output[ii] = (short) (dvalue - .5);
802 }
803 }
804 }
805 return(*status);
806 }
807 /*--------------------------------------------------------------------------*/
ffi4fi4(long * input,long ntodo,double scale,double zero,INT32BIT * output,int * status)808 int ffi4fi4(long *input, /* I - array of values to be converted */
809 long ntodo, /* I - number of elements in the array */
810 double scale, /* I - FITS TSCALn or BSCALE value */
811 double zero, /* I - FITS TZEROn or BZERO value */
812 INT32BIT *output, /* O - output array of converted values */
813 int *status) /* IO - error status */
814 /*
815 Copy input to output prior to writing output to a FITS file.
816 Do datatype conversion and scaling if required
817 */
818 {
819 long ii;
820 double dvalue;
821
822 if (scale == 1. && zero == 0.)
823 {
824 for (ii = 0; ii < ntodo; ii++)
825 output[ii] = (INT32BIT) input[ii];
826 }
827 else
828 {
829 for (ii = 0; ii < ntodo; ii++)
830 {
831 dvalue = (input[ii] - zero) / scale;
832
833 if (dvalue < DINT_MIN)
834 {
835 *status = OVERFLOW_ERR;
836 output[ii] = INT32_MIN;
837 }
838 else if (dvalue > DINT_MAX)
839 {
840 *status = OVERFLOW_ERR;
841 output[ii] = INT32_MAX;
842 }
843 else
844 {
845 if (dvalue >= 0)
846 output[ii] = (INT32BIT) (dvalue + .5);
847 else
848 output[ii] = (INT32BIT) (dvalue - .5);
849 }
850 }
851 }
852 return(*status);
853 }
854 /*--------------------------------------------------------------------------*/
ffi4fi8(long * input,long ntodo,double scale,double zero,LONGLONG * output,int * status)855 int ffi4fi8(long *input, /* I - array of values to be converted */
856 long ntodo, /* I - number of elements in the array */
857 double scale, /* I - FITS TSCALn or BSCALE value */
858 double zero, /* I - FITS TZEROn or BZERO value */
859 LONGLONG *output, /* O - output array of converted values */
860 int *status) /* IO - error status */
861 /*
862 Copy input to output prior to writing output to a FITS file.
863 Do datatype conversion and scaling if required
864 */
865 {
866 long ii;
867 double dvalue;
868
869 if (scale == 1. && zero == 9223372036854775808.)
870 {
871 /* Writing to unsigned long long column. Input values must not be negative */
872 /* Instead of subtracting 9223372036854775808, it is more efficient */
873 /* and more precise to just flip the sign bit with the XOR operator */
874
875 for (ii = 0; ii < ntodo; ii++) {
876 if (input[ii] < 0) {
877 *status = OVERFLOW_ERR;
878 output[ii] = LONGLONG_MIN;
879 } else {
880 output[ii] = ((LONGLONG) input[ii]) ^ 0x8000000000000000;
881 }
882 }
883 }
884 else if (scale == 1. && zero == 0.)
885 {
886 for (ii = 0; ii < ntodo; ii++)
887 output[ii] = input[ii];
888 }
889 else
890 {
891 for (ii = 0; ii < ntodo; ii++)
892 {
893 dvalue = (input[ii] - zero) / scale;
894
895 if (dvalue < DLONGLONG_MIN)
896 {
897 *status = OVERFLOW_ERR;
898 output[ii] = LONGLONG_MIN;
899 }
900 else if (dvalue > DLONGLONG_MAX)
901 {
902 *status = OVERFLOW_ERR;
903 output[ii] = LONGLONG_MAX;
904 }
905 else
906 {
907 if (dvalue >= 0)
908 output[ii] = (LONGLONG) (dvalue + .5);
909 else
910 output[ii] = (LONGLONG) (dvalue - .5);
911 }
912 }
913 }
914 return(*status);
915 }
916 /*--------------------------------------------------------------------------*/
ffi4fr4(long * input,long ntodo,double scale,double zero,float * output,int * status)917 int ffi4fr4(long *input, /* I - array of values to be converted */
918 long ntodo, /* I - number of elements in the array */
919 double scale, /* I - FITS TSCALn or BSCALE value */
920 double zero, /* I - FITS TZEROn or BZERO value */
921 float *output, /* O - output array of converted values */
922 int *status) /* IO - error status */
923 /*
924 Copy input to output prior to writing output to a FITS file.
925 Do datatype conversion and scaling if required.
926 */
927 {
928 long ii;
929
930 if (scale == 1. && zero == 0.)
931 {
932 for (ii = 0; ii < ntodo; ii++)
933 output[ii] = (float) input[ii];
934 }
935 else
936 {
937 for (ii = 0; ii < ntodo; ii++)
938 output[ii] = (float) ((input[ii] - zero) / scale);
939 }
940 return(*status);
941 }
942 /*--------------------------------------------------------------------------*/
ffi4fr8(long * input,long ntodo,double scale,double zero,double * output,int * status)943 int ffi4fr8(long *input, /* I - array of values to be converted */
944 long ntodo, /* I - number of elements in the array */
945 double scale, /* I - FITS TSCALn or BSCALE value */
946 double zero, /* I - FITS TZEROn or BZERO value */
947 double *output, /* O - output array of converted values */
948 int *status) /* IO - error status */
949 /*
950 Copy input to output prior to writing output to a FITS file.
951 Do datatype conversion and scaling if required.
952 */
953 {
954 long ii;
955
956 if (scale == 1. && zero == 0.)
957 {
958 for (ii = 0; ii < ntodo; ii++)
959 output[ii] = (double) input[ii];
960 }
961 else
962 {
963 for (ii = 0; ii < ntodo; ii++)
964 output[ii] = (input[ii] - zero) / scale;
965 }
966 return(*status);
967 }
968 /*--------------------------------------------------------------------------*/
ffi4fstr(long * input,long ntodo,double scale,double zero,char * cform,long twidth,char * output,int * status)969 int ffi4fstr(long *input, /* I - array of values to be converted */
970 long ntodo, /* I - number of elements in the array */
971 double scale, /* I - FITS TSCALn or BSCALE value */
972 double zero, /* I - FITS TZEROn or BZERO value */
973 char *cform, /* I - format for output string values */
974 long twidth, /* I - width of each field, in chars */
975 char *output, /* O - output array of converted values */
976 int *status) /* IO - error status */
977 /*
978 Copy input to output prior to writing output to a FITS file.
979 Do scaling if required.
980 */
981 {
982 long ii;
983 double dvalue;
984 char *cptr;
985
986 cptr = output;
987
988 if (scale == 1. && zero == 0.)
989 {
990 for (ii = 0; ii < ntodo; ii++)
991 {
992 sprintf(output, cform, (double) input[ii]);
993 output += twidth;
994
995 if (*output) /* if this char != \0, then overflow occurred */
996 *status = OVERFLOW_ERR;
997 }
998 }
999 else
1000 {
1001 for (ii = 0; ii < ntodo; ii++)
1002 {
1003 dvalue = (input[ii] - zero) / scale;
1004 sprintf(output, cform, dvalue);
1005 output += twidth;
1006
1007 if (*output) /* if this char != \0, then overflow occurred */
1008 *status = OVERFLOW_ERR;
1009 }
1010 }
1011
1012 /* replace any commas with periods (e.g., in French locale) */
1013 while ((cptr = strchr(cptr, ','))) *cptr = '.';
1014
1015 return(*status);
1016 }
1017
1018 /* ======================================================================== */
1019 /* the following routines support the 'long long' data type */
1020 /* ======================================================================== */
1021
1022 /*--------------------------------------------------------------------------*/
ffpprjj(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,LONGLONG * array,int * status)1023 int ffpprjj(fitsfile *fptr, /* I - FITS file pointer */
1024 long group, /* I - group to write(1 = 1st group) */
1025 LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
1026 LONGLONG nelem, /* I - number of values to write */
1027 LONGLONG *array, /* I - array of values that are written */
1028 int *status) /* IO - error status */
1029 /*
1030 Write an array of values to the primary array. Data conversion
1031 and scaling will be performed if necessary (e.g, if the datatype of
1032 the FITS array is not the same as the array being written).
1033 */
1034 {
1035 long row;
1036
1037 /*
1038 the primary array is represented as a binary table:
1039 each group of the primary array is a row in the table,
1040 where the first column contains the group parameters
1041 and the second column contains the image itself.
1042 */
1043
1044 if (fits_is_compressed_image(fptr, status))
1045 {
1046 /* this is a compressed image in a binary table */
1047
1048 ffpmsg("writing TLONGLONG to compressed image is not supported");
1049
1050 return(*status = DATA_COMPRESSION_ERR);
1051 }
1052
1053 row=maxvalue(1,group);
1054
1055 ffpcljj(fptr, 2, row, firstelem, nelem, array, status);
1056 return(*status);
1057 }
1058 /*--------------------------------------------------------------------------*/
ffppnjj(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,LONGLONG * array,LONGLONG nulval,int * status)1059 int ffppnjj(fitsfile *fptr, /* I - FITS file pointer */
1060 long group, /* I - group to write(1 = 1st group) */
1061 LONGLONG firstelem, /* I - first vector element to write(1 = 1st) */
1062 LONGLONG nelem, /* I - number of values to write */
1063 LONGLONG *array, /* I - array of values that are written */
1064 LONGLONG nulval, /* I - undefined pixel value */
1065 int *status) /* IO - error status */
1066 /*
1067 Write an array of values to the primary array. Data conversion
1068 and scaling will be performed if necessary (e.g, if the datatype of the
1069 FITS array is not the same as the array being written). Any array values
1070 that are equal to the value of nulval will be replaced with the null
1071 pixel value that is appropriate for this column.
1072 */
1073 {
1074 long row;
1075
1076 /*
1077 the primary array is represented as a binary table:
1078 each group of the primary array is a row in the table,
1079 where the first column contains the group parameters
1080 and the second column contains the image itself.
1081 */
1082
1083 if (fits_is_compressed_image(fptr, status))
1084 {
1085 /* this is a compressed image in a binary table */
1086
1087 ffpmsg("writing TLONGLONG to compressed image is not supported");
1088
1089 return(*status = DATA_COMPRESSION_ERR);
1090 }
1091
1092 row=maxvalue(1,group);
1093
1094 ffpcnjj(fptr, 2, row, firstelem, nelem, array, nulval, status);
1095 return(*status);
1096 }
1097 /*--------------------------------------------------------------------------*/
ffp2djj(fitsfile * fptr,long group,LONGLONG ncols,LONGLONG naxis1,LONGLONG naxis2,LONGLONG * array,int * status)1098 int ffp2djj(fitsfile *fptr, /* I - FITS file pointer */
1099 long group, /* I - group to write(1 = 1st group) */
1100 LONGLONG ncols, /* I - number of pixels in each row of array */
1101 LONGLONG naxis1, /* I - FITS image NAXIS1 value */
1102 LONGLONG naxis2, /* I - FITS image NAXIS2 value */
1103 LONGLONG *array, /* I - array to be written */
1104 int *status) /* IO - error status */
1105 /*
1106 Write an entire 2-D array of values to the primary array. Data conversion
1107 and scaling will be performed if necessary (e.g, if the datatype of the
1108 FITS array is not the same as the array being written).
1109 */
1110 {
1111
1112 /* call the 3D writing routine, with the 3rd dimension = 1 */
1113
1114 ffp3djj(fptr, group, ncols, naxis2, naxis1, naxis2, 1, array, status);
1115
1116 return(*status);
1117 }
1118 /*--------------------------------------------------------------------------*/
ffp3djj(fitsfile * fptr,long group,LONGLONG ncols,LONGLONG nrows,LONGLONG naxis1,LONGLONG naxis2,LONGLONG naxis3,LONGLONG * array,int * status)1119 int ffp3djj(fitsfile *fptr, /* I - FITS file pointer */
1120 long group, /* I - group to write(1 = 1st group) */
1121 LONGLONG ncols, /* I - number of pixels in each row of array */
1122 LONGLONG nrows, /* I - number of rows in each plane of array */
1123 LONGLONG naxis1, /* I - FITS image NAXIS1 value */
1124 LONGLONG naxis2, /* I - FITS image NAXIS2 value */
1125 LONGLONG naxis3, /* I - FITS image NAXIS3 value */
1126 LONGLONG *array, /* I - array to be written */
1127 int *status) /* IO - error status */
1128 /*
1129 Write an entire 3-D cube of values to the primary array. Data conversion
1130 and scaling will be performed if necessary (e.g, if the datatype of the
1131 FITS array is not the same as the array being written).
1132 */
1133 {
1134 long tablerow, ii, jj;
1135 LONGLONG nfits, narray;
1136 /*
1137 the primary array is represented as a binary table:
1138 each group of the primary array is a row in the table,
1139 where the first column contains the group parameters
1140 and the second column contains the image itself.
1141 */
1142
1143 if (fits_is_compressed_image(fptr, status))
1144 {
1145 /* this is a compressed image in a binary table */
1146
1147 ffpmsg("writing TLONGLONG to compressed image is not supported");
1148
1149 return(*status = DATA_COMPRESSION_ERR);
1150 }
1151
1152 tablerow=maxvalue(1,group);
1153
1154 if (ncols == naxis1 && nrows == naxis2) /* arrays have same size? */
1155 {
1156 /* all the image pixels are contiguous, so write all at once */
1157 ffpcljj(fptr, 2, tablerow, 1L, naxis1 * naxis2 * naxis3, array, status);
1158 return(*status);
1159 }
1160
1161 if (ncols < naxis1 || nrows < naxis2)
1162 return(*status = BAD_DIMEN);
1163
1164 nfits = 1; /* next pixel in FITS image to write to */
1165 narray = 0; /* next pixel in input array to be written */
1166
1167 /* loop over naxis3 planes in the data cube */
1168 for (jj = 0; jj < naxis3; jj++)
1169 {
1170 /* loop over the naxis2 rows in the FITS image, */
1171 /* writing naxis1 pixels to each row */
1172
1173 for (ii = 0; ii < naxis2; ii++)
1174 {
1175 if (ffpcljj(fptr, 2, tablerow, nfits, naxis1,&array[narray],status) > 0)
1176 return(*status);
1177
1178 nfits += naxis1;
1179 narray += ncols;
1180 }
1181 narray += (nrows - naxis2) * ncols;
1182 }
1183 return(*status);
1184 }
1185 /*--------------------------------------------------------------------------*/
ffpssjj(fitsfile * fptr,long group,long naxis,long * naxes,long * fpixel,long * lpixel,LONGLONG * array,int * status)1186 int ffpssjj(fitsfile *fptr, /* I - FITS file pointer */
1187 long group, /* I - group to write(1 = 1st group) */
1188 long naxis, /* I - number of data axes in array */
1189 long *naxes, /* I - size of each FITS axis */
1190 long *fpixel, /* I - 1st pixel in each axis to write (1=1st) */
1191 long *lpixel, /* I - last pixel in each axis to write */
1192 LONGLONG *array, /* I - array to be written */
1193 int *status) /* IO - error status */
1194 /*
1195 Write a subsection of pixels to the primary array or image.
1196 A subsection is defined to be any contiguous rectangular
1197 array of pixels within the n-dimensional FITS data file.
1198 Data conversion and scaling will be performed if necessary
1199 (e.g, if the datatype of the FITS array is not the same as
1200 the array being written).
1201 */
1202 {
1203 long tablerow;
1204 LONGLONG fpix[7], dimen[7], astart, pstart;
1205 LONGLONG off2, off3, off4, off5, off6, off7;
1206 LONGLONG st10, st20, st30, st40, st50, st60, st70;
1207 LONGLONG st1, st2, st3, st4, st5, st6, st7;
1208 long ii, i1, i2, i3, i4, i5, i6, i7, irange[7];
1209
1210 if (*status > 0)
1211 return(*status);
1212
1213 if (fits_is_compressed_image(fptr, status))
1214 {
1215 /* this is a compressed image in a binary table */
1216
1217 ffpmsg("writing TLONGLONG to compressed image is not supported");
1218
1219 return(*status = DATA_COMPRESSION_ERR);
1220 }
1221
1222 if (naxis < 1 || naxis > 7)
1223 return(*status = BAD_DIMEN);
1224
1225 tablerow=maxvalue(1,group);
1226
1227 /* calculate the size and number of loops to perform in each dimension */
1228 for (ii = 0; ii < 7; ii++)
1229 {
1230 fpix[ii]=1;
1231 irange[ii]=1;
1232 dimen[ii]=1;
1233 }
1234
1235 for (ii = 0; ii < naxis; ii++)
1236 {
1237 fpix[ii]=fpixel[ii];
1238 irange[ii]=lpixel[ii]-fpixel[ii]+1;
1239 dimen[ii]=naxes[ii];
1240 }
1241
1242 i1=irange[0];
1243
1244 /* compute the pixel offset between each dimension */
1245 off2 = dimen[0];
1246 off3 = off2 * dimen[1];
1247 off4 = off3 * dimen[2];
1248 off5 = off4 * dimen[3];
1249 off6 = off5 * dimen[4];
1250 off7 = off6 * dimen[5];
1251
1252 st10 = fpix[0];
1253 st20 = (fpix[1] - 1) * off2;
1254 st30 = (fpix[2] - 1) * off3;
1255 st40 = (fpix[3] - 1) * off4;
1256 st50 = (fpix[4] - 1) * off5;
1257 st60 = (fpix[5] - 1) * off6;
1258 st70 = (fpix[6] - 1) * off7;
1259
1260 /* store the initial offset in each dimension */
1261 st1 = st10;
1262 st2 = st20;
1263 st3 = st30;
1264 st4 = st40;
1265 st5 = st50;
1266 st6 = st60;
1267 st7 = st70;
1268
1269 astart = 0;
1270
1271 for (i7 = 0; i7 < irange[6]; i7++)
1272 {
1273 for (i6 = 0; i6 < irange[5]; i6++)
1274 {
1275 for (i5 = 0; i5 < irange[4]; i5++)
1276 {
1277 for (i4 = 0; i4 < irange[3]; i4++)
1278 {
1279 for (i3 = 0; i3 < irange[2]; i3++)
1280 {
1281 pstart = st1 + st2 + st3 + st4 + st5 + st6 + st7;
1282
1283 for (i2 = 0; i2 < irange[1]; i2++)
1284 {
1285 if (ffpcljj(fptr, 2, tablerow, pstart, i1, &array[astart],
1286 status) > 0)
1287 return(*status);
1288
1289 astart += i1;
1290 pstart += off2;
1291 }
1292 st2 = st20;
1293 st3 = st3+off3;
1294 }
1295 st3 = st30;
1296 st4 = st4+off4;
1297 }
1298 st4 = st40;
1299 st5 = st5+off5;
1300 }
1301 st5 = st50;
1302 st6 = st6+off6;
1303 }
1304 st6 = st60;
1305 st7 = st7+off7;
1306 }
1307 return(*status);
1308 }
1309 /*--------------------------------------------------------------------------*/
ffpgpjj(fitsfile * fptr,long group,long firstelem,long nelem,LONGLONG * array,int * status)1310 int ffpgpjj(fitsfile *fptr, /* I - FITS file pointer */
1311 long group, /* I - group to write(1 = 1st group) */
1312 long firstelem, /* I - first vector element to write(1 = 1st) */
1313 long nelem, /* I - number of values to write */
1314 LONGLONG *array, /* I - array of values that are written */
1315 int *status) /* IO - error status */
1316 /*
1317 Write an array of group parameters to the primary array. Data conversion
1318 and scaling will be performed if necessary (e.g, if the datatype of
1319 the FITS array is not the same as the array being written).
1320 */
1321 {
1322 long row;
1323
1324 /*
1325 the primary array is represented as a binary table:
1326 each group of the primary array is a row in the table,
1327 where the first column contains the group parameters
1328 and the second column contains the image itself.
1329 */
1330
1331 row=maxvalue(1,group);
1332
1333 ffpcljj(fptr, 1L, row, firstelem, nelem, array, status);
1334 return(*status);
1335 }
1336 /*--------------------------------------------------------------------------*/
ffpcljj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,LONGLONG * array,int * status)1337 int ffpcljj(fitsfile *fptr, /* I - FITS file pointer */
1338 int colnum, /* I - number of column to write (1 = 1st col) */
1339 LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
1340 LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
1341 LONGLONG nelem, /* I - number of values to write */
1342 LONGLONG *array, /* I - array of values to write */
1343 int *status) /* IO - error status */
1344 /*
1345 Write an array of values to a column in the current FITS HDU.
1346 The column number may refer to a real column in an ASCII or binary table,
1347 or it may refer to a virtual column in a 1 or more grouped FITS primary
1348 array. FITSIO treats a primary array as a binary table
1349 with 2 vector columns: the first column contains the group parameters (often
1350 with length = 0) and the second column contains the array of image pixels.
1351 Each row of the table represents a group in the case of multigroup FITS
1352 images.
1353
1354 The input array of values will be converted to the datatype of the column
1355 and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary.
1356 */
1357 {
1358 int tcode, maxelem2, hdutype, writeraw;
1359 long twidth, incre;
1360 long ntodo;
1361 LONGLONG repeat, startpos, elemnum, wrtptr, rowlen, rownum, remain, next, tnull, maxelem;
1362 double scale, zero;
1363 char tform[20], cform[20];
1364 char message[FLEN_ERRMSG];
1365
1366 char snull[20]; /* the FITS null value */
1367
1368 double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
1369 void *buffer;
1370
1371 if (*status > 0) /* inherit input status value if > 0 */
1372 return(*status);
1373
1374 buffer = cbuff;
1375
1376 /*---------------------------------------------------*/
1377 /* Check input and get parameters about the column: */
1378 /*---------------------------------------------------*/
1379 if (ffgcprll( fptr, colnum, firstrow, firstelem, nelem, 1, &scale, &zero,
1380 tform, &twidth, &tcode, &maxelem2, &startpos, &elemnum, &incre,
1381 &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0)
1382 return(*status);
1383 maxelem = maxelem2;
1384
1385 if (tcode == TSTRING)
1386 ffcfmt(tform, cform); /* derive C format for writing strings */
1387
1388 /*
1389 if there is no scaling and the native machine format is not byteswapped
1390 then we can simply write the raw data bytes into the FITS file if the
1391 datatype of the FITS column is the same as the input values. Otherwise
1392 we must convert the raw values into the scaled and/or machine dependent
1393 format in a temporary buffer that has been allocated for this purpose.
1394 */
1395 if (scale == 1. && zero == 0. &&
1396 MACHINE == NATIVE && tcode == TLONGLONG)
1397 {
1398 writeraw = 1;
1399 if (nelem < (LONGLONG)INT32_MAX/8) {
1400 maxelem = nelem;
1401 } else {
1402 maxelem = INT32_MAX/8;
1403 }
1404 }
1405 else
1406 writeraw = 0;
1407
1408 /*---------------------------------------------------------------------*/
1409 /* Now write the pixels to the FITS column. */
1410 /* First call the ffXXfYY routine to (1) convert the datatype */
1411 /* if necessary, and (2) scale the values by the FITS TSCALn and */
1412 /* TZEROn linear scaling parameters into a temporary buffer. */
1413 /*---------------------------------------------------------------------*/
1414 remain = nelem; /* remaining number of values to write */
1415 next = 0; /* next element in array to be written */
1416 rownum = 0; /* row number, relative to firstrow */
1417
1418 while (remain)
1419 {
1420 /* limit the number of pixels to process a one time to the number that
1421 will fit in the buffer space or to the number of pixels that remain
1422 in the current vector, which ever is smaller.
1423 */
1424 ntodo = (long) minvalue(remain, maxelem);
1425 ntodo = (long) minvalue(ntodo, (repeat - elemnum));
1426
1427 wrtptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * incre);
1428
1429 ffmbyt(fptr, wrtptr, IGNORE_EOF, status); /* move to write position */
1430
1431 switch (tcode)
1432 {
1433 case (TLONGLONG):
1434 if (writeraw)
1435 {
1436 /* write raw input bytes without conversion */
1437 ffpi8b(fptr, ntodo, incre, (long *) &array[next], status);
1438 }
1439 else
1440 {
1441 /* convert the raw data before writing to FITS file */
1442 ffi8fi8(&array[next], ntodo, scale, zero,
1443 (LONGLONG *) buffer, status);
1444 ffpi8b(fptr, ntodo, incre, (long *) buffer, status);
1445 }
1446
1447 break;
1448
1449 case (TLONG):
1450
1451 ffi8fi4(&array[next], ntodo, scale, zero,
1452 (INT32BIT *) buffer, status);
1453 ffpi4b(fptr, ntodo, incre, (INT32BIT *) buffer, status);
1454 break;
1455
1456 case (TBYTE):
1457
1458 ffi8fi1(&array[next], ntodo, scale, zero,
1459 (unsigned char *) buffer, status);
1460 ffpi1b(fptr, ntodo, incre, (unsigned char *) buffer, status);
1461 break;
1462
1463 case (TSHORT):
1464
1465 ffi8fi2(&array[next], ntodo, scale, zero,
1466 (short *) buffer, status);
1467 ffpi2b(fptr, ntodo, incre, (short *) buffer, status);
1468 break;
1469
1470 case (TFLOAT):
1471
1472 ffi8fr4(&array[next], ntodo, scale, zero,
1473 (float *) buffer, status);
1474 ffpr4b(fptr, ntodo, incre, (float *) buffer, status);
1475 break;
1476
1477 case (TDOUBLE):
1478 ffi8fr8(&array[next], ntodo, scale, zero,
1479 (double *) buffer, status);
1480 ffpr8b(fptr, ntodo, incre, (double *) buffer, status);
1481 break;
1482
1483 case (TSTRING): /* numerical column in an ASCII table */
1484
1485 if (cform[1] != 's') /* "%s" format is a string */
1486 {
1487 ffi8fstr(&array[next], ntodo, scale, zero, cform,
1488 twidth, (char *) buffer, status);
1489
1490 if (incre == twidth) /* contiguous bytes */
1491 ffpbyt(fptr, ntodo * twidth, buffer, status);
1492 else
1493 ffpbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
1494 status);
1495
1496 break;
1497 }
1498 /* can't write to string column, so fall thru to default: */
1499
1500 default: /* error trap */
1501 snprintf(message, FLEN_ERRMSG,
1502 "Cannot write numbers to column %d which has format %s",
1503 colnum,tform);
1504 ffpmsg(message);
1505 if (hdutype == ASCII_TBL)
1506 return(*status = BAD_ATABLE_FORMAT);
1507 else
1508 return(*status = BAD_BTABLE_FORMAT);
1509
1510 } /* End of switch block */
1511
1512 /*-------------------------*/
1513 /* Check for fatal error */
1514 /*-------------------------*/
1515 if (*status > 0) /* test for error during previous write operation */
1516 {
1517 snprintf(message,FLEN_ERRMSG,
1518 "Error writing elements %.0f thru %.0f of input data array (ffpclj).",
1519 (double) (next+1), (double) (next+ntodo));
1520 ffpmsg(message);
1521 return(*status);
1522 }
1523
1524 /*--------------------------------------------*/
1525 /* increment the counters for the next loop */
1526 /*--------------------------------------------*/
1527 remain -= ntodo;
1528 if (remain)
1529 {
1530 next += ntodo;
1531 elemnum += ntodo;
1532 if (elemnum == repeat) /* completed a row; start on next row */
1533 {
1534 elemnum = 0;
1535 rownum++;
1536 }
1537 }
1538 } /* End of main while Loop */
1539
1540
1541 /*--------------------------------*/
1542 /* check for numerical overflow */
1543 /*--------------------------------*/
1544 if (*status == OVERFLOW_ERR)
1545 {
1546 ffpmsg(
1547 "Numerical overflow during type conversion while writing FITS data.");
1548 *status = NUM_OVERFLOW;
1549 }
1550
1551 return(*status);
1552 }
1553 /*--------------------------------------------------------------------------*/
ffpcnjj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,LONGLONG * array,LONGLONG nulvalue,int * status)1554 int ffpcnjj(fitsfile *fptr, /* I - FITS file pointer */
1555 int colnum, /* I - number of column to write (1 = 1st col) */
1556 LONGLONG firstrow, /* I - first row to write (1 = 1st row) */
1557 LONGLONG firstelem, /* I - first vector element to write (1 = 1st) */
1558 LONGLONG nelem, /* I - number of values to write */
1559 LONGLONG *array, /* I - array of values to write */
1560 LONGLONG nulvalue, /* I - value used to flag undefined pixels */
1561 int *status) /* IO - error status */
1562 /*
1563 Write an array of elements to the specified column of a table. Any input
1564 pixels equal to the value of nulvalue will be replaced by the appropriate
1565 null value in the output FITS file.
1566
1567 The input array of values will be converted to the datatype of the column
1568 and will be inverse-scaled by the FITS TSCALn and TZEROn values if necessary
1569 */
1570 {
1571 tcolumn *colptr;
1572 LONGLONG ngood = 0, nbad = 0, ii;
1573 LONGLONG repeat, first, fstelm, fstrow;
1574 int tcode, overflow = 0;
1575
1576 if (*status > 0)
1577 return(*status);
1578
1579 /* reset position to the correct HDU if necessary */
1580 if (fptr->HDUposition != (fptr->Fptr)->curhdu)
1581 {
1582 ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
1583 }
1584 else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
1585 {
1586 if ( ffrdef(fptr, status) > 0) /* rescan header */
1587 return(*status);
1588 }
1589
1590 colptr = (fptr->Fptr)->tableptr; /* point to first column */
1591 colptr += (colnum - 1); /* offset to correct column structure */
1592
1593 tcode = colptr->tdatatype;
1594
1595 if (tcode > 0)
1596 repeat = colptr->trepeat; /* repeat count for this column */
1597 else
1598 repeat = firstelem -1 + nelem; /* variable length arrays */
1599
1600 /* if variable length array, first write the whole input vector,
1601 then go back and fill in the nulls */
1602 if (tcode < 0) {
1603 if (ffpcljj(fptr, colnum, firstrow, firstelem, nelem, array, status) > 0) {
1604 if (*status == NUM_OVERFLOW)
1605 {
1606 /* ignore overflows, which are possibly the null pixel values */
1607 /* overflow = 1; */
1608 *status = 0;
1609 } else {
1610 return(*status);
1611 }
1612 }
1613 }
1614
1615 /* absolute element number in the column */
1616 first = (firstrow - 1) * repeat + firstelem;
1617
1618 for (ii = 0; ii < nelem; ii++)
1619 {
1620 if (array[ii] != nulvalue) /* is this a good pixel? */
1621 {
1622 if (nbad) /* write previous string of bad pixels */
1623 {
1624 fstelm = ii - nbad + first; /* absolute element number */
1625 fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
1626 fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
1627
1628 if (ffpclu(fptr, colnum, fstrow, fstelm, nbad, status) > 0)
1629 return(*status);
1630
1631 nbad=0;
1632 }
1633
1634 ngood = ngood +1; /* the consecutive number of good pixels */
1635 }
1636 else
1637 {
1638 if (ngood) /* write previous string of good pixels */
1639 {
1640 fstelm = ii - ngood + first; /* absolute element number */
1641 fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
1642 fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
1643
1644 if (tcode > 0) { /* variable length arrays have already been written */
1645 if (ffpcljj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood],
1646 status) > 0) {
1647 if (*status == NUM_OVERFLOW)
1648 {
1649 overflow = 1;
1650 *status = 0;
1651 } else {
1652 return(*status);
1653 }
1654 }
1655 }
1656 ngood=0;
1657 }
1658
1659 nbad = nbad +1; /* the consecutive number of bad pixels */
1660 }
1661 }
1662
1663 /* finished loop; now just write the last set of pixels */
1664
1665 if (ngood) /* write last string of good pixels */
1666 {
1667 fstelm = ii - ngood + first; /* absolute element number */
1668 fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
1669 fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
1670
1671 if (tcode > 0) { /* variable length arrays have already been written */
1672 ffpcljj(fptr, colnum, fstrow, fstelm, ngood, &array[ii-ngood], status);
1673 }
1674 }
1675 else if (nbad) /* write last string of bad pixels */
1676 {
1677 fstelm = ii - nbad + first; /* absolute element number */
1678 fstrow = (fstelm - 1) / repeat + 1; /* starting row number */
1679 fstelm = fstelm - (fstrow - 1) * repeat; /* relative number */
1680
1681 ffpclu(fptr, colnum, fstrow, fstelm, nbad, status);
1682 }
1683
1684 if (*status <= 0) {
1685 if (overflow) {
1686 *status = NUM_OVERFLOW;
1687 }
1688 }
1689
1690 return(*status);
1691 }
1692 /*--------------------------------------------------------------------------*/
ffi8fi1(LONGLONG * input,long ntodo,double scale,double zero,unsigned char * output,int * status)1693 int ffi8fi1(LONGLONG *input, /* I - array of values to be converted */
1694 long ntodo, /* I - number of elements in the array */
1695 double scale, /* I - FITS TSCALn or BSCALE value */
1696 double zero, /* I - FITS TZEROn or BZERO value */
1697 unsigned char *output, /* O - output array of converted values */
1698 int *status) /* IO - error status */
1699 /*
1700 Copy input to output prior to writing output to a FITS file.
1701 Do datatype conversion and scaling if required.
1702 */
1703 {
1704 long ii;
1705 double dvalue;
1706
1707 if (scale == 1. && zero == 0.)
1708 {
1709 for (ii = 0; ii < ntodo; ii++)
1710 {
1711 if (input[ii] < 0)
1712 {
1713 *status = OVERFLOW_ERR;
1714 output[ii] = 0;
1715 }
1716 else if (input[ii] > UCHAR_MAX)
1717 {
1718 *status = OVERFLOW_ERR;
1719 output[ii] = UCHAR_MAX;
1720 }
1721 else
1722 output[ii] = (unsigned char) input[ii];
1723 }
1724 }
1725 else
1726 {
1727 for (ii = 0; ii < ntodo; ii++)
1728 {
1729 dvalue = (input[ii] - zero) / scale;
1730
1731 if (dvalue < DUCHAR_MIN)
1732 {
1733 *status = OVERFLOW_ERR;
1734 output[ii] = 0;
1735 }
1736 else if (dvalue > DUCHAR_MAX)
1737 {
1738 *status = OVERFLOW_ERR;
1739 output[ii] = UCHAR_MAX;
1740 }
1741 else
1742 output[ii] = (unsigned char) (dvalue + .5);
1743 }
1744 }
1745 return(*status);
1746 }
1747 /*--------------------------------------------------------------------------*/
ffi8fi2(LONGLONG * input,long ntodo,double scale,double zero,short * output,int * status)1748 int ffi8fi2(LONGLONG *input, /* I - array of values to be converted */
1749 long ntodo, /* I - number of elements in the array */
1750 double scale, /* I - FITS TSCALn or BSCALE value */
1751 double zero, /* I - FITS TZEROn or BZERO value */
1752 short *output, /* O - output array of converted values */
1753 int *status) /* IO - error status */
1754 /*
1755 Copy input to output prior to writing output to a FITS file.
1756 Do datatype conversion and scaling if required.
1757 */
1758 {
1759 long ii;
1760 double dvalue;
1761
1762 if (scale == 1. && zero == 0.)
1763 {
1764 for (ii = 0; ii < ntodo; ii++)
1765 {
1766 if (input[ii] < SHRT_MIN)
1767 {
1768 *status = OVERFLOW_ERR;
1769 output[ii] = SHRT_MIN;
1770 }
1771 else if (input[ii] > SHRT_MAX)
1772 {
1773 *status = OVERFLOW_ERR;
1774 output[ii] = SHRT_MAX;
1775 }
1776 else
1777 output[ii] = (short) input[ii];
1778 }
1779 }
1780 else
1781 {
1782 for (ii = 0; ii < ntodo; ii++)
1783 {
1784 dvalue = (input[ii] - zero) / scale;
1785
1786 if (dvalue < DSHRT_MIN)
1787 {
1788 *status = OVERFLOW_ERR;
1789 output[ii] = SHRT_MIN;
1790 }
1791 else if (dvalue > DSHRT_MAX)
1792 {
1793 *status = OVERFLOW_ERR;
1794 output[ii] = SHRT_MAX;
1795 }
1796 else
1797 {
1798 if (dvalue >= 0)
1799 output[ii] = (short) (dvalue + .5);
1800 else
1801 output[ii] = (short) (dvalue - .5);
1802 }
1803 }
1804 }
1805 return(*status);
1806 }
1807 /*--------------------------------------------------------------------------*/
ffi8fi4(LONGLONG * input,long ntodo,double scale,double zero,INT32BIT * output,int * status)1808 int ffi8fi4(LONGLONG *input, /* I - array of values to be converted */
1809 long ntodo, /* I - number of elements in the array */
1810 double scale, /* I - FITS TSCALn or BSCALE value */
1811 double zero, /* I - FITS TZEROn or BZERO value */
1812 INT32BIT *output, /* O - output array of converted values */
1813 int *status) /* IO - error status */
1814 /*
1815 Copy input to output prior to writing output to a FITS file.
1816 Do datatype conversion and scaling if required
1817 */
1818 {
1819 long ii;
1820 double dvalue;
1821
1822 if (scale == 1. && zero == 0.)
1823 {
1824 for (ii = 0; ii < ntodo; ii++)
1825 {
1826 if (input[ii] < INT32_MIN)
1827 {
1828 *status = OVERFLOW_ERR;
1829 output[ii] = INT32_MIN;
1830 }
1831 else if (input[ii] > INT32_MAX)
1832 {
1833 *status = OVERFLOW_ERR;
1834 output[ii] = INT32_MAX;
1835 }
1836 else
1837 output[ii] = (INT32BIT) input[ii];
1838 }
1839 }
1840 else
1841 {
1842 for (ii = 0; ii < ntodo; ii++)
1843 {
1844 dvalue = (input[ii] - zero) / scale;
1845
1846 if (dvalue < DINT_MIN)
1847 {
1848 *status = OVERFLOW_ERR;
1849 output[ii] = INT32_MIN;
1850 }
1851 else if (dvalue > DINT_MAX)
1852 {
1853 *status = OVERFLOW_ERR;
1854 output[ii] = INT32_MAX;
1855 }
1856 else
1857 {
1858 if (dvalue >= 0)
1859 output[ii] = (INT32BIT) (dvalue + .5);
1860 else
1861 output[ii] = (INT32BIT) (dvalue - .5);
1862 }
1863 }
1864 }
1865 return(*status);
1866 }
1867 /*--------------------------------------------------------------------------*/
ffi8fi8(LONGLONG * input,long ntodo,double scale,double zero,LONGLONG * output,int * status)1868 int ffi8fi8(LONGLONG *input, /* I - array of values to be converted */
1869 long ntodo, /* I - number of elements in the array */
1870 double scale, /* I - FITS TSCALn or BSCALE value */
1871 double zero, /* I - FITS TZEROn or BZERO value */
1872 LONGLONG *output, /* O - output array of converted values */
1873 int *status) /* IO - error status */
1874 /*
1875 Copy input to output prior to writing output to a FITS file.
1876 Do datatype conversion and scaling if required
1877 */
1878 {
1879 long ii;
1880 double dvalue;
1881
1882 if (scale == 1. && zero == 9223372036854775808.)
1883 {
1884 /* Writing to unsigned long long column. Input values must not be negative */
1885 /* Instead of subtracting 9223372036854775808, it is more efficient */
1886 /* and more precise to just flip the sign bit with the XOR operator */
1887
1888 for (ii = 0; ii < ntodo; ii++) {
1889 if (input[ii] < 0) {
1890 *status = OVERFLOW_ERR;
1891 output[ii] = LONGLONG_MIN;
1892 } else {
1893 output[ii] = (input[ii]) ^ 0x8000000000000000;
1894 }
1895 }
1896 }
1897 else if (scale == 1. && zero == 0.)
1898 {
1899 for (ii = 0; ii < ntodo; ii++)
1900 output[ii] = input[ii];
1901 }
1902 else
1903 {
1904 for (ii = 0; ii < ntodo; ii++)
1905 {
1906 dvalue = (input[ii] - zero) / scale;
1907
1908 if (dvalue < DLONGLONG_MIN)
1909 {
1910 *status = OVERFLOW_ERR;
1911 output[ii] = LONGLONG_MIN;
1912 }
1913 else if (dvalue > DLONGLONG_MAX)
1914 {
1915 *status = OVERFLOW_ERR;
1916 output[ii] = LONGLONG_MAX;
1917 }
1918 else
1919 {
1920 if (dvalue >= 0)
1921 output[ii] = (LONGLONG) (dvalue + .5);
1922 else
1923 output[ii] = (LONGLONG) (dvalue - .5);
1924 }
1925 }
1926 }
1927 return(*status);
1928 }
1929 /*--------------------------------------------------------------------------*/
ffi8fr4(LONGLONG * input,long ntodo,double scale,double zero,float * output,int * status)1930 int ffi8fr4(LONGLONG *input, /* I - array of values to be converted */
1931 long ntodo, /* I - number of elements in the array */
1932 double scale, /* I - FITS TSCALn or BSCALE value */
1933 double zero, /* I - FITS TZEROn or BZERO value */
1934 float *output, /* O - output array of converted values */
1935 int *status) /* IO - error status */
1936 /*
1937 Copy input to output prior to writing output to a FITS file.
1938 Do datatype conversion and scaling if required.
1939 */
1940 {
1941 long ii;
1942
1943 if (scale == 1. && zero == 0.)
1944 {
1945 for (ii = 0; ii < ntodo; ii++)
1946 output[ii] = (float) input[ii];
1947 }
1948 else
1949 {
1950 for (ii = 0; ii < ntodo; ii++)
1951 output[ii] = (float) ((input[ii] - zero) / scale);
1952 }
1953 return(*status);
1954 }
1955 /*--------------------------------------------------------------------------*/
ffi8fr8(LONGLONG * input,long ntodo,double scale,double zero,double * output,int * status)1956 int ffi8fr8(LONGLONG *input, /* I - array of values to be converted */
1957 long ntodo, /* I - number of elements in the array */
1958 double scale, /* I - FITS TSCALn or BSCALE value */
1959 double zero, /* I - FITS TZEROn or BZERO value */
1960 double *output, /* O - output array of converted values */
1961 int *status) /* IO - error status */
1962 /*
1963 Copy input to output prior to writing output to a FITS file.
1964 Do datatype conversion and scaling if required.
1965 */
1966 {
1967 long ii;
1968
1969 if (scale == 1. && zero == 0.)
1970 {
1971 for (ii = 0; ii < ntodo; ii++)
1972 output[ii] = (double) input[ii];
1973 }
1974 else
1975 {
1976 for (ii = 0; ii < ntodo; ii++)
1977 output[ii] = (input[ii] - zero) / scale;
1978 }
1979 return(*status);
1980 }
1981 /*--------------------------------------------------------------------------*/
ffi8fstr(LONGLONG * input,long ntodo,double scale,double zero,char * cform,long twidth,char * output,int * status)1982 int ffi8fstr(LONGLONG *input, /* I - array of values to be converted */
1983 long ntodo, /* I - number of elements in the array */
1984 double scale, /* I - FITS TSCALn or BSCALE value */
1985 double zero, /* I - FITS TZEROn or BZERO value */
1986 char *cform, /* I - format for output string values */
1987 long twidth, /* I - width of each field, in chars */
1988 char *output, /* O - output array of converted values */
1989 int *status) /* IO - error status */
1990 /*
1991 Copy input to output prior to writing output to a FITS file.
1992 Do scaling if required.
1993 */
1994 {
1995 long ii;
1996 double dvalue;
1997 char *cptr;
1998
1999 cptr = output;
2000
2001 if (scale == 1. && zero == 0.)
2002 {
2003 for (ii = 0; ii < ntodo; ii++)
2004 {
2005 sprintf(output, cform, (double) input[ii]);
2006 output += twidth;
2007
2008 if (*output) /* if this char != \0, then overflow occurred */
2009 *status = OVERFLOW_ERR;
2010 }
2011 }
2012 else
2013 {
2014 for (ii = 0; ii < ntodo; ii++)
2015 {
2016 dvalue = (input[ii] - zero) / scale;
2017 sprintf(output, cform, dvalue);
2018 output += twidth;
2019
2020 if (*output) /* if this char != \0, then overflow occurred */
2021 *status = OVERFLOW_ERR;
2022 }
2023 }
2024
2025 /* replace any commas with periods (e.g., in French locale) */
2026 while ((cptr = strchr(cptr, ','))) *cptr = '.';
2027
2028 return(*status);
2029 }
2030