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