1 /*  This file, getcolj.c, contains routines that read data elements from   */
2 /*  a FITS image or table, with long data type.                            */
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 <math.h>
9 #include <stdlib.h>
10 #include <limits.h>
11 #include <string.h>
12 #include "fitsio2.h"
13 
14 /*--------------------------------------------------------------------------*/
ffgpvj(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,long nulval,long * array,int * anynul,int * status)15 int ffgpvj( fitsfile *fptr,   /* I - FITS file pointer                       */
16             long  group,      /* I - group to read (1 = 1st group)           */
17             LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
18             LONGLONG  nelem,      /* I - number of values to read                */
19             long  nulval,     /* I - value for undefined pixels              */
20             long  *array,     /* O - array of values that are returned       */
21             int  *anynul,     /* O - set to 1 if any values are null; else 0 */
22             int  *status)     /* IO - error status                           */
23 /*
24   Read an array of values from the primary array. Data conversion
25   and scaling will be performed if necessary (e.g, if the datatype of
26   the FITS array is not the same as the array being read).
27   Undefined elements will be set equal to NULVAL, unless NULVAL=0
28   in which case no checking for undefined values will be performed.
29   ANYNUL is returned with a value of .true. if any pixels are undefined.
30 */
31 {
32     long row;
33     char cdummy;
34     int nullcheck = 1;
35     long nullvalue;
36 
37     if (fits_is_compressed_image(fptr, status))
38     {
39         /* this is a compressed image in a binary table */
40          nullvalue = nulval;  /* set local variable */
41 
42         fits_read_compressed_pixels(fptr, TLONG, firstelem, nelem,
43             nullcheck, &nullvalue, array, NULL, anynul, status);
44         return(*status);
45     }
46 
47     /*
48       the primary array is represented as a binary table:
49       each group of the primary array is a row in the table,
50       where the first column contains the group parameters
51       and the second column contains the image itself.
52     */
53 
54     row=maxvalue(1,group);
55 
56     ffgclj(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
57                array, &cdummy, anynul, status);
58     return(*status);
59 }
60 /*--------------------------------------------------------------------------*/
ffgpfj(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,long * array,char * nularray,int * anynul,int * status)61 int ffgpfj( fitsfile *fptr,   /* I - FITS file pointer                       */
62             long  group,      /* I - group to read (1 = 1st group)           */
63             LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
64             LONGLONG  nelem,      /* I - number of values to read                */
65             long  *array,     /* O - array of values that are returned       */
66             char *nularray,   /* O - array of null pixel flags               */
67             int  *anynul,     /* O - set to 1 if any values are null; else 0 */
68             int  *status)     /* IO - error status                           */
69 /*
70   Read an array of values from the primary array. Data conversion
71   and scaling will be performed if necessary (e.g, if the datatype of
72   the FITS array is not the same as the array being read).
73   Any undefined pixels in the returned array will be set = 0 and the
74   corresponding nularray value will be set = 1.
75   ANYNUL is returned with a value of .true. if any pixels are undefined.
76 */
77 {
78     long row;
79     int nullcheck = 2;
80 
81     if (fits_is_compressed_image(fptr, status))
82     {
83         /* this is a compressed image in a binary table */
84 
85         fits_read_compressed_pixels(fptr, TLONG, firstelem, nelem,
86             nullcheck, NULL, array, nularray, anynul, status);
87         return(*status);
88     }
89 
90     /*
91       the primary array is represented as a binary table:
92       each group of the primary array is a row in the table,
93       where the first column contains the group parameters
94       and the second column contains the image itself.
95     */
96 
97     row=maxvalue(1,group);
98 
99     ffgclj(fptr, 2, row, firstelem, nelem, 1, 2, 0L,
100                array, nularray, anynul, status);
101     return(*status);
102 }
103 /*--------------------------------------------------------------------------*/
ffg2dj(fitsfile * fptr,long group,long nulval,LONGLONG ncols,LONGLONG naxis1,LONGLONG naxis2,long * array,int * anynul,int * status)104 int ffg2dj(fitsfile *fptr,  /* I - FITS file pointer                       */
105            long  group,     /* I - group to read (1 = 1st group)           */
106            long  nulval,    /* set undefined pixels equal to this          */
107            LONGLONG  ncols,     /* I - number of pixels in each row of array   */
108            LONGLONG  naxis1,    /* I - FITS image NAXIS1 value                 */
109            LONGLONG  naxis2,    /* I - FITS image NAXIS2 value                 */
110            long  *array,    /* O - array to be filled and returned         */
111            int  *anynul,    /* O - set to 1 if any values are null; else 0 */
112            int  *status)    /* IO - error status                           */
113 /*
114   Read an entire 2-D array of values to the primary array. Data conversion
115   and scaling will be performed if necessary (e.g, if the datatype of the
116   FITS array is not the same as the array being read).  Any null
117   values in the array will be set equal to the value of nulval, unless
118   nulval = 0 in which case no null checking will be performed.
119 */
120 {
121     /* call the 3D reading routine, with the 3rd dimension = 1 */
122 
123     ffg3dj(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
124            anynul, status);
125 
126     return(*status);
127 }
128 /*--------------------------------------------------------------------------*/
ffg3dj(fitsfile * fptr,long group,long nulval,LONGLONG ncols,LONGLONG nrows,LONGLONG naxis1,LONGLONG naxis2,LONGLONG naxis3,long * array,int * anynul,int * status)129 int ffg3dj(fitsfile *fptr,  /* I - FITS file pointer                       */
130            long  group,     /* I - group to read (1 = 1st group)           */
131            long  nulval,    /* set undefined pixels equal to this          */
132            LONGLONG  ncols,     /* I - number of pixels in each row of array   */
133            LONGLONG  nrows,     /* I - number of rows in each plane of array   */
134            LONGLONG  naxis1,    /* I - FITS image NAXIS1 value                 */
135            LONGLONG  naxis2,    /* I - FITS image NAXIS2 value                 */
136            LONGLONG  naxis3,    /* I - FITS image NAXIS3 value                 */
137            long  *array,    /* O - array to be filled and returned         */
138            int  *anynul,    /* O - set to 1 if any values are null; else 0 */
139            int  *status)    /* IO - error status                           */
140 /*
141   Read an entire 3-D array of values to the primary array. Data conversion
142   and scaling will be performed if necessary (e.g, if the datatype of the
143   FITS array is not the same as the array being read).  Any null
144   values in the array will be set equal to the value of nulval, unless
145   nulval = 0 in which case no null checking will be performed.
146 */
147 {
148     long tablerow, ii, jj;
149     char cdummy;
150     int nullcheck = 1;
151     long inc[] = {1,1,1};
152     LONGLONG fpixel[] = {1,1,1}, nfits, narray;
153     LONGLONG lpixel[3], nullvalue;
154 
155     if (fits_is_compressed_image(fptr, status))
156     {
157         /* this is a compressed image in a binary table */
158 
159         lpixel[0] = ncols;
160         lpixel[1] = nrows;
161         lpixel[2] = naxis3;
162         nullvalue = nulval;  /* set local variable */
163 
164         fits_read_compressed_img(fptr, TLONG, fpixel, lpixel, inc,
165             nullcheck, &nullvalue, array, NULL, anynul, status);
166         return(*status);
167     }
168 
169     /*
170       the primary array is represented as a binary table:
171       each group of the primary array is a row in the table,
172       where the first column contains the group parameters
173       and the second column contains the image itself.
174     */
175     tablerow=maxvalue(1,group);
176 
177     if (ncols == naxis1 && nrows == naxis2)  /* arrays have same size? */
178     {
179        /* all the image pixels are contiguous, so read all at once */
180        ffgclj(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
181                array, &cdummy, anynul, status);
182        return(*status);
183     }
184 
185     if (ncols < naxis1 || nrows < naxis2)
186        return(*status = BAD_DIMEN);
187 
188     nfits = 1;   /* next pixel in FITS image to read */
189     narray = 0;  /* next pixel in output array to be filled */
190 
191     /* loop over naxis3 planes in the data cube */
192     for (jj = 0; jj < naxis3; jj++)
193     {
194       /* loop over the naxis2 rows in the FITS image, */
195       /* reading naxis1 pixels to each row            */
196 
197       for (ii = 0; ii < naxis2; ii++)
198       {
199        if (ffgclj(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
200           &array[narray], &cdummy, anynul, status) > 0)
201           return(*status);
202 
203        nfits += naxis1;
204        narray += ncols;
205       }
206       narray += (nrows - naxis2) * ncols;
207     }
208 
209     return(*status);
210 }
211 /*--------------------------------------------------------------------------*/
ffgsvj(fitsfile * fptr,int colnum,int naxis,long * naxes,long * blc,long * trc,long * inc,long nulval,long * array,int * anynul,int * status)212 int ffgsvj(fitsfile *fptr, /* I - FITS file pointer                         */
213            int  colnum,    /* I - number of the column to read (1 = 1st)    */
214            int naxis,      /* I - number of dimensions in the FITS array    */
215            long  *naxes,   /* I - size of each dimension                    */
216            long  *blc,     /* I - 'bottom left corner' of the subsection    */
217            long  *trc,     /* I - 'top right corner' of the subsection      */
218            long  *inc,     /* I - increment to be applied in each dimension */
219            long nulval,    /* I - value to set undefined pixels             */
220            long *array,    /* O - array to be filled and returned           */
221            int  *anynul,   /* O - set to 1 if any values are null; else 0   */
222            int  *status)   /* IO - error status                             */
223 /*
224   Read a subsection of data values from an image or a table column.
225   This routine is set up to handle a maximum of nine dimensions.
226 */
227 {
228     long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
229     long str[9],stp[9],incr[9],dir[9];
230     long nelem, nultyp, ninc, numcol;
231     LONGLONG felem, dsize[10], blcll[9], trcll[9];
232     int hdutype, anyf;
233     char ldummy, msg[FLEN_ERRMSG];
234     int nullcheck = 1;
235     long nullvalue;
236 
237     if (naxis < 1 || naxis > 9)
238     {
239         snprintf(msg, FLEN_ERRMSG,"NAXIS = %d in call to ffgsvj is out of range", naxis);
240         ffpmsg(msg);
241         return(*status = BAD_DIMEN);
242     }
243 
244     if (fits_is_compressed_image(fptr, status))
245     {
246         /* this is a compressed image in a binary table */
247 
248         for (ii=0; ii < naxis; ii++) {
249 	    blcll[ii] = blc[ii];
250 	    trcll[ii] = trc[ii];
251 	}
252 
253         nullvalue = nulval;  /* set local variable */
254 
255         fits_read_compressed_img(fptr, TLONG, blcll, trcll, inc,
256             nullcheck, &nullvalue, array, NULL, anynul, status);
257         return(*status);
258     }
259 
260 /*
261     if this is a primary array, then the input COLNUM parameter should
262     be interpreted as the row number, and we will alway read the image
263     data from column 2 (any group parameters are in column 1).
264 */
265     if (ffghdt(fptr, &hdutype, status) > 0)
266         return(*status);
267 
268     if (hdutype == IMAGE_HDU)
269     {
270         /* this is a primary array, or image extension */
271         if (colnum == 0)
272         {
273             rstr = 1;
274             rstp = 1;
275         }
276         else
277         {
278             rstr = colnum;
279             rstp = colnum;
280         }
281         rinc = 1;
282         numcol = 2;
283     }
284     else
285     {
286         /* this is a table, so the row info is in the (naxis+1) elements */
287         rstr = blc[naxis];
288         rstp = trc[naxis];
289         rinc = inc[naxis];
290         numcol = colnum;
291     }
292 
293     nultyp = 1;
294     if (anynul)
295         *anynul = FALSE;
296 
297     i0 = 0;
298     for (ii = 0; ii < 9; ii++)
299     {
300         str[ii] = 1;
301         stp[ii] = 1;
302         incr[ii] = 1;
303         dsize[ii] = 1;
304         dir[ii] = 1;
305     }
306 
307     for (ii = 0; ii < naxis; ii++)
308     {
309       if (trc[ii] < blc[ii])
310       {
311         if (hdutype == IMAGE_HDU)
312         {
313            dir[ii] = -1;
314         }
315         else
316         {
317           snprintf(msg, FLEN_ERRMSG,"ffgsvj: illegal range specified for axis %ld", ii + 1);
318           ffpmsg(msg);
319           return(*status = BAD_PIX_NUM);
320         }
321       }
322 
323       str[ii] = blc[ii];
324       stp[ii] = trc[ii];
325       incr[ii] = inc[ii];
326       dsize[ii + 1] = dsize[ii] * naxes[ii];
327       dsize[ii] = dsize[ii] * dir[ii];
328     }
329     dsize[naxis] = dsize[naxis] * dir[naxis];
330 
331     if (naxis == 1 && naxes[0] == 1)
332     {
333       /* This is not a vector column, so read all the rows at once */
334       nelem = (rstp - rstr) / rinc + 1;
335       ninc = rinc;
336       rstp = rstr;
337     }
338     else
339     {
340       /* have to read each row individually, in all dimensions */
341       nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
342       ninc = incr[0] * dir[0];
343     }
344 
345     for (row = rstr; row <= rstp; row += rinc)
346     {
347      for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
348      {
349       for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
350       {
351        for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
352        {
353         for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
354         {
355          for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
356          {
357           for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
358           {
359            for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
360            {
361             for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
362             {
363 
364               felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
365                              (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
366                              (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
367                              (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
368 
369               if ( ffgclj(fptr, numcol, row, felem, nelem, ninc, nultyp,
370                    nulval, &array[i0], &ldummy, &anyf, status) > 0)
371                    return(*status);
372 
373               if (anyf && anynul)
374                   *anynul = TRUE;
375 
376               i0 += nelem;
377             }
378            }
379           }
380          }
381         }
382        }
383       }
384      }
385     }
386     return(*status);
387 }
388 /*--------------------------------------------------------------------------*/
ffgsfj(fitsfile * fptr,int colnum,int naxis,long * naxes,long * blc,long * trc,long * inc,long * array,char * flagval,int * anynul,int * status)389 int ffgsfj(fitsfile *fptr, /* I - FITS file pointer                         */
390            int  colnum,    /* I - number of the column to read (1 = 1st)    */
391            int naxis,      /* I - number of dimensions in the FITS array    */
392            long  *naxes,   /* I - size of each dimension                    */
393            long  *blc,     /* I - 'bottom left corner' of the subsection    */
394            long  *trc,     /* I - 'top right corner' of the subsection      */
395            long  *inc,     /* I - increment to be applied in each dimension */
396            long *array,    /* O - array to be filled and returned           */
397            char *flagval,  /* O - set to 1 if corresponding value is null   */
398            int  *anynul,   /* O - set to 1 if any values are null; else 0   */
399            int  *status)   /* IO - error status                             */
400 /*
401   Read a subsection of data values from an image or a table column.
402   This routine is set up to handle a maximum of nine dimensions.
403 */
404 {
405     long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
406     long str[9],stp[9],incr[9],dsize[10];
407     LONGLONG blcll[9], trcll[9];
408     long felem, nelem, nultyp, ninc, numcol;
409     long nulval = 0;
410     int hdutype, anyf;
411     char msg[FLEN_ERRMSG];
412     int nullcheck = 2;
413 
414     if (naxis < 1 || naxis > 9)
415     {
416         snprintf(msg, FLEN_ERRMSG,"NAXIS = %d in call to ffgsvj is out of range", naxis);
417         ffpmsg(msg);
418         return(*status = BAD_DIMEN);
419     }
420 
421     if (fits_is_compressed_image(fptr, status))
422     {
423         /* this is a compressed image in a binary table */
424 
425         for (ii=0; ii < naxis; ii++) {
426 	    blcll[ii] = blc[ii];
427 	    trcll[ii] = trc[ii];
428 	}
429 
430         fits_read_compressed_img(fptr, TLONG, blcll, trcll, inc,
431             nullcheck, NULL, array, flagval, anynul, status);
432         return(*status);
433     }
434 
435 /*
436     if this is a primary array, then the input COLNUM parameter should
437     be interpreted as the row number, and we will alway read the image
438     data from column 2 (any group parameters are in column 1).
439 */
440     if (ffghdt(fptr, &hdutype, status) > 0)
441         return(*status);
442 
443     if (hdutype == IMAGE_HDU)
444     {
445         /* this is a primary array, or image extension */
446         if (colnum == 0)
447         {
448             rstr = 1;
449             rstp = 1;
450         }
451         else
452         {
453             rstr = colnum;
454             rstp = colnum;
455         }
456         rinc = 1;
457         numcol = 2;
458     }
459     else
460     {
461         /* this is a table, so the row info is in the (naxis+1) elements */
462         rstr = blc[naxis];
463         rstp = trc[naxis];
464         rinc = inc[naxis];
465         numcol = colnum;
466     }
467 
468     nultyp = 2;
469     if (anynul)
470         *anynul = FALSE;
471 
472     i0 = 0;
473     for (ii = 0; ii < 9; ii++)
474     {
475         str[ii] = 1;
476         stp[ii] = 1;
477         incr[ii] = 1;
478         dsize[ii] = 1;
479     }
480 
481     for (ii = 0; ii < naxis; ii++)
482     {
483       if (trc[ii] < blc[ii])
484       {
485         snprintf(msg, FLEN_ERRMSG,"ffgsvj: illegal range specified for axis %ld", ii + 1);
486         ffpmsg(msg);
487         return(*status = BAD_PIX_NUM);
488       }
489 
490       str[ii] = blc[ii];
491       stp[ii] = trc[ii];
492       incr[ii] = inc[ii];
493       dsize[ii + 1] = dsize[ii] * naxes[ii];
494     }
495 
496     if (naxis == 1 && naxes[0] == 1)
497     {
498       /* This is not a vector column, so read all the rows at once */
499       nelem = (rstp - rstr) / rinc + 1;
500       ninc = rinc;
501       rstp = rstr;
502     }
503     else
504     {
505       /* have to read each row individually, in all dimensions */
506       nelem = (stp[0] - str[0]) / inc[0] + 1;
507       ninc = incr[0];
508     }
509 
510     for (row = rstr; row <= rstp; row += rinc)
511     {
512      for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
513      {
514       for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
515       {
516        for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
517        {
518         for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
519         {
520          for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
521          {
522           for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
523           {
524            for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
525            {
526             for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
527             {
528               felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
529                              (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
530                              (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
531                              (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
532 
533               if ( ffgclj(fptr, numcol, row, felem, nelem, ninc, nultyp,
534                    nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
535                    return(*status);
536 
537               if (anyf && anynul)
538                   *anynul = TRUE;
539 
540               i0 += nelem;
541             }
542            }
543           }
544          }
545         }
546        }
547       }
548      }
549     }
550     return(*status);
551 }
552 /*--------------------------------------------------------------------------*/
ffggpj(fitsfile * fptr,long group,long firstelem,long nelem,long * array,int * status)553 int ffggpj( fitsfile *fptr,   /* I - FITS file pointer                       */
554             long  group,      /* I - group to read (1 = 1st group)           */
555             long  firstelem,  /* I - first vector element to read (1 = 1st)  */
556             long  nelem,      /* I - number of values to read                */
557             long  *array,     /* O - array of values that are returned       */
558             int  *status)     /* IO - error status                           */
559 /*
560   Read an array of group parameters from the primary array. Data conversion
561   and scaling will be performed if necessary (e.g, if the datatype of
562   the FITS array is not the same as the array being read).
563 */
564 {
565     long row;
566     int idummy;
567     char cdummy;
568     /*
569       the primary array is represented as a binary table:
570       each group of the primary array is a row in the table,
571       where the first column contains the group parameters
572       and the second column contains the image itself.
573     */
574 
575     row=maxvalue(1,group);
576 
577     ffgclj(fptr, 1, row, firstelem, nelem, 1, 1, 0L,
578                array, &cdummy, &idummy, status);
579     return(*status);
580 }
581 /*--------------------------------------------------------------------------*/
ffgcvj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,long nulval,long * array,int * anynul,int * status)582 int ffgcvj(fitsfile *fptr,   /* I - FITS file pointer                       */
583            int  colnum,      /* I - number of column to read (1 = 1st col)  */
584            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
585            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
586            LONGLONG  nelem,      /* I - number of values to read                */
587            long  nulval,     /* I - value for null pixels                   */
588            long *array,      /* O - array of values that are read           */
589            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
590            int  *status)     /* IO - error status                           */
591 /*
592   Read an array of values from a column in the current FITS HDU. Automatic
593   datatype conversion will be performed if the datatype of the column does not
594   match the datatype of the array parameter. The output values will be scaled
595   by the FITS TSCALn and TZEROn values if these values have been defined.
596   Any undefined pixels will be set equal to the value of 'nulval' unless
597   nulval = 0 in which case no checks for undefined pixels will be made.
598 */
599 {
600     char cdummy;
601 
602     ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
603            array, &cdummy, anynul, status);
604     return(*status);
605 }
606 /*--------------------------------------------------------------------------*/
ffgcfj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,long * array,char * nularray,int * anynul,int * status)607 int ffgcfj(fitsfile *fptr,   /* I - FITS file pointer                       */
608            int  colnum,      /* I - number of column to read (1 = 1st col)  */
609            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
610            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
611            LONGLONG  nelem,      /* I - number of values to read                */
612            long  *array,     /* O - array of values that are read           */
613            char *nularray,   /* O - array of flags: 1 if null pixel; else 0 */
614            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
615            int  *status)     /* IO - error status                           */
616 /*
617   Read an array of values from a column in the current FITS HDU. Automatic
618   datatype conversion will be performed if the datatype of the column does not
619   match the datatype of the array parameter. The output values will be scaled
620   by the FITS TSCALn and TZEROn values if these values have been defined.
621   Nularray will be set = 1 if the corresponding array pixel is undefined,
622   otherwise nularray will = 0.
623 */
624 {
625     long dummy = 0;
626 
627     ffgclj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
628            array, nularray, anynul, status);
629     return(*status);
630 }
631 /*--------------------------------------------------------------------------*/
ffgclj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,long elemincre,int nultyp,long nulval,long * array,char * nularray,int * anynul,int * status)632 int ffgclj( fitsfile *fptr,   /* I - FITS file pointer                       */
633             int  colnum,      /* I - number of column to read (1 = 1st col)  */
634             LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
635             LONGLONG firstelem,  /* I - first vector element to read (1 = 1st)  */
636             LONGLONG  nelem,      /* I - number of values to read                */
637             long  elemincre,  /* I - pixel increment; e.g., 2 = every other  */
638             int   nultyp,     /* I - null value handling code:               */
639                               /*     1: set undefined pixels = nulval        */
640                               /*     2: set nularray=1 for undefined pixels  */
641             long  nulval,     /* I - value for null pixels if nultyp = 1     */
642             long  *array,     /* O - array of values that are read           */
643             char *nularray,   /* O - array of flags = 1 if nultyp = 2        */
644             int  *anynul,     /* O - set to 1 if any values are null; else 0 */
645             int  *status)     /* IO - error status                           */
646 /*
647   Read an array of values from a column in the current FITS HDU.
648   The column number may refer to a real column in an ASCII or binary table,
649   or it may refer be a virtual column in a 1 or more grouped FITS primary
650   array or image extension.  FITSIO treats a primary array as a binary table
651   with 2 vector columns: the first column contains the group parameters (often
652   with length = 0) and the second column contains the array of image pixels.
653   Each row of the table represents a group in the case of multigroup FITS
654   images.
655 
656   The output array of values will be converted from the datatype of the column
657   and will be scaled by the FITS TSCALn and TZEROn values if necessary.
658 */
659 {
660     double scale, zero, power = 1., dtemp;
661     int tcode, maxelem2, hdutype, xcode, decimals;
662     long twidth, incre;
663     long ii, xwidth, ntodo;
664     int convert, nulcheck, readcheck = 0;
665     LONGLONG repeat, startpos, elemnum, readptr, tnull;
666     LONGLONG rowlen, rownum, remain, next, rowincre, maxelem;
667     char tform[20];
668     char message[FLEN_ERRMSG];
669     char snull[20];   /*  the FITS null value if reading from ASCII table  */
670 
671     double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
672     void *buffer;
673 
674     if (*status > 0 || nelem == 0)  /* inherit input status value if > 0 */
675         return(*status);
676 
677     buffer = cbuff;
678 
679     if (anynul)
680         *anynul = 0;
681 
682     if (nultyp == 2)
683         memset(nularray, 0, (size_t) nelem);   /* initialize nullarray */
684 
685     /*---------------------------------------------------*/
686     /*  Check input and get parameters about the column: */
687     /*---------------------------------------------------*/
688     if (elemincre < 0)
689         readcheck = -1;  /* don't do range checking in this case */
690 
691     if (ffgcprll(fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
692          tform, &twidth, &tcode, &maxelem2, &startpos, &elemnum, &incre,
693          &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 )
694          return(*status);
695     maxelem = maxelem2;
696 
697     incre *= elemincre;   /* multiply incre to just get every nth pixel */
698 
699     if (tcode == TSTRING)    /* setup for ASCII tables */
700     {
701       /* get the number of implied decimal places if no explicit decmal point */
702       ffasfm(tform, &xcode, &xwidth, &decimals, status);
703       for(ii = 0; ii < decimals; ii++)
704         power *= 10.;
705     }
706     /*------------------------------------------------------------------*/
707     /*  Decide whether to check for null values in the input FITS file: */
708     /*------------------------------------------------------------------*/
709     nulcheck = nultyp; /* by default check for null values in the FITS file */
710 
711     if (nultyp == 1 && nulval == 0)
712        nulcheck = 0;    /* calling routine does not want to check for nulls */
713 
714     else if (tcode%10 == 1 &&        /* if reading an integer column, and  */
715             tnull == NULL_UNDEFINED) /* if a null value is not defined,    */
716             nulcheck = 0;            /* then do not check for null values. */
717 
718     else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
719             nulcheck = 0;            /* Impossible null value */
720 
721     else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
722             nulcheck = 0;            /* Impossible null value */
723 
724     else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
725          nulcheck = 0;
726 
727     /*----------------------------------------------------------------------*/
728     /*  If FITS column and output data array have same datatype, then we do */
729     /*  not need to use a temporary buffer to store intermediate datatype.  */
730     /*----------------------------------------------------------------------*/
731     convert = 1;
732     if ((tcode == TLONG) && (LONGSIZE == 32))  /* Special Case:                        */
733     {                             /* no type convertion required, so read */
734                                   /* data directly into output buffer.    */
735 
736         if (nelem < (LONGLONG)INT32_MAX/4) {
737             maxelem = nelem;
738         } else {
739             maxelem = INT32_MAX/4;
740         }
741 
742         if (nulcheck == 0 && scale == 1. && zero == 0. )
743             convert = 0;  /* no need to scale data or find nulls */
744     }
745 
746     /*---------------------------------------------------------------------*/
747     /*  Now read the pixels from the FITS column. If the column does not   */
748     /*  have the same datatype as the output array, then we have to read   */
749     /*  the raw values into a temporary buffer (of limited size).  In      */
750     /*  the case of a vector colum read only 1 vector of values at a time  */
751     /*  then skip to the next row if more values need to be read.          */
752     /*  After reading the raw values, then call the fffXXYY routine to (1) */
753     /*  test for undefined values, (2) convert the datatype if necessary,  */
754     /*  and (3) scale the values by the FITS TSCALn and TZEROn linear      */
755     /*  scaling parameters.                                                */
756     /*---------------------------------------------------------------------*/
757     remain = nelem;           /* remaining number of values to read */
758     next = 0;                 /* next element in array to be read   */
759     rownum = 0;               /* row number, relative to firstrow   */
760 
761     while (remain)
762     {
763         /* limit the number of pixels to read at one time to the number that
764            will fit in the buffer or to the number of pixels that remain in
765            the current vector, which ever is smaller.
766         */
767         ntodo = (long) minvalue(remain, maxelem);
768         if (elemincre >= 0)
769         {
770           ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
771         }
772         else
773         {
774           ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
775         }
776 
777         readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
778 
779         switch (tcode)
780         {
781             case (TLONG):
782 	      if (LONGSIZE == 32) {
783                 ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) &array[next],
784                        status);
785                 if (convert)
786                     fffi4i4((INT32BIT *) &array[next], ntodo, scale, zero,
787                            nulcheck, (INT32BIT) tnull, nulval, &nularray[next],
788                             anynul, &array[next], status);
789 	      } else { /* case where sizeof(long) = 8 */
790                 ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
791                        status);
792                 if (convert)
793                     fffi4i4((INT32BIT *) buffer, ntodo, scale, zero,
794                            nulcheck, (INT32BIT) tnull, nulval, &nularray[next],
795                             anynul, &array[next], status);
796 	      }
797 
798                 break;
799             case (TLONGLONG):
800                 ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
801                 fffi8i4((LONGLONG *) buffer, ntodo, scale, zero,
802                            nulcheck, tnull, nulval, &nularray[next],
803                             anynul, &array[next], status);
804                 break;
805             case (TBYTE):
806                 ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
807                        status);
808                 fffi1i4((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
809                      (unsigned char) tnull, nulval, &nularray[next], anynul,
810                      &array[next], status);
811                 break;
812             case (TSHORT):
813                 ffgi2b(fptr, readptr, ntodo, incre, (short  *) buffer, status);
814                 fffi2i4((short  *) buffer, ntodo, scale, zero, nulcheck,
815                       (short) tnull, nulval, &nularray[next], anynul,
816                       &array[next], status);
817                 break;
818             case (TFLOAT):
819                 ffgr4b(fptr, readptr, ntodo, incre, (float  *) buffer, status);
820                 fffr4i4((float  *) buffer, ntodo, scale, zero, nulcheck,
821                        nulval, &nularray[next], anynul,
822                        &array[next], status);
823                 break;
824             case (TDOUBLE):
825                 ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
826                 fffr8i4((double *) buffer, ntodo, scale, zero, nulcheck,
827                           nulval, &nularray[next], anynul,
828                           &array[next], status);
829                 break;
830             case (TSTRING):
831                 ffmbyt(fptr, readptr, REPORT_EOF, status);
832 
833                 if (incre == twidth)    /* contiguous bytes */
834                      ffgbyt(fptr, ntodo * twidth, buffer, status);
835                 else
836                      ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
837                                status);
838 
839                 fffstri4((char *) buffer, ntodo, scale, zero, twidth, power,
840                      nulcheck, snull, nulval, &nularray[next], anynul,
841                      &array[next], status);
842                 break;
843 
844             default:  /*  error trap for invalid column format */
845                 snprintf(message, FLEN_ERRMSG,
846                    "Cannot read numbers from column %d which has format %s",
847                     colnum, tform);
848                 ffpmsg(message);
849                 if (hdutype == ASCII_TBL)
850                     return(*status = BAD_ATABLE_FORMAT);
851                 else
852                     return(*status = BAD_BTABLE_FORMAT);
853 
854         } /* End of switch block */
855 
856         /*-------------------------*/
857         /*  Check for fatal error  */
858         /*-------------------------*/
859         if (*status > 0)  /* test for error during previous read operation */
860         {
861 	  dtemp = (double) next;
862           if (hdutype > 0)
863             snprintf(message,FLEN_ERRMSG,
864             "Error reading elements %.0f thru %.0f from column %d (ffgclj).",
865               dtemp+1., dtemp+ntodo, colnum);
866           else
867             snprintf(message,FLEN_ERRMSG,
868             "Error reading elements %.0f thru %.0f from image (ffgclj).",
869               dtemp+1., dtemp+ntodo);
870 
871           ffpmsg(message);
872           return(*status);
873         }
874 
875         /*--------------------------------------------*/
876         /*  increment the counters for the next loop  */
877         /*--------------------------------------------*/
878         remain -= ntodo;
879         if (remain)
880         {
881             next += ntodo;
882             elemnum = elemnum + (ntodo * elemincre);
883 
884             if (elemnum >= repeat)  /* completed a row; start on later row */
885             {
886                 rowincre = elemnum / repeat;
887                 rownum += rowincre;
888                 elemnum = elemnum - (rowincre * repeat);
889             }
890             else if (elemnum < 0)  /* completed a row; start on a previous row */
891             {
892                 rowincre = (-elemnum - 1) / repeat + 1;
893                 rownum -= rowincre;
894                 elemnum = (rowincre * repeat) + elemnum;
895             }
896         }
897     }  /*  End of main while Loop  */
898 
899 
900     /*--------------------------------*/
901     /*  check for numerical overflow  */
902     /*--------------------------------*/
903     if (*status == OVERFLOW_ERR)
904     {
905         ffpmsg(
906         "Numerical overflow during type conversion while reading FITS data.");
907         *status = NUM_OVERFLOW;
908     }
909 
910     return(*status);
911 }
912 /*--------------------------------------------------------------------------*/
fffi1i4(unsigned char * input,long ntodo,double scale,double zero,int nullcheck,unsigned char tnull,long nullval,char * nullarray,int * anynull,long * output,int * status)913 int fffi1i4(unsigned char *input, /* I - array of values to be converted     */
914             long ntodo,           /* I - number of elements in the array     */
915             double scale,         /* I - FITS TSCALn or BSCALE value         */
916             double zero,          /* I - FITS TZEROn or BZERO  value         */
917             int nullcheck,        /* I - null checking code; 0 = don't check */
918                                   /*     1:set null pixels = nullval         */
919                                   /*     2: if null pixel, set nullarray = 1 */
920             unsigned char tnull,  /* I - value of FITS TNULLn keyword if any */
921             long nullval,         /* I - set null pixels, if nullcheck = 1   */
922             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
923             int  *anynull,        /* O - set to 1 if any pixels are null     */
924             long *output,         /* O - array of converted pixels           */
925             int *status)          /* IO - error status                       */
926 /*
927   Copy input to output following reading of the input from a FITS file.
928   Check for null values and do datatype conversion and scaling if required.
929   The nullcheck code value determines how any null values in the input array
930   are treated.  A null value is an input pixel that is equal to tnull.  If
931   nullcheck = 0, then no checking for nulls is performed and any null values
932   will be transformed just like any other pixel.  If nullcheck = 1, then the
933   output pixel will be set = nullval if the corresponding input pixel is null.
934   If nullcheck = 2, then if the pixel is null then the corresponding value of
935   nullarray will be set to 1; the value of nullarray for non-null pixels
936   will = 0.  The anynull parameter will be set = 1 if any of the returned
937   pixels are null, otherwise anynull will be returned with a value = 0;
938 */
939 {
940     long ii;
941     double dvalue;
942 
943     if (nullcheck == 0)     /* no null checking required */
944     {
945         if (scale == 1. && zero == 0.)      /* no scaling */
946         {
947             for (ii = 0; ii < ntodo; ii++)
948                 output[ii] = (long) input[ii];  /* copy input to output */
949         }
950         else             /* must scale the data */
951         {
952             for (ii = 0; ii < ntodo; ii++)
953             {
954                 dvalue = input[ii] * scale + zero;
955 
956                 if (dvalue < DLONG_MIN)
957                 {
958                     *status = OVERFLOW_ERR;
959                     output[ii] = LONG_MIN;
960                 }
961                 else if (dvalue > DLONG_MAX)
962                 {
963                     *status = OVERFLOW_ERR;
964                     output[ii] = LONG_MAX;
965                 }
966                 else
967                     output[ii] = (long) dvalue;
968             }
969         }
970     }
971     else        /* must check for null values */
972     {
973         if (scale == 1. && zero == 0.)  /* no scaling */
974         {
975             for (ii = 0; ii < ntodo; ii++)
976             {
977                 if (input[ii] == tnull)
978                 {
979                     *anynull = 1;
980                     if (nullcheck == 1)
981                         output[ii] = nullval;
982                     else
983                         nullarray[ii] = 1;
984                 }
985                 else
986                     output[ii] = (long) input[ii];
987             }
988         }
989         else                  /* must scale the data */
990         {
991             for (ii = 0; ii < ntodo; ii++)
992             {
993                 if (input[ii] == tnull)
994                 {
995                     *anynull = 1;
996                     if (nullcheck == 1)
997                         output[ii] = nullval;
998                     else
999                         nullarray[ii] = 1;
1000                 }
1001                 else
1002                 {
1003                     dvalue = input[ii] * scale + zero;
1004 
1005                     if (dvalue < DLONG_MIN)
1006                     {
1007                         *status = OVERFLOW_ERR;
1008                         output[ii] = LONG_MIN;
1009                     }
1010                     else if (dvalue > DLONG_MAX)
1011                     {
1012                         *status = OVERFLOW_ERR;
1013                         output[ii] = LONG_MAX;
1014                     }
1015                     else
1016                         output[ii] = (long) dvalue;
1017                 }
1018             }
1019         }
1020     }
1021     return(*status);
1022 }
1023 /*--------------------------------------------------------------------------*/
fffi2i4(short * input,long ntodo,double scale,double zero,int nullcheck,short tnull,long nullval,char * nullarray,int * anynull,long * output,int * status)1024 int fffi2i4(short *input,         /* I - array of values to be converted     */
1025             long ntodo,           /* I - number of elements in the array     */
1026             double scale,         /* I - FITS TSCALn or BSCALE value         */
1027             double zero,          /* I - FITS TZEROn or BZERO  value         */
1028             int nullcheck,        /* I - null checking code; 0 = don't check */
1029                                   /*     1:set null pixels = nullval         */
1030                                   /*     2: if null pixel, set nullarray = 1 */
1031             short tnull,          /* I - value of FITS TNULLn keyword if any */
1032             long nullval,         /* I - set null pixels, if nullcheck = 1   */
1033             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1034             int  *anynull,        /* O - set to 1 if any pixels are null     */
1035             long *output,         /* O - array of converted pixels           */
1036             int *status)          /* IO - error status                       */
1037 /*
1038   Copy input to output following reading of the input from a FITS file.
1039   Check for null values and do datatype conversion and scaling if required.
1040   The nullcheck code value determines how any null values in the input array
1041   are treated.  A null value is an input pixel that is equal to tnull.  If
1042   nullcheck = 0, then no checking for nulls is performed and any null values
1043   will be transformed just like any other pixel.  If nullcheck = 1, then the
1044   output pixel will be set = nullval if the corresponding input pixel is null.
1045   If nullcheck = 2, then if the pixel is null then the corresponding value of
1046   nullarray will be set to 1; the value of nullarray for non-null pixels
1047   will = 0.  The anynull parameter will be set = 1 if any of the returned
1048   pixels are null, otherwise anynull will be returned with a value = 0;
1049 */
1050 {
1051     long ii;
1052     double dvalue;
1053 
1054     if (nullcheck == 0)     /* no null checking required */
1055     {
1056         if (scale == 1. && zero == 0.)      /* no scaling */
1057         {
1058             for (ii = 0; ii < ntodo; ii++)
1059                 output[ii] = (long) input[ii];   /* copy input to output */
1060         }
1061         else             /* must scale the data */
1062         {
1063             for (ii = 0; ii < ntodo; ii++)
1064             {
1065                 dvalue = input[ii] * scale + zero;
1066 
1067                 if (dvalue < DLONG_MIN)
1068                 {
1069                     *status = OVERFLOW_ERR;
1070                     output[ii] = LONG_MIN;
1071                 }
1072                 else if (dvalue > DLONG_MAX)
1073                 {
1074                     *status = OVERFLOW_ERR;
1075                     output[ii] = LONG_MAX;
1076                 }
1077                 else
1078                     output[ii] = (long) dvalue;
1079             }
1080         }
1081     }
1082     else        /* must check for null values */
1083     {
1084         if (scale == 1. && zero == 0.)  /* no scaling */
1085         {
1086             for (ii = 0; ii < ntodo; ii++)
1087             {
1088                 if (input[ii] == tnull)
1089                 {
1090                     *anynull = 1;
1091                     if (nullcheck == 1)
1092                         output[ii] = nullval;
1093                     else
1094                         nullarray[ii] = 1;
1095                 }
1096                 else
1097                     output[ii] = (long) input[ii];
1098             }
1099         }
1100         else                  /* must scale the data */
1101         {
1102             for (ii = 0; ii < ntodo; ii++)
1103             {
1104                 if (input[ii] == tnull)
1105                 {
1106                     *anynull = 1;
1107                     if (nullcheck == 1)
1108                         output[ii] = nullval;
1109                     else
1110                         nullarray[ii] = 1;
1111                 }
1112                 else
1113                 {
1114                     dvalue = input[ii] * scale + zero;
1115 
1116                     if (dvalue < DLONG_MIN)
1117                     {
1118                         *status = OVERFLOW_ERR;
1119                         output[ii] = LONG_MIN;
1120                     }
1121                     else if (dvalue > DLONG_MAX)
1122                     {
1123                         *status = OVERFLOW_ERR;
1124                         output[ii] = LONG_MAX;
1125                     }
1126                     else
1127                         output[ii] = (long) dvalue;
1128                 }
1129             }
1130         }
1131     }
1132     return(*status);
1133 }
1134 /*--------------------------------------------------------------------------*/
fffi4i4(INT32BIT * input,long ntodo,double scale,double zero,int nullcheck,INT32BIT tnull,long nullval,char * nullarray,int * anynull,long * output,int * status)1135 int fffi4i4(INT32BIT *input,      /* I - array of values to be converted     */
1136             long ntodo,           /* I - number of elements in the array     */
1137             double scale,         /* I - FITS TSCALn or BSCALE value         */
1138             double zero,          /* I - FITS TZEROn or BZERO  value         */
1139             int nullcheck,        /* I - null checking code; 0 = don't check */
1140                                   /*     1:set null pixels = nullval         */
1141                                   /*     2: if null pixel, set nullarray = 1 */
1142             INT32BIT tnull,       /* I - value of FITS TNULLn keyword if any */
1143             long nullval,         /* I - set null pixels, if nullcheck = 1   */
1144             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1145             int  *anynull,        /* O - set to 1 if any pixels are null     */
1146             long *output,         /* O - array of converted pixels           */
1147             int *status)          /* IO - error status                       */
1148 /*
1149   Copy input to output following reading of the input from a FITS file.
1150   Check for null values and do datatype conversion and scaling if required.
1151   The nullcheck code value determines how any null values in the input array
1152   are treated.  A null value is an input pixel that is equal to tnull.  If
1153   nullcheck = 0, then no checking for nulls is performed and any null values
1154   will be transformed just like any other pixel.  If nullcheck = 1, then the
1155   output pixel will be set = nullval if the corresponding input pixel is null.
1156   If nullcheck = 2, then if the pixel is null then the corresponding value of
1157   nullarray will be set to 1; the value of nullarray for non-null pixels
1158   will = 0.  The anynull parameter will be set = 1 if any of the returned
1159   pixels are null, otherwise anynull will be returned with a value = 0;
1160 */
1161 {
1162     long ii;
1163     double dvalue;
1164 
1165     if (nullcheck == 0)     /* no null checking required */
1166     {
1167         if (scale == 1. && zero == 0.)      /* no scaling */
1168         {
1169             for (ii = 0; ii < ntodo; ii++) {
1170                  output[ii] = (long) input[ii];   /* copy input to output */
1171 	    }
1172         }
1173         else             /* must scale the data */
1174         {
1175             for (ii = 0; ii < ntodo; ii++)
1176             {
1177                 dvalue = input[ii] * scale + zero;
1178 
1179                 if (dvalue < DLONG_MIN)
1180                 {
1181                     *status = OVERFLOW_ERR;
1182                     output[ii] = LONG_MIN;
1183                 }
1184                 else if (dvalue > DLONG_MAX)
1185                 {
1186                     *status = OVERFLOW_ERR;
1187                     output[ii] = LONG_MAX;
1188                 }
1189                 else
1190                     output[ii] = (long) dvalue;
1191             }
1192         }
1193     }
1194     else        /* must check for null values */
1195     {
1196         if (scale == 1. && zero == 0.)  /* no scaling */
1197         {
1198             for (ii = 0; ii < ntodo; ii++)
1199             {
1200                 if (input[ii] == tnull)
1201                 {
1202                     *anynull = 1;
1203                     if (nullcheck == 1)
1204                         output[ii] = nullval;
1205                     else
1206                         nullarray[ii] = 1;
1207                 }
1208                 else
1209                     output[ii] = input[ii];
1210             }
1211         }
1212         else                  /* must scale the data */
1213         {
1214             for (ii = 0; ii < ntodo; ii++)
1215             {
1216                 if (input[ii] == tnull)
1217                 {
1218                     *anynull = 1;
1219                     if (nullcheck == 1)
1220                         output[ii] = nullval;
1221                     else
1222                         nullarray[ii] = 1;
1223                 }
1224                 else
1225                 {
1226                     dvalue = input[ii] * scale + zero;
1227 
1228                     if (dvalue < DLONG_MIN)
1229                     {
1230                         *status = OVERFLOW_ERR;
1231                         output[ii] = LONG_MIN;
1232                     }
1233                     else if (dvalue > DLONG_MAX)
1234                     {
1235                         *status = OVERFLOW_ERR;
1236                         output[ii] = LONG_MAX;
1237                     }
1238                     else
1239                         output[ii] = (long) dvalue;
1240                 }
1241             }
1242         }
1243     }
1244     return(*status);
1245 }
1246 /*--------------------------------------------------------------------------*/
fffi8i4(LONGLONG * input,long ntodo,double scale,double zero,int nullcheck,LONGLONG tnull,long nullval,char * nullarray,int * anynull,long * output,int * status)1247 int fffi8i4(LONGLONG *input,      /* I - array of values to be converted     */
1248             long ntodo,           /* I - number of elements in the array     */
1249             double scale,         /* I - FITS TSCALn or BSCALE value         */
1250             double zero,          /* I - FITS TZEROn or BZERO  value         */
1251             int nullcheck,        /* I - null checking code; 0 = don't check */
1252                                   /*     1:set null pixels = nullval         */
1253                                   /*     2: if null pixel, set nullarray = 1 */
1254             LONGLONG tnull,       /* I - value of FITS TNULLn keyword if any */
1255             long nullval,         /* I - set null pixels, if nullcheck = 1   */
1256             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1257             int  *anynull,        /* O - set to 1 if any pixels are null     */
1258             long *output,         /* O - array of converted pixels           */
1259             int *status)          /* IO - error status                       */
1260 /*
1261   Copy input to output following reading of the input from a FITS file.
1262   Check for null values and do datatype conversion and scaling if required.
1263   The nullcheck code value determines how any null values in the input array
1264   are treated.  A null value is an input pixel that is equal to tnull.  If
1265   nullcheck = 0, then no checking for nulls is performed and any null values
1266   will be transformed just like any other pixel.  If nullcheck = 1, then the
1267   output pixel will be set = nullval if the corresponding input pixel is null.
1268   If nullcheck = 2, then if the pixel is null then the corresponding value of
1269   nullarray will be set to 1; the value of nullarray for non-null pixels
1270   will = 0.  The anynull parameter will be set = 1 if any of the returned
1271   pixels are null, otherwise anynull will be returned with a value = 0;
1272 */
1273 {
1274     long ii;
1275     double dvalue;
1276     ULONGLONG ulltemp;
1277 
1278     if (nullcheck == 0)     /* no null checking required */
1279     {
1280         if (scale == 1. && zero ==  9223372036854775808.)
1281         {
1282             /* The column we read contains unsigned long long values. */
1283             /* Instead of adding 9223372036854775808, it is more efficient */
1284             /* and more precise to just flip the sign bit with the XOR operator */
1285 
1286             for (ii = 0; ii < ntodo; ii++) {
1287 
1288                 ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000);
1289 
1290                 if (ulltemp > LONG_MAX)
1291                 {
1292                     *status = OVERFLOW_ERR;
1293                     output[ii] = LONG_MAX;
1294                 }
1295                 else
1296 		{
1297                     output[ii] = (long) ulltemp;
1298 		}
1299             }
1300         }
1301         else if (scale == 1. && zero == 0.)      /* no scaling */
1302         {
1303             for (ii = 0; ii < ntodo; ii++)
1304             {
1305                 if (input[ii] < LONG_MIN)
1306                 {
1307                     *status = OVERFLOW_ERR;
1308                     output[ii] = LONG_MIN;
1309                 }
1310                 else if (input[ii] > LONG_MAX)
1311                 {
1312                     *status = OVERFLOW_ERR;
1313                     output[ii] = LONG_MAX;
1314                 }
1315                 else
1316                     output[ii] = (long) input[ii];
1317             }
1318         }
1319         else             /* must scale the data */
1320         {
1321             for (ii = 0; ii < ntodo; ii++)
1322             {
1323                 dvalue = input[ii] * scale + zero;
1324 
1325                 if (dvalue < DLONG_MIN)
1326                 {
1327                     *status = OVERFLOW_ERR;
1328                     output[ii] = LONG_MIN;
1329                 }
1330                 else if (dvalue > DLONG_MAX)
1331                 {
1332                     *status = OVERFLOW_ERR;
1333                     output[ii] = LONG_MAX;
1334                 }
1335                 else
1336                     output[ii] = (long) dvalue;
1337             }
1338         }
1339     }
1340     else        /* must check for null values */
1341     {
1342         if (scale == 1. && zero ==  9223372036854775808.)
1343         {
1344             /* The column we read contains unsigned long long values. */
1345             /* Instead of subtracting 9223372036854775808, it is more efficient */
1346             /* and more precise to just flip the sign bit with the XOR operator */
1347 
1348             for (ii = 0; ii < ntodo; ii++) {
1349 
1350                 if (input[ii] == tnull)
1351                 {
1352                     *anynull = 1;
1353                     if (nullcheck == 1)
1354                         output[ii] = nullval;
1355                     else
1356                         nullarray[ii] = 1;
1357                 }
1358                 else
1359 		{
1360                     ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000);
1361 
1362                     if (ulltemp > LONG_MAX)
1363                     {
1364                         *status = OVERFLOW_ERR;
1365                         output[ii] = LONG_MAX;
1366                     }
1367                     else
1368 		    {
1369                         output[ii] = (long) ulltemp;
1370 		    }
1371                 }
1372             }
1373         }
1374         else if (scale == 1. && zero == 0.)  /* no scaling */
1375         {
1376             for (ii = 0; ii < ntodo; ii++)
1377             {
1378                 if (input[ii] == tnull)
1379                 {
1380                     *anynull = 1;
1381                     if (nullcheck == 1)
1382                         output[ii] = nullval;
1383                     else
1384                         nullarray[ii] = 1;
1385                 }
1386                 else
1387                 {
1388                     if (input[ii] < LONG_MIN)
1389                     {
1390                         *status = OVERFLOW_ERR;
1391                         output[ii] = LONG_MIN;
1392                     }
1393                     else if (input[ii] > LONG_MAX)
1394                     {
1395                         *status = OVERFLOW_ERR;
1396                         output[ii] = LONG_MAX;
1397                     }
1398                     else
1399                         output[ii] = (long) input[ii];
1400                 }
1401             }
1402         }
1403         else                  /* must scale the data */
1404         {
1405             for (ii = 0; ii < ntodo; ii++)
1406             {
1407                 if (input[ii] == tnull)
1408                 {
1409                     *anynull = 1;
1410                     if (nullcheck == 1)
1411                         output[ii] = nullval;
1412                     else
1413                         nullarray[ii] = 1;
1414                 }
1415                 else
1416                 {
1417                     dvalue = input[ii] * scale + zero;
1418 
1419                     if (dvalue < DLONG_MIN)
1420                     {
1421                         *status = OVERFLOW_ERR;
1422                         output[ii] = LONG_MIN;
1423                     }
1424                     else if (dvalue > DLONG_MAX)
1425                     {
1426                         *status = OVERFLOW_ERR;
1427                         output[ii] = LONG_MAX;
1428                     }
1429                     else
1430                         output[ii] = (long) dvalue;
1431                 }
1432             }
1433         }
1434     }
1435     return(*status);
1436 }
1437 /*--------------------------------------------------------------------------*/
fffr4i4(float * input,long ntodo,double scale,double zero,int nullcheck,long nullval,char * nullarray,int * anynull,long * output,int * status)1438 int fffr4i4(float *input,         /* I - array of values to be converted     */
1439             long ntodo,           /* I - number of elements in the array     */
1440             double scale,         /* I - FITS TSCALn or BSCALE value         */
1441             double zero,          /* I - FITS TZEROn or BZERO  value         */
1442             int nullcheck,        /* I - null checking code; 0 = don't check */
1443                                   /*     1:set null pixels = nullval         */
1444                                   /*     2: if null pixel, set nullarray = 1 */
1445             long nullval,         /* I - set null pixels, if nullcheck = 1   */
1446             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1447             int  *anynull,        /* O - set to 1 if any pixels are null     */
1448             long *output,         /* O - array of converted pixels           */
1449             int *status)          /* IO - error status                       */
1450 /*
1451   Copy input to output following reading of the input from a FITS file.
1452   Check for null values and do datatype conversion and scaling if required.
1453   The nullcheck code value determines how any null values in the input array
1454   are treated.  A null value is an input pixel that is equal to NaN.  If
1455   nullcheck = 0, then no checking for nulls is performed and any null values
1456   will be transformed just like any other pixel.  If nullcheck = 1, then the
1457   output pixel will be set = nullval if the corresponding input pixel is null.
1458   If nullcheck = 2, then if the pixel is null then the corresponding value of
1459   nullarray will be set to 1; the value of nullarray for non-null pixels
1460   will = 0.  The anynull parameter will be set = 1 if any of the returned
1461   pixels are null, otherwise anynull will be returned with a value = 0;
1462 */
1463 {
1464     long ii;
1465     double dvalue;
1466     short *sptr, iret;
1467 
1468     if (nullcheck == 0)     /* no null checking required */
1469     {
1470         if (scale == 1. && zero == 0.)      /* no scaling */
1471         {
1472             for (ii = 0; ii < ntodo; ii++)
1473             {
1474                 if (input[ii] < DLONG_MIN)
1475                 {
1476                     *status = OVERFLOW_ERR;
1477                     output[ii] = LONG_MIN;
1478                 }
1479                 else if (input[ii] > DLONG_MAX)
1480                 {
1481                     *status = OVERFLOW_ERR;
1482                     output[ii] = LONG_MAX;
1483                 }
1484                 else
1485                     output[ii] = (long) input[ii];
1486             }
1487         }
1488         else             /* must scale the data */
1489         {
1490             for (ii = 0; ii < ntodo; ii++)
1491             {
1492                 dvalue = input[ii] * scale + zero;
1493 
1494                 if (dvalue < DLONG_MIN)
1495                 {
1496                     *status = OVERFLOW_ERR;
1497                     output[ii] = LONG_MIN;
1498                 }
1499                 else if (dvalue > DLONG_MAX)
1500                 {
1501                     *status = OVERFLOW_ERR;
1502                     output[ii] = LONG_MAX;
1503                 }
1504                 else
1505                     output[ii] = (long) dvalue;
1506             }
1507         }
1508     }
1509     else        /* must check for null values */
1510     {
1511         sptr = (short *) input;
1512 
1513 #if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
1514         sptr++;       /* point to MSBs */
1515 #endif
1516 
1517         if (scale == 1. && zero == 0.)  /* no scaling */
1518         {
1519             for (ii = 0; ii < ntodo; ii++, sptr += 2)
1520             {
1521               if (0 != (iret = fnan(*sptr) ) )  /* test for NaN or underflow */
1522               {
1523                   if (iret == 1)  /* is it a NaN? */
1524                   {
1525                     *anynull = 1;
1526                     if (nullcheck == 1)
1527                         output[ii] = nullval;
1528                     else
1529                         nullarray[ii] = 1;
1530                   }
1531                   else            /* it's an underflow */
1532                      output[ii] = 0;
1533               }
1534               else
1535                 {
1536                     if (input[ii] < DLONG_MIN)
1537                     {
1538                         *status = OVERFLOW_ERR;
1539                         output[ii] = LONG_MIN;
1540                     }
1541                     else if (input[ii] > DLONG_MAX)
1542                     {
1543                         *status = OVERFLOW_ERR;
1544                         output[ii] = LONG_MAX;
1545                     }
1546                     else
1547                         output[ii] = (long) input[ii];
1548                 }
1549             }
1550         }
1551         else                  /* must scale the data */
1552         {
1553             for (ii = 0; ii < ntodo; ii++, sptr += 2)
1554             {
1555               if (0 != (iret = fnan(*sptr) ) )  /* test for NaN or underflow */
1556               {
1557                   if (iret == 1)  /* is it a NaN? */
1558                   {
1559                     *anynull = 1;
1560                     if (nullcheck == 1)
1561                         output[ii] = nullval;
1562                     else
1563                         nullarray[ii] = 1;
1564                   }
1565                   else            /* it's an underflow */
1566                   {
1567                     if (zero < DLONG_MIN)
1568                     {
1569                         *status = OVERFLOW_ERR;
1570                         output[ii] = LONG_MIN;
1571                     }
1572                     else if (zero > DLONG_MAX)
1573                     {
1574                         *status = OVERFLOW_ERR;
1575                         output[ii] = LONG_MAX;
1576                     }
1577                     else
1578                         output[ii] = (long) zero;
1579                   }
1580               }
1581               else
1582                 {
1583                     dvalue = input[ii] * scale + zero;
1584 
1585                     if (dvalue < DLONG_MIN)
1586                     {
1587                         *status = OVERFLOW_ERR;
1588                         output[ii] = LONG_MIN;
1589                     }
1590                     else if (dvalue > DLONG_MAX)
1591                     {
1592                         *status = OVERFLOW_ERR;
1593                         output[ii] = LONG_MAX;
1594                     }
1595                     else
1596                         output[ii] = (long) dvalue;
1597                 }
1598             }
1599         }
1600     }
1601     return(*status);
1602 }
1603 /*--------------------------------------------------------------------------*/
fffr8i4(double * input,long ntodo,double scale,double zero,int nullcheck,long nullval,char * nullarray,int * anynull,long * output,int * status)1604 int fffr8i4(double *input,        /* I - array of values to be converted     */
1605             long ntodo,           /* I - number of elements in the array     */
1606             double scale,         /* I - FITS TSCALn or BSCALE value         */
1607             double zero,          /* I - FITS TZEROn or BZERO  value         */
1608             int nullcheck,        /* I - null checking code; 0 = don't check */
1609                                   /*     1:set null pixels = nullval         */
1610                                   /*     2: if null pixel, set nullarray = 1 */
1611             long nullval,         /* I - set null pixels, if nullcheck = 1   */
1612             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1613             int  *anynull,        /* O - set to 1 if any pixels are null     */
1614             long *output,         /* O - array of converted pixels           */
1615             int *status)          /* IO - error status                       */
1616 /*
1617   Copy input to output following reading of the input from a FITS file.
1618   Check for null values and do datatype conversion and scaling if required.
1619   The nullcheck code value determines how any null values in the input array
1620   are treated.  A null value is an input pixel that is equal to NaN.  If
1621   nullcheck = 0, then no checking for nulls is performed and any null values
1622   will be transformed just like any other pixel.  If nullcheck = 1, then the
1623   output pixel will be set = nullval if the corresponding input pixel is null.
1624   If nullcheck = 2, then if the pixel is null then the corresponding value of
1625   nullarray will be set to 1; the value of nullarray for non-null pixels
1626   will = 0.  The anynull parameter will be set = 1 if any of the returned
1627   pixels are null, otherwise anynull will be returned with a value = 0;
1628 */
1629 {
1630     long ii;
1631     double dvalue;
1632     short *sptr, iret;
1633 
1634     if (nullcheck == 0)     /* no null checking required */
1635     {
1636         if (scale == 1. && zero == 0.)      /* no scaling */
1637         {
1638             for (ii = 0; ii < ntodo; ii++)
1639             {
1640                 if (input[ii] < DLONG_MIN)
1641                 {
1642                     *status = OVERFLOW_ERR;
1643                     output[ii] = LONG_MIN;
1644                 }
1645                 else if (input[ii] > DLONG_MAX)
1646                 {
1647                     *status = OVERFLOW_ERR;
1648                     output[ii] = LONG_MAX;
1649                 }
1650                 else
1651                     output[ii] = (long) input[ii];
1652             }
1653         }
1654         else             /* must scale the data */
1655         {
1656             for (ii = 0; ii < ntodo; ii++)
1657             {
1658                 dvalue = input[ii] * scale + zero;
1659 
1660                 if (dvalue < DLONG_MIN)
1661                 {
1662                     *status = OVERFLOW_ERR;
1663                     output[ii] = LONG_MIN;
1664                 }
1665                 else if (dvalue > DLONG_MAX)
1666                 {
1667                     *status = OVERFLOW_ERR;
1668                     output[ii] = LONG_MAX;
1669                 }
1670                 else
1671                     output[ii] = (long) dvalue;
1672             }
1673         }
1674     }
1675     else        /* must check for null values */
1676     {
1677         sptr = (short *) input;
1678 
1679 #if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
1680         sptr += 3;       /* point to MSBs */
1681 #endif
1682         if (scale == 1. && zero == 0.)  /* no scaling */
1683         {
1684             for (ii = 0; ii < ntodo; ii++, sptr += 4)
1685             {
1686               if (0 != (iret = dnan(*sptr)) )  /* test for NaN or underflow */
1687               {
1688                   if (iret == 1)  /* is it a NaN? */
1689                   {
1690                     *anynull = 1;
1691                     if (nullcheck == 1)
1692                         output[ii] = nullval;
1693                     else
1694                         nullarray[ii] = 1;
1695                   }
1696                   else            /* it's an underflow */
1697                      output[ii] = 0;
1698               }
1699               else
1700                 {
1701                     if (input[ii] < DLONG_MIN)
1702                     {
1703                         *status = OVERFLOW_ERR;
1704                         output[ii] = LONG_MIN;
1705                     }
1706                     else if (input[ii] > DLONG_MAX)
1707                     {
1708                         *status = OVERFLOW_ERR;
1709                         output[ii] = LONG_MAX;
1710                     }
1711                     else
1712                         output[ii] = (long) input[ii];
1713                 }
1714             }
1715         }
1716         else                  /* must scale the data */
1717         {
1718             for (ii = 0; ii < ntodo; ii++, sptr += 4)
1719             {
1720               if (0 != (iret = dnan(*sptr)) )  /* test for NaN or underflow */
1721               {
1722                   if (iret == 1)  /* is it a NaN? */
1723                   {
1724                     *anynull = 1;
1725                     if (nullcheck == 1)
1726                         output[ii] = nullval;
1727                     else
1728                         nullarray[ii] = 1;
1729                   }
1730                   else            /* it's an underflow */
1731                   {
1732                     if (zero < DLONG_MIN)
1733                     {
1734                         *status = OVERFLOW_ERR;
1735                         output[ii] = LONG_MIN;
1736                     }
1737                     else if (zero > DLONG_MAX)
1738                     {
1739                         *status = OVERFLOW_ERR;
1740                         output[ii] = LONG_MAX;
1741                     }
1742                     else
1743                         output[ii] = (long) zero;
1744                   }
1745               }
1746               else
1747                 {
1748                     dvalue = input[ii] * scale + zero;
1749 
1750                     if (dvalue < DLONG_MIN)
1751                     {
1752                         *status = OVERFLOW_ERR;
1753                         output[ii] = LONG_MIN;
1754                     }
1755                     else if (dvalue > DLONG_MAX)
1756                     {
1757                         *status = OVERFLOW_ERR;
1758                         output[ii] = LONG_MAX;
1759                     }
1760                     else
1761                         output[ii] = (long) dvalue;
1762                 }
1763             }
1764         }
1765     }
1766     return(*status);
1767 }
1768 /*--------------------------------------------------------------------------*/
fffstri4(char * input,long ntodo,double scale,double zero,long twidth,double implipower,int nullcheck,char * snull,long nullval,char * nullarray,int * anynull,long * output,int * status)1769 int fffstri4(char *input,         /* I - array of values to be converted     */
1770             long ntodo,           /* I - number of elements in the array     */
1771             double scale,         /* I - FITS TSCALn or BSCALE value         */
1772             double zero,          /* I - FITS TZEROn or BZERO  value         */
1773             long twidth,          /* I - width of each substring of chars    */
1774             double implipower,    /* I - power of 10 of implied decimal      */
1775             int nullcheck,        /* I - null checking code; 0 = don't check */
1776                                   /*     1:set null pixels = nullval         */
1777                                   /*     2: if null pixel, set nullarray = 1 */
1778             char  *snull,         /* I - value of FITS null string, if any   */
1779             long nullval,         /* I - set null pixels, if nullcheck = 1   */
1780             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1781             int  *anynull,        /* O - set to 1 if any pixels are null     */
1782             long *output,         /* O - array of converted pixels           */
1783             int *status)          /* IO - error status                       */
1784 /*
1785   Copy input to output following reading of the input from a FITS file. Check
1786   for null values and do scaling if required. The nullcheck code value
1787   determines how any null values in the input array are treated. A null
1788   value is an input pixel that is equal to snull.  If nullcheck= 0, then
1789   no special checking for nulls is performed.  If nullcheck = 1, then the
1790   output pixel will be set = nullval if the corresponding input pixel is null.
1791   If nullcheck = 2, then if the pixel is null then the corresponding value of
1792   nullarray will be set to 1; the value of nullarray for non-null pixels
1793   will = 0.  The anynull parameter will be set = 1 if any of the returned
1794   pixels are null, otherwise anynull will be returned with a value = 0;
1795 */
1796 {
1797     int nullen;
1798     long ii;
1799     double dvalue;
1800     char *cstring, message[FLEN_ERRMSG];
1801     char *cptr, *tpos;
1802     char tempstore, chrzero = '0';
1803     double val, power;
1804     int exponent, sign, esign, decpt;
1805 
1806     nullen = strlen(snull);
1807     cptr = input;  /* pointer to start of input string */
1808     for (ii = 0; ii < ntodo; ii++)
1809     {
1810       cstring = cptr;
1811       /* temporarily insert a null terminator at end of the string */
1812       tpos = cptr + twidth;
1813       tempstore = *tpos;
1814       *tpos = 0;
1815 
1816       /* check if null value is defined, and if the    */
1817       /* column string is identical to the null string */
1818       if (snull[0] != ASCII_NULL_UNDEFINED &&
1819          !strncmp(snull, cptr, nullen) )
1820       {
1821         if (nullcheck)
1822         {
1823           *anynull = 1;
1824           if (nullcheck == 1)
1825             output[ii] = nullval;
1826           else
1827             nullarray[ii] = 1;
1828         }
1829         cptr += twidth;
1830       }
1831       else
1832       {
1833         /* value is not the null value, so decode it */
1834         /* remove any embedded blank characters from the string */
1835 
1836         decpt = 0;
1837         sign = 1;
1838         val  = 0.;
1839         power = 1.;
1840         exponent = 0;
1841         esign = 1;
1842 
1843         while (*cptr == ' ')               /* skip leading blanks */
1844            cptr++;
1845 
1846         if (*cptr == '-' || *cptr == '+')  /* check for leading sign */
1847         {
1848           if (*cptr == '-')
1849              sign = -1;
1850 
1851           cptr++;
1852 
1853           while (*cptr == ' ')         /* skip blanks between sign and value */
1854             cptr++;
1855         }
1856 
1857         while (*cptr >= '0' && *cptr <= '9')
1858         {
1859           val = val * 10. + *cptr - chrzero;  /* accumulate the value */
1860           cptr++;
1861 
1862           while (*cptr == ' ')         /* skip embedded blanks in the value */
1863             cptr++;
1864         }
1865 
1866         if (*cptr == '.' || *cptr == ',')    /* check for decimal point */
1867         {
1868           decpt = 1;       /* set flag to show there was a decimal point */
1869           cptr++;
1870           while (*cptr == ' ')         /* skip any blanks */
1871             cptr++;
1872 
1873           while (*cptr >= '0' && *cptr <= '9')
1874           {
1875             val = val * 10. + *cptr - chrzero;  /* accumulate the value */
1876             power = power * 10.;
1877             cptr++;
1878 
1879             while (*cptr == ' ')         /* skip embedded blanks in the value */
1880               cptr++;
1881           }
1882         }
1883 
1884         if (*cptr == 'E' || *cptr == 'D')  /* check for exponent */
1885         {
1886           cptr++;
1887           while (*cptr == ' ')         /* skip blanks */
1888               cptr++;
1889 
1890           if (*cptr == '-' || *cptr == '+')  /* check for exponent sign */
1891           {
1892             if (*cptr == '-')
1893                esign = -1;
1894 
1895             cptr++;
1896 
1897             while (*cptr == ' ')        /* skip blanks between sign and exp */
1898               cptr++;
1899           }
1900 
1901           while (*cptr >= '0' && *cptr <= '9')
1902           {
1903             exponent = exponent * 10 + *cptr - chrzero;  /* accumulate exp */
1904             cptr++;
1905 
1906             while (*cptr == ' ')         /* skip embedded blanks */
1907               cptr++;
1908           }
1909         }
1910 
1911         if (*cptr  != 0)  /* should end up at the null terminator */
1912         {
1913           snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table");
1914           ffpmsg(message);
1915           snprintf(message, FLEN_ERRMSG,"Column field = %s.", cstring);
1916           ffpmsg(message);
1917           /* restore the char that was overwritten by the null */
1918           *tpos = tempstore;
1919           return(*status = BAD_C2D);
1920         }
1921 
1922         if (!decpt)  /* if no explicit decimal, use implied */
1923            power = implipower;
1924 
1925         dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
1926 
1927         dvalue = dvalue * scale + zero;   /* apply the scaling */
1928 
1929         if (dvalue < DLONG_MIN)
1930         {
1931             *status = OVERFLOW_ERR;
1932             output[ii] = LONG_MIN;
1933         }
1934         else if (dvalue > DLONG_MAX)
1935         {
1936             *status = OVERFLOW_ERR;
1937             output[ii] = LONG_MAX;
1938         }
1939         else
1940             output[ii] = (long) dvalue;
1941       }
1942       /* restore the char that was overwritten by the null */
1943       *tpos = tempstore;
1944     }
1945     return(*status);
1946 }
1947 
1948 /* ======================================================================== */
1949 /*      the following routines support the 'long long' data type            */
1950 /* ======================================================================== */
1951 
1952 /*--------------------------------------------------------------------------*/
ffgpvjj(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,LONGLONG nulval,LONGLONG * array,int * anynul,int * status)1953 int ffgpvjj(fitsfile *fptr,   /* I - FITS file pointer                       */
1954             long  group,      /* I - group to read (1 = 1st group)           */
1955             LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
1956             LONGLONG  nelem,      /* I - number of values to read                */
1957             LONGLONG  nulval, /* I - value for undefined pixels              */
1958             LONGLONG  *array, /* O - array of values that are returned       */
1959             int  *anynul,     /* O - set to 1 if any values are null; else 0 */
1960             int  *status)     /* IO - error status                           */
1961 /*
1962   Read an array of values from the primary array. Data conversion
1963   and scaling will be performed if necessary (e.g, if the datatype of
1964   the FITS array is not the same as the array being read).
1965   Undefined elements will be set equal to NULVAL, unless NULVAL=0
1966   in which case no checking for undefined values will be performed.
1967   ANYNUL is returned with a value of .true. if any pixels are undefined.
1968 */
1969 {
1970     long row;
1971     char cdummy;
1972     int nullcheck = 1;
1973     LONGLONG nullvalue;
1974 
1975     if (fits_is_compressed_image(fptr, status))
1976     {
1977         /* this is a compressed image in a binary table */
1978          nullvalue = nulval;  /* set local variable */
1979 
1980         fits_read_compressed_pixels(fptr, TLONGLONG, firstelem, nelem,
1981             nullcheck, &nullvalue, array, NULL, anynul, status);
1982         return(*status);
1983     }
1984 
1985     /*
1986       the primary array is represented as a binary table:
1987       each group of the primary array is a row in the table,
1988       where the first column contains the group parameters
1989       and the second column contains the image itself.
1990     */
1991 
1992     row=maxvalue(1,group);
1993 
1994     ffgcljj(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
1995                array, &cdummy, anynul, status);
1996     return(*status);
1997 }
1998 /*--------------------------------------------------------------------------*/
ffgpfjj(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,LONGLONG * array,char * nularray,int * anynul,int * status)1999 int ffgpfjj(fitsfile *fptr,   /* I - FITS file pointer                       */
2000             long  group,      /* I - group to read (1 = 1st group)           */
2001             LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
2002             LONGLONG  nelem,      /* I - number of values to read                */
2003             LONGLONG  *array, /* O - array of values that are returned       */
2004             char *nularray,   /* O - array of null pixel flags               */
2005             int  *anynul,     /* O - set to 1 if any values are null; else 0 */
2006             int  *status)     /* IO - error status                           */
2007 /*
2008   Read an array of values from the primary array. Data conversion
2009   and scaling will be performed if necessary (e.g, if the datatype of
2010   the FITS array is not the same as the array being read).
2011   Any undefined pixels in the returned array will be set = 0 and the
2012   corresponding nularray value will be set = 1.
2013   ANYNUL is returned with a value of .true. if any pixels are undefined.
2014 */
2015 {
2016     long row;
2017     int nullcheck = 2;
2018     LONGLONG dummy = 0;
2019 
2020     if (fits_is_compressed_image(fptr, status))
2021     {
2022         /* this is a compressed image in a binary table */
2023 
2024         fits_read_compressed_pixels(fptr, TLONGLONG, firstelem, nelem,
2025             nullcheck, NULL, array, nularray, anynul, status);
2026         return(*status);
2027     }
2028 
2029     /*
2030       the primary array is represented as a binary table:
2031       each group of the primary array is a row in the table,
2032       where the first column contains the group parameters
2033       and the second column contains the image itself.
2034     */
2035 
2036     row=maxvalue(1,group);
2037 
2038     ffgcljj(fptr, 2, row, firstelem, nelem, 1, 2, dummy,
2039                array, nularray, anynul, status);
2040     return(*status);
2041 }
2042 /*--------------------------------------------------------------------------*/
ffg2djj(fitsfile * fptr,long group,LONGLONG nulval,LONGLONG ncols,LONGLONG naxis1,LONGLONG naxis2,LONGLONG * array,int * anynul,int * status)2043 int ffg2djj(fitsfile *fptr, /* I - FITS file pointer                       */
2044            long  group,     /* I - group to read (1 = 1st group)           */
2045            LONGLONG nulval ,/* set undefined pixels equal to this          */
2046            LONGLONG  ncols,     /* I - number of pixels in each row of array   */
2047            LONGLONG  naxis1,    /* I - FITS image NAXIS1 value                 */
2048            LONGLONG  naxis2,    /* I - FITS image NAXIS2 value                 */
2049            LONGLONG  *array,/* O - array to be filled and returned         */
2050            int  *anynul,    /* O - set to 1 if any values are null; else 0 */
2051            int  *status)    /* IO - error status                           */
2052 /*
2053   Read an entire 2-D array of values to the primary array. Data conversion
2054   and scaling will be performed if necessary (e.g, if the datatype of the
2055   FITS array is not the same as the array being read).  Any null
2056   values in the array will be set equal to the value of nulval, unless
2057   nulval = 0 in which case no null checking will be performed.
2058 */
2059 {
2060     /* call the 3D reading routine, with the 3rd dimension = 1 */
2061 
2062     ffg3djj(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
2063            anynul, status);
2064 
2065     return(*status);
2066 }
2067 /*--------------------------------------------------------------------------*/
ffg3djj(fitsfile * fptr,long group,LONGLONG nulval,LONGLONG ncols,LONGLONG nrows,LONGLONG naxis1,LONGLONG naxis2,LONGLONG naxis3,LONGLONG * array,int * anynul,int * status)2068 int ffg3djj(fitsfile *fptr, /* I - FITS file pointer                       */
2069            long  group,     /* I - group to read (1 = 1st group)           */
2070            LONGLONG nulval, /* set undefined pixels equal to this          */
2071            LONGLONG  ncols,     /* I - number of pixels in each row of array   */
2072            LONGLONG  nrows,     /* I - number of rows in each plane of array   */
2073            LONGLONG  naxis1,    /* I - FITS image NAXIS1 value                 */
2074            LONGLONG  naxis2,    /* I - FITS image NAXIS2 value                 */
2075            LONGLONG  naxis3,    /* I - FITS image NAXIS3 value                 */
2076            LONGLONG  *array,/* O - array to be filled and returned         */
2077            int  *anynul,    /* O - set to 1 if any values are null; else 0 */
2078            int  *status)    /* IO - error status                           */
2079 /*
2080   Read an entire 3-D array of values to the primary array. Data conversion
2081   and scaling will be performed if necessary (e.g, if the datatype of the
2082   FITS array is not the same as the array being read).  Any null
2083   values in the array will be set equal to the value of nulval, unless
2084   nulval = 0 in which case no null checking will be performed.
2085 */
2086 {
2087     long tablerow, ii, jj;
2088     char cdummy;
2089     int nullcheck = 1;
2090     long inc[] = {1,1,1};
2091     LONGLONG fpixel[] = {1,1,1}, nfits, narray;
2092     LONGLONG lpixel[3];
2093     LONGLONG nullvalue;
2094 
2095     if (fits_is_compressed_image(fptr, status))
2096     {
2097         /* this is a compressed image in a binary table */
2098 
2099         lpixel[0] = ncols;
2100         lpixel[1] = nrows;
2101         lpixel[2] = naxis3;
2102         nullvalue = nulval;  /* set local variable */
2103 
2104         fits_read_compressed_img(fptr, TLONGLONG, fpixel, lpixel, inc,
2105             nullcheck, &nullvalue, array, NULL, anynul, status);
2106         return(*status);
2107     }
2108 
2109     /*
2110       the primary array is represented as a binary table:
2111       each group of the primary array is a row in the table,
2112       where the first column contains the group parameters
2113       and the second column contains the image itself.
2114     */
2115     tablerow=maxvalue(1,group);
2116 
2117     if (ncols == naxis1 && nrows == naxis2)  /* arrays have same size? */
2118     {
2119        /* all the image pixels are contiguous, so read all at once */
2120        ffgcljj(fptr, 2, tablerow, 1, naxis1 * naxis2 * naxis3, 1, 1, nulval,
2121                array, &cdummy, anynul, status);
2122        return(*status);
2123     }
2124 
2125     if (ncols < naxis1 || nrows < naxis2)
2126        return(*status = BAD_DIMEN);
2127 
2128     nfits = 1;   /* next pixel in FITS image to read */
2129     narray = 0;  /* next pixel in output array to be filled */
2130 
2131     /* loop over naxis3 planes in the data cube */
2132     for (jj = 0; jj < naxis3; jj++)
2133     {
2134       /* loop over the naxis2 rows in the FITS image, */
2135       /* reading naxis1 pixels to each row            */
2136 
2137       for (ii = 0; ii < naxis2; ii++)
2138       {
2139        if (ffgcljj(fptr, 2, tablerow, nfits, naxis1, 1, 1, nulval,
2140           &array[narray], &cdummy, anynul, status) > 0)
2141           return(*status);
2142 
2143        nfits += naxis1;
2144        narray += ncols;
2145       }
2146       narray += (nrows - naxis2) * ncols;
2147     }
2148 
2149     return(*status);
2150 }
2151 /*--------------------------------------------------------------------------*/
ffgsvjj(fitsfile * fptr,int colnum,int naxis,long * naxes,long * blc,long * trc,long * inc,LONGLONG nulval,LONGLONG * array,int * anynul,int * status)2152 int ffgsvjj(fitsfile *fptr, /* I - FITS file pointer                         */
2153            int  colnum,    /* I - number of the column to read (1 = 1st)    */
2154            int naxis,      /* I - number of dimensions in the FITS array    */
2155            long  *naxes,   /* I - size of each dimension                    */
2156            long  *blc,     /* I - 'bottom left corner' of the subsection    */
2157            long  *trc,     /* I - 'top right corner' of the subsection      */
2158            long  *inc,     /* I - increment to be applied in each dimension */
2159            LONGLONG nulval,/* I - value to set undefined pixels             */
2160            LONGLONG *array,/* O - array to be filled and returned           */
2161            int  *anynul,   /* O - set to 1 if any values are null; else 0   */
2162            int  *status)   /* IO - error status                             */
2163 /*
2164   Read a subsection of data values from an image or a table column.
2165   This routine is set up to handle a maximum of nine dimensions.
2166 */
2167 {
2168     long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
2169     long str[9],stp[9],incr[9],dir[9];
2170     long nelem, nultyp, ninc, numcol;
2171     LONGLONG felem, dsize[10], blcll[9], trcll[9];
2172     int hdutype, anyf;
2173     char ldummy, msg[FLEN_ERRMSG];
2174     int nullcheck = 1;
2175     LONGLONG nullvalue;
2176 
2177     if (naxis < 1 || naxis > 9)
2178     {
2179         snprintf(msg, FLEN_ERRMSG,"NAXIS = %d in call to ffgsvj is out of range", naxis);
2180         ffpmsg(msg);
2181         return(*status = BAD_DIMEN);
2182     }
2183 
2184     if (fits_is_compressed_image(fptr, status))
2185     {
2186         /* this is a compressed image in a binary table */
2187 
2188         for (ii=0; ii < naxis; ii++) {
2189 	    blcll[ii] = blc[ii];
2190 	    trcll[ii] = trc[ii];
2191 	}
2192 
2193         nullvalue = nulval;  /* set local variable */
2194 
2195         fits_read_compressed_img(fptr, TLONGLONG, blcll, trcll, inc,
2196             nullcheck, &nullvalue, array, NULL, anynul, status);
2197         return(*status);
2198     }
2199 
2200 /*
2201     if this is a primary array, then the input COLNUM parameter should
2202     be interpreted as the row number, and we will alway read the image
2203     data from column 2 (any group parameters are in column 1).
2204 */
2205     if (ffghdt(fptr, &hdutype, status) > 0)
2206         return(*status);
2207 
2208     if (hdutype == IMAGE_HDU)
2209     {
2210         /* this is a primary array, or image extension */
2211         if (colnum == 0)
2212         {
2213             rstr = 1;
2214             rstp = 1;
2215         }
2216         else
2217         {
2218             rstr = colnum;
2219             rstp = colnum;
2220         }
2221         rinc = 1;
2222         numcol = 2;
2223     }
2224     else
2225     {
2226         /* this is a table, so the row info is in the (naxis+1) elements */
2227         rstr = blc[naxis];
2228         rstp = trc[naxis];
2229         rinc = inc[naxis];
2230         numcol = colnum;
2231     }
2232 
2233     nultyp = 1;
2234     if (anynul)
2235         *anynul = FALSE;
2236 
2237     i0 = 0;
2238     for (ii = 0; ii < 9; ii++)
2239     {
2240         str[ii] = 1;
2241         stp[ii] = 1;
2242         incr[ii] = 1;
2243         dsize[ii] = 1;
2244         dir[ii] = 1;
2245     }
2246 
2247     for (ii = 0; ii < naxis; ii++)
2248     {
2249       if (trc[ii] < blc[ii])
2250       {
2251         if (hdutype == IMAGE_HDU)
2252         {
2253            dir[ii] = -1;
2254         }
2255         else
2256         {
2257           snprintf(msg, FLEN_ERRMSG,"ffgsvj: illegal range specified for axis %ld", ii + 1);
2258           ffpmsg(msg);
2259           return(*status = BAD_PIX_NUM);
2260         }
2261       }
2262 
2263       str[ii] = blc[ii];
2264       stp[ii] = trc[ii];
2265       incr[ii] = inc[ii];
2266       dsize[ii + 1] = dsize[ii] * naxes[ii];
2267       dsize[ii] = dsize[ii] * dir[ii];
2268     }
2269     dsize[naxis] = dsize[naxis] * dir[naxis];
2270 
2271     if (naxis == 1 && naxes[0] == 1)
2272     {
2273       /* This is not a vector column, so read all the rows at once */
2274       nelem = (rstp - rstr) / rinc + 1;
2275       ninc = rinc;
2276       rstp = rstr;
2277     }
2278     else
2279     {
2280       /* have to read each row individually, in all dimensions */
2281       nelem = (stp[0]*dir[0] - str[0]*dir[0]) / inc[0] + 1;
2282       ninc = incr[0] * dir[0];
2283     }
2284 
2285     for (row = rstr; row <= rstp; row += rinc)
2286     {
2287      for (i8 = str[8]*dir[8]; i8 <= stp[8]*dir[8]; i8 += incr[8])
2288      {
2289       for (i7 = str[7]*dir[7]; i7 <= stp[7]*dir[7]; i7 += incr[7])
2290       {
2291        for (i6 = str[6]*dir[6]; i6 <= stp[6]*dir[6]; i6 += incr[6])
2292        {
2293         for (i5 = str[5]*dir[5]; i5 <= stp[5]*dir[5]; i5 += incr[5])
2294         {
2295          for (i4 = str[4]*dir[4]; i4 <= stp[4]*dir[4]; i4 += incr[4])
2296          {
2297           for (i3 = str[3]*dir[3]; i3 <= stp[3]*dir[3]; i3 += incr[3])
2298           {
2299            for (i2 = str[2]*dir[2]; i2 <= stp[2]*dir[2]; i2 += incr[2])
2300            {
2301             for (i1 = str[1]*dir[1]; i1 <= stp[1]*dir[1]; i1 += incr[1])
2302             {
2303 
2304               felem=str[0] + (i1 - dir[1]) * dsize[1] + (i2 - dir[2]) * dsize[2] +
2305                              (i3 - dir[3]) * dsize[3] + (i4 - dir[4]) * dsize[4] +
2306                              (i5 - dir[5]) * dsize[5] + (i6 - dir[6]) * dsize[6] +
2307                              (i7 - dir[7]) * dsize[7] + (i8 - dir[8]) * dsize[8];
2308 
2309               if ( ffgcljj(fptr, numcol, row, felem, nelem, ninc, nultyp,
2310                    nulval, &array[i0], &ldummy, &anyf, status) > 0)
2311                    return(*status);
2312 
2313               if (anyf && anynul)
2314                   *anynul = TRUE;
2315 
2316               i0 += nelem;
2317             }
2318            }
2319           }
2320          }
2321         }
2322        }
2323       }
2324      }
2325     }
2326     return(*status);
2327 }
2328 /*--------------------------------------------------------------------------*/
ffgsfjj(fitsfile * fptr,int colnum,int naxis,long * naxes,long * blc,long * trc,long * inc,LONGLONG * array,char * flagval,int * anynul,int * status)2329 int ffgsfjj(fitsfile *fptr, /* I - FITS file pointer                         */
2330            int  colnum,    /* I - number of the column to read (1 = 1st)    */
2331            int naxis,      /* I - number of dimensions in the FITS array    */
2332            long  *naxes,   /* I - size of each dimension                    */
2333            long  *blc,     /* I - 'bottom left corner' of the subsection    */
2334            long  *trc,     /* I - 'top right corner' of the subsection      */
2335            long  *inc,     /* I - increment to be applied in each dimension */
2336            LONGLONG *array,/* O - array to be filled and returned           */
2337            char *flagval,  /* O - set to 1 if corresponding value is null   */
2338            int  *anynul,   /* O - set to 1 if any values are null; else 0   */
2339            int  *status)   /* IO - error status                             */
2340 /*
2341   Read a subsection of data values from an image or a table column.
2342   This routine is set up to handle a maximum of nine dimensions.
2343 */
2344 {
2345     long ii,i0, i1,i2,i3,i4,i5,i6,i7,i8,row,rstr,rstp,rinc;
2346     long str[9],stp[9],incr[9],dsize[10];
2347     LONGLONG blcll[9], trcll[9];
2348     long felem, nelem, nultyp, ninc, numcol;
2349     LONGLONG nulval = 0;
2350     int hdutype, anyf;
2351     char msg[FLEN_ERRMSG];
2352     int nullcheck = 2;
2353 
2354     if (naxis < 1 || naxis > 9)
2355     {
2356         snprintf(msg, FLEN_ERRMSG,"NAXIS = %d in call to ffgsvj is out of range", naxis);
2357         ffpmsg(msg);
2358         return(*status = BAD_DIMEN);
2359     }
2360 
2361     if (fits_is_compressed_image(fptr, status))
2362     {
2363         /* this is a compressed image in a binary table */
2364 
2365         for (ii=0; ii < naxis; ii++) {
2366 	    blcll[ii] = blc[ii];
2367 	    trcll[ii] = trc[ii];
2368 	}
2369 
2370          fits_read_compressed_img(fptr, TLONGLONG, blcll, trcll, inc,
2371             nullcheck, NULL, array, flagval, anynul, status);
2372         return(*status);
2373     }
2374 
2375 /*
2376     if this is a primary array, then the input COLNUM parameter should
2377     be interpreted as the row number, and we will alway read the image
2378     data from column 2 (any group parameters are in column 1).
2379 */
2380     if (ffghdt(fptr, &hdutype, status) > 0)
2381         return(*status);
2382 
2383     if (hdutype == IMAGE_HDU)
2384     {
2385         /* this is a primary array, or image extension */
2386         if (colnum == 0)
2387         {
2388             rstr = 1;
2389             rstp = 1;
2390         }
2391         else
2392         {
2393             rstr = colnum;
2394             rstp = colnum;
2395         }
2396         rinc = 1;
2397         numcol = 2;
2398     }
2399     else
2400     {
2401         /* this is a table, so the row info is in the (naxis+1) elements */
2402         rstr = blc[naxis];
2403         rstp = trc[naxis];
2404         rinc = inc[naxis];
2405         numcol = colnum;
2406     }
2407 
2408     nultyp = 2;
2409     if (anynul)
2410         *anynul = FALSE;
2411 
2412     i0 = 0;
2413     for (ii = 0; ii < 9; ii++)
2414     {
2415         str[ii] = 1;
2416         stp[ii] = 1;
2417         incr[ii] = 1;
2418         dsize[ii] = 1;
2419     }
2420 
2421     for (ii = 0; ii < naxis; ii++)
2422     {
2423       if (trc[ii] < blc[ii])
2424       {
2425         snprintf(msg, FLEN_ERRMSG,"ffgsvj: illegal range specified for axis %ld", ii + 1);
2426         ffpmsg(msg);
2427         return(*status = BAD_PIX_NUM);
2428       }
2429 
2430       str[ii] = blc[ii];
2431       stp[ii] = trc[ii];
2432       incr[ii] = inc[ii];
2433       dsize[ii + 1] = dsize[ii] * naxes[ii];
2434     }
2435 
2436     if (naxis == 1 && naxes[0] == 1)
2437     {
2438       /* This is not a vector column, so read all the rows at once */
2439       nelem = (rstp - rstr) / rinc + 1;
2440       ninc = rinc;
2441       rstp = rstr;
2442     }
2443     else
2444     {
2445       /* have to read each row individually, in all dimensions */
2446       nelem = (stp[0] - str[0]) / inc[0] + 1;
2447       ninc = incr[0];
2448     }
2449 
2450     for (row = rstr; row <= rstp; row += rinc)
2451     {
2452      for (i8 = str[8]; i8 <= stp[8]; i8 += incr[8])
2453      {
2454       for (i7 = str[7]; i7 <= stp[7]; i7 += incr[7])
2455       {
2456        for (i6 = str[6]; i6 <= stp[6]; i6 += incr[6])
2457        {
2458         for (i5 = str[5]; i5 <= stp[5]; i5 += incr[5])
2459         {
2460          for (i4 = str[4]; i4 <= stp[4]; i4 += incr[4])
2461          {
2462           for (i3 = str[3]; i3 <= stp[3]; i3 += incr[3])
2463           {
2464            for (i2 = str[2]; i2 <= stp[2]; i2 += incr[2])
2465            {
2466             for (i1 = str[1]; i1 <= stp[1]; i1 += incr[1])
2467             {
2468               felem=str[0] + (i1 - 1) * dsize[1] + (i2 - 1) * dsize[2] +
2469                              (i3 - 1) * dsize[3] + (i4 - 1) * dsize[4] +
2470                              (i5 - 1) * dsize[5] + (i6 - 1) * dsize[6] +
2471                              (i7 - 1) * dsize[7] + (i8 - 1) * dsize[8];
2472 
2473               if ( ffgcljj(fptr, numcol, row, felem, nelem, ninc, nultyp,
2474                    nulval, &array[i0], &flagval[i0], &anyf, status) > 0)
2475                    return(*status);
2476 
2477               if (anyf && anynul)
2478                   *anynul = TRUE;
2479 
2480               i0 += nelem;
2481             }
2482            }
2483           }
2484          }
2485         }
2486        }
2487       }
2488      }
2489     }
2490     return(*status);
2491 }
2492 /*--------------------------------------------------------------------------*/
ffggpjj(fitsfile * fptr,long group,long firstelem,long nelem,LONGLONG * array,int * status)2493 int ffggpjj(fitsfile *fptr,   /* I - FITS file pointer                       */
2494             long  group,      /* I - group to read (1 = 1st group)           */
2495             long  firstelem,  /* I - first vector element to read (1 = 1st)  */
2496             long  nelem,      /* I - number of values to read                */
2497             LONGLONG  *array, /* O - array of values that are returned       */
2498             int  *status)     /* IO - error status                           */
2499 /*
2500   Read an array of group parameters from the primary array. Data conversion
2501   and scaling will be performed if necessary (e.g, if the datatype of
2502   the FITS array is not the same as the array being read).
2503 */
2504 {
2505     long row;
2506     int idummy;
2507     char cdummy;
2508     LONGLONG dummy = 0;
2509 
2510     /*
2511       the primary array is represented as a binary table:
2512       each group of the primary array is a row in the table,
2513       where the first column contains the group parameters
2514       and the second column contains the image itself.
2515     */
2516 
2517     row=maxvalue(1,group);
2518 
2519     ffgcljj(fptr, 1, row, firstelem, nelem, 1, 1, dummy,
2520                array, &cdummy, &idummy, status);
2521     return(*status);
2522 }
2523 /*--------------------------------------------------------------------------*/
ffgcvjj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,LONGLONG nulval,LONGLONG * array,int * anynul,int * status)2524 int ffgcvjj(fitsfile *fptr,  /* I - FITS file pointer                       */
2525            int  colnum,      /* I - number of column to read (1 = 1st col)  */
2526            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
2527            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
2528            LONGLONG  nelem,      /* I - number of values to read                */
2529            LONGLONG  nulval, /* I - value for null pixels                   */
2530            LONGLONG *array,  /* O - array of values that are read           */
2531            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
2532            int  *status)     /* IO - error status                           */
2533 /*
2534   Read an array of values from a column in the current FITS HDU. Automatic
2535   datatype conversion will be performed if the datatype of the column does not
2536   match the datatype of the array parameter. The output values will be scaled
2537   by the FITS TSCALn and TZEROn values if these values have been defined.
2538   Any undefined pixels will be set equal to the value of 'nulval' unless
2539   nulval = 0 in which case no checks for undefined pixels will be made.
2540 */
2541 {
2542     char cdummy;
2543 
2544     ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
2545            array, &cdummy, anynul, status);
2546     return(*status);
2547 }
2548 /*--------------------------------------------------------------------------*/
ffgcfjj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,LONGLONG * array,char * nularray,int * anynul,int * status)2549 int ffgcfjj(fitsfile *fptr,  /* I - FITS file pointer                       */
2550            int  colnum,      /* I - number of column to read (1 = 1st col)  */
2551            LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
2552            LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
2553            LONGLONG  nelem,      /* I - number of values to read                */
2554            LONGLONG  *array, /* O - array of values that are read           */
2555            char *nularray,   /* O - array of flags: 1 if null pixel; else 0 */
2556            int  *anynul,     /* O - set to 1 if any values are null; else 0 */
2557            int  *status)     /* IO - error status                           */
2558 /*
2559   Read an array of values from a column in the current FITS HDU. Automatic
2560   datatype conversion will be performed if the datatype of the column does not
2561   match the datatype of the array parameter. The output values will be scaled
2562   by the FITS TSCALn and TZEROn values if these values have been defined.
2563   Nularray will be set = 1 if the corresponding array pixel is undefined,
2564   otherwise nularray will = 0.
2565 */
2566 {
2567     LONGLONG dummy = 0;
2568 
2569     ffgcljj(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
2570            array, nularray, anynul, status);
2571     return(*status);
2572 }
2573 /*--------------------------------------------------------------------------*/
ffgcljj(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,long elemincre,int nultyp,LONGLONG nulval,LONGLONG * array,char * nularray,int * anynul,int * status)2574 int ffgcljj( fitsfile *fptr,   /* I - FITS file pointer                       */
2575             int  colnum,      /* I - number of column to read (1 = 1st col)  */
2576             LONGLONG  firstrow,   /* I - first row to read (1 = 1st row)         */
2577             LONGLONG firstelem,  /* I - first vector element to read (1 = 1st)  */
2578             LONGLONG  nelem,      /* I - number of values to read                */
2579             long  elemincre,  /* I - pixel increment; e.g., 2 = every other  */
2580             int   nultyp,     /* I - null value handling code:               */
2581                               /*     1: set undefined pixels = nulval        */
2582                               /*     2: set nularray=1 for undefined pixels  */
2583             LONGLONG  nulval, /* I - value for null pixels if nultyp = 1     */
2584             LONGLONG  *array, /* O - array of values that are read           */
2585             char *nularray,   /* O - array of flags = 1 if nultyp = 2        */
2586             int  *anynul,     /* O - set to 1 if any values are null; else 0 */
2587             int  *status)     /* IO - error status                           */
2588 /*
2589   Read an array of values from a column in the current FITS HDU.
2590   The column number may refer to a real column in an ASCII or binary table,
2591   or it may refer be a virtual column in a 1 or more grouped FITS primary
2592   array or image extension.  FITSIO treats a primary array as a binary table
2593   with 2 vector columns: the first column contains the group parameters (often
2594   with length = 0) and the second column contains the array of image pixels.
2595   Each row of the table represents a group in the case of multigroup FITS
2596   images.
2597 
2598   The output array of values will be converted from the datatype of the column
2599   and will be scaled by the FITS TSCALn and TZEROn values if necessary.
2600 */
2601 {
2602     double scale, zero, power = 1., dtemp;
2603     int tcode, maxelem2, hdutype, xcode, decimals;
2604     long twidth, incre;
2605     long ii, xwidth, ntodo;
2606     int convert, nulcheck, readcheck = 0;
2607     LONGLONG repeat, startpos, elemnum, readptr, tnull;
2608     LONGLONG rowlen, rownum, remain, next, rowincre, maxelem;
2609     char tform[20];
2610     char message[FLEN_ERRMSG];
2611     char snull[20];   /*  the FITS null value if reading from ASCII table  */
2612 
2613     double cbuff[DBUFFSIZE / sizeof(double)]; /* align cbuff on word boundary */
2614     void *buffer;
2615 
2616     if (*status > 0 || nelem == 0)  /* inherit input status value if > 0 */
2617         return(*status);
2618 
2619     buffer = cbuff;
2620 
2621     if (anynul)
2622         *anynul = 0;
2623 
2624     if (nultyp == 2)
2625         memset(nularray, 0, (size_t) nelem);   /* initialize nullarray */
2626 
2627     /*---------------------------------------------------*/
2628     /*  Check input and get parameters about the column: */
2629     /*---------------------------------------------------*/
2630     if (elemincre < 0)
2631         readcheck = -1;  /* don't do range checking in this case */
2632 
2633     if (ffgcprll(fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
2634          tform, &twidth, &tcode, &maxelem2, &startpos, &elemnum, &incre,
2635          &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 )
2636          return(*status);
2637     maxelem = maxelem2;
2638 
2639     incre *= elemincre;   /* multiply incre to just get every nth pixel */
2640 
2641     if (tcode == TSTRING)    /* setup for ASCII tables */
2642     {
2643       /* get the number of implied decimal places if no explicit decmal point */
2644       ffasfm(tform, &xcode, &xwidth, &decimals, status);
2645       for(ii = 0; ii < decimals; ii++)
2646         power *= 10.;
2647     }
2648     /*------------------------------------------------------------------*/
2649     /*  Decide whether to check for null values in the input FITS file: */
2650     /*------------------------------------------------------------------*/
2651     nulcheck = nultyp; /* by default check for null values in the FITS file */
2652 
2653     if (nultyp == 1 && nulval == 0)
2654        nulcheck = 0;    /* calling routine does not want to check for nulls */
2655 
2656     else if (tcode%10 == 1 &&        /* if reading an integer column, and  */
2657             tnull == NULL_UNDEFINED) /* if a null value is not defined,    */
2658             nulcheck = 0;            /* then do not check for null values. */
2659 
2660     else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
2661             nulcheck = 0;            /* Impossible null value */
2662 
2663     else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
2664             nulcheck = 0;            /* Impossible null value */
2665 
2666     else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
2667          nulcheck = 0;
2668 
2669     /*----------------------------------------------------------------------*/
2670     /*  If FITS column and output data array have same datatype, then we do */
2671     /*  not need to use a temporary buffer to store intermediate datatype.  */
2672     /*----------------------------------------------------------------------*/
2673     convert = 1;
2674     if (tcode == TLONGLONG)  /* Special Case:                        */
2675     {                             /* no type convertion required, so read */
2676                                   /* data directly into output buffer.    */
2677 
2678         if (nelem < (LONGLONG)INT32_MAX/8) {
2679             maxelem = nelem;
2680         } else {
2681             maxelem = INT32_MAX/8;
2682         }
2683 
2684         if (nulcheck == 0 && scale == 1. && zero == 0.)
2685             convert = 0;  /* no need to scale data or find nulls */
2686     }
2687 
2688     /*---------------------------------------------------------------------*/
2689     /*  Now read the pixels from the FITS column. If the column does not   */
2690     /*  have the same datatype as the output array, then we have to read   */
2691     /*  the raw values into a temporary buffer (of limited size).  In      */
2692     /*  the case of a vector colum read only 1 vector of values at a time  */
2693     /*  then skip to the next row if more values need to be read.          */
2694     /*  After reading the raw values, then call the fffXXYY routine to (1) */
2695     /*  test for undefined values, (2) convert the datatype if necessary,  */
2696     /*  and (3) scale the values by the FITS TSCALn and TZEROn linear      */
2697     /*  scaling parameters.                                                */
2698     /*---------------------------------------------------------------------*/
2699     remain = nelem;           /* remaining number of values to read */
2700     next = 0;                 /* next element in array to be read   */
2701     rownum = 0;               /* row number, relative to firstrow   */
2702 
2703     while (remain)
2704     {
2705         /* limit the number of pixels to read at one time to the number that
2706            will fit in the buffer or to the number of pixels that remain in
2707            the current vector, which ever is smaller.
2708         */
2709         ntodo = (long) minvalue(remain, maxelem);
2710         if (elemincre >= 0)
2711         {
2712           ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
2713         }
2714         else
2715         {
2716           ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
2717         }
2718 
2719         readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
2720 
2721         switch (tcode)
2722         {
2723             case (TLONGLONG):
2724                 ffgi8b(fptr, readptr, ntodo, incre, (long *) &array[next],
2725                        status);
2726                 if (convert)
2727                     fffi8i8((LONGLONG *) &array[next], ntodo, scale, zero,
2728                            nulcheck, tnull, nulval, &nularray[next],
2729                            anynul, &array[next], status);
2730                 break;
2731             case (TLONG):
2732                 ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
2733                        status);
2734                 fffi4i8((INT32BIT *) buffer, ntodo, scale, zero,
2735                         nulcheck, (INT32BIT) tnull, nulval, &nularray[next],
2736                         anynul, &array[next], status);
2737                 break;
2738             case (TBYTE):
2739                 ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
2740                        status);
2741                 fffi1i8((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
2742                      (unsigned char) tnull, nulval, &nularray[next], anynul,
2743                      &array[next], status);
2744                 break;
2745             case (TSHORT):
2746                 ffgi2b(fptr, readptr, ntodo, incre, (short  *) buffer, status);
2747                 fffi2i8((short  *) buffer, ntodo, scale, zero, nulcheck,
2748                       (short) tnull, nulval, &nularray[next], anynul,
2749                       &array[next], status);
2750                 break;
2751             case (TFLOAT):
2752                 ffgr4b(fptr, readptr, ntodo, incre, (float  *) buffer, status);
2753                 fffr4i8((float  *) buffer, ntodo, scale, zero, nulcheck,
2754                        nulval, &nularray[next], anynul,
2755                        &array[next], status);
2756                 break;
2757             case (TDOUBLE):
2758                 ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
2759                 fffr8i8((double *) buffer, ntodo, scale, zero, nulcheck,
2760                           nulval, &nularray[next], anynul,
2761                           &array[next], status);
2762                 break;
2763             case (TSTRING):
2764                 ffmbyt(fptr, readptr, REPORT_EOF, status);
2765 
2766                 if (incre == twidth)    /* contiguous bytes */
2767                      ffgbyt(fptr, ntodo * twidth, buffer, status);
2768                 else
2769                      ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
2770                                status);
2771 
2772                 fffstri8((char *) buffer, ntodo, scale, zero, twidth, power,
2773                      nulcheck, snull, nulval, &nularray[next], anynul,
2774                      &array[next], status);
2775                 break;
2776 
2777             default:  /*  error trap for invalid column format */
2778                 snprintf(message,FLEN_ERRMSG,
2779                    "Cannot read numbers from column %d which has format %s",
2780                     colnum, tform);
2781                 ffpmsg(message);
2782                 if (hdutype == ASCII_TBL)
2783                     return(*status = BAD_ATABLE_FORMAT);
2784                 else
2785                     return(*status = BAD_BTABLE_FORMAT);
2786 
2787         } /* End of switch block */
2788 
2789         /*-------------------------*/
2790         /*  Check for fatal error  */
2791         /*-------------------------*/
2792         if (*status > 0)  /* test for error during previous read operation */
2793         {
2794 	  dtemp = (double) next;
2795           if (hdutype > 0)
2796             snprintf(message,FLEN_ERRMSG,
2797             "Error reading elements %.0f thru %.0f from column %d (ffgclj).",
2798               dtemp+1., dtemp+ntodo, colnum);
2799           else
2800             snprintf(message,FLEN_ERRMSG,
2801             "Error reading elements %.0f thru %.0f from image (ffgclj).",
2802               dtemp+1., dtemp+ntodo);
2803 
2804           ffpmsg(message);
2805           return(*status);
2806         }
2807 
2808         /*--------------------------------------------*/
2809         /*  increment the counters for the next loop  */
2810         /*--------------------------------------------*/
2811         remain -= ntodo;
2812         if (remain)
2813         {
2814             next += ntodo;
2815             elemnum = elemnum + (ntodo * elemincre);
2816 
2817             if (elemnum >= repeat)  /* completed a row; start on later row */
2818             {
2819                 rowincre = elemnum / repeat;
2820                 rownum += rowincre;
2821                 elemnum = elemnum - (rowincre * repeat);
2822             }
2823             else if (elemnum < 0)  /* completed a row; start on a previous row */
2824             {
2825                 rowincre = (-elemnum - 1) / repeat + 1;
2826                 rownum -= rowincre;
2827                 elemnum = (rowincre * repeat) + elemnum;
2828             }
2829         }
2830     }  /*  End of main while Loop  */
2831 
2832 
2833     /*--------------------------------*/
2834     /*  check for numerical overflow  */
2835     /*--------------------------------*/
2836     if (*status == OVERFLOW_ERR)
2837     {
2838         ffpmsg(
2839         "Numerical overflow during type conversion while reading FITS data.");
2840         *status = NUM_OVERFLOW;
2841     }
2842 
2843     return(*status);
2844 }
2845 /*--------------------------------------------------------------------------*/
fffi1i8(unsigned char * input,long ntodo,double scale,double zero,int nullcheck,unsigned char tnull,LONGLONG nullval,char * nullarray,int * anynull,LONGLONG * output,int * status)2846 int fffi1i8(unsigned char *input, /* I - array of values to be converted     */
2847             long ntodo,           /* I - number of elements in the array     */
2848             double scale,         /* I - FITS TSCALn or BSCALE value         */
2849             double zero,          /* I - FITS TZEROn or BZERO  value         */
2850             int nullcheck,        /* I - null checking code; 0 = don't check */
2851                                   /*     1:set null pixels = nullval         */
2852                                   /*     2: if null pixel, set nullarray = 1 */
2853             unsigned char tnull,  /* I - value of FITS TNULLn keyword if any */
2854             LONGLONG nullval,     /* I - set null pixels, if nullcheck = 1   */
2855             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
2856             int  *anynull,        /* O - set to 1 if any pixels are null     */
2857             LONGLONG *output,     /* O - array of converted pixels           */
2858             int *status)          /* IO - error status                       */
2859 /*
2860   Copy input to output following reading of the input from a FITS file.
2861   Check for null values and do datatype conversion and scaling if required.
2862   The nullcheck code value determines how any null values in the input array
2863   are treated.  A null value is an input pixel that is equal to tnull.  If
2864   nullcheck = 0, then no checking for nulls is performed and any null values
2865   will be transformed just like any other pixel.  If nullcheck = 1, then the
2866   output pixel will be set = nullval if the corresponding input pixel is null.
2867   If nullcheck = 2, then if the pixel is null then the corresponding value of
2868   nullarray will be set to 1; the value of nullarray for non-null pixels
2869   will = 0.  The anynull parameter will be set = 1 if any of the returned
2870   pixels are null, otherwise anynull will be returned with a value = 0;
2871 */
2872 {
2873     long ii;
2874     double dvalue;
2875 
2876     if (nullcheck == 0)     /* no null checking required */
2877     {
2878         if (scale == 1. && zero == 0.)      /* no scaling */
2879         {
2880             for (ii = 0; ii < ntodo; ii++)
2881                 output[ii] = (LONGLONG) input[ii];  /* copy input to output */
2882         }
2883         else             /* must scale the data */
2884         {
2885             for (ii = 0; ii < ntodo; ii++)
2886             {
2887                 dvalue = input[ii] * scale + zero;
2888 
2889                 if (dvalue < DLONGLONG_MIN)
2890                 {
2891                     *status = OVERFLOW_ERR;
2892                     output[ii] = LONGLONG_MIN;
2893                 }
2894                 else if (dvalue > DLONGLONG_MAX)
2895                 {
2896                     *status = OVERFLOW_ERR;
2897                     output[ii] = LONGLONG_MAX;
2898                 }
2899                 else
2900                     output[ii] = (LONGLONG) dvalue;
2901             }
2902         }
2903     }
2904     else        /* must check for null values */
2905     {
2906         if (scale == 1. && zero == 0.)  /* no scaling */
2907         {
2908             for (ii = 0; ii < ntodo; ii++)
2909             {
2910                 if (input[ii] == tnull)
2911                 {
2912                     *anynull = 1;
2913                     if (nullcheck == 1)
2914                         output[ii] = nullval;
2915                     else
2916                         nullarray[ii] = 1;
2917                 }
2918                 else
2919                     output[ii] = (LONGLONG) input[ii];
2920             }
2921         }
2922         else                  /* must scale the data */
2923         {
2924             for (ii = 0; ii < ntodo; ii++)
2925             {
2926                 if (input[ii] == tnull)
2927                 {
2928                     *anynull = 1;
2929                     if (nullcheck == 1)
2930                         output[ii] = nullval;
2931                     else
2932                         nullarray[ii] = 1;
2933                 }
2934                 else
2935                 {
2936                     dvalue = input[ii] * scale + zero;
2937 
2938                     if (dvalue < DLONGLONG_MIN)
2939                     {
2940                         *status = OVERFLOW_ERR;
2941                         output[ii] = LONGLONG_MIN;
2942                     }
2943                     else if (dvalue > DLONGLONG_MAX)
2944                     {
2945                         *status = OVERFLOW_ERR;
2946                         output[ii] = LONGLONG_MAX;
2947                     }
2948                     else
2949                         output[ii] = (LONGLONG) dvalue;
2950                 }
2951             }
2952         }
2953     }
2954     return(*status);
2955 }
2956 /*--------------------------------------------------------------------------*/
fffi2i8(short * input,long ntodo,double scale,double zero,int nullcheck,short tnull,LONGLONG nullval,char * nullarray,int * anynull,LONGLONG * output,int * status)2957 int fffi2i8(short *input,         /* I - array of values to be converted     */
2958             long ntodo,           /* I - number of elements in the array     */
2959             double scale,         /* I - FITS TSCALn or BSCALE value         */
2960             double zero,          /* I - FITS TZEROn or BZERO  value         */
2961             int nullcheck,        /* I - null checking code; 0 = don't check */
2962                                   /*     1:set null pixels = nullval         */
2963                                   /*     2: if null pixel, set nullarray = 1 */
2964             short tnull,          /* I - value of FITS TNULLn keyword if any */
2965             LONGLONG nullval,     /* I - set null pixels, if nullcheck = 1   */
2966             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
2967             int  *anynull,        /* O - set to 1 if any pixels are null     */
2968             LONGLONG *output,     /* O - array of converted pixels           */
2969             int *status)          /* IO - error status                       */
2970 /*
2971   Copy input to output following reading of the input from a FITS file.
2972   Check for null values and do datatype conversion and scaling if required.
2973   The nullcheck code value determines how any null values in the input array
2974   are treated.  A null value is an input pixel that is equal to tnull.  If
2975   nullcheck = 0, then no checking for nulls is performed and any null values
2976   will be transformed just like any other pixel.  If nullcheck = 1, then the
2977   output pixel will be set = nullval if the corresponding input pixel is null.
2978   If nullcheck = 2, then if the pixel is null then the corresponding value of
2979   nullarray will be set to 1; the value of nullarray for non-null pixels
2980   will = 0.  The anynull parameter will be set = 1 if any of the returned
2981   pixels are null, otherwise anynull will be returned with a value = 0;
2982 */
2983 {
2984     long ii;
2985     double dvalue;
2986 
2987     if (nullcheck == 0)     /* no null checking required */
2988     {
2989         if (scale == 1. && zero == 0.)      /* no scaling */
2990         {
2991             for (ii = 0; ii < ntodo; ii++)
2992                 output[ii] = (LONGLONG) input[ii];   /* copy input to output */
2993         }
2994         else             /* must scale the data */
2995         {
2996             for (ii = 0; ii < ntodo; ii++)
2997             {
2998                 dvalue = input[ii] * scale + zero;
2999 
3000                 if (dvalue < DLONGLONG_MIN)
3001                 {
3002                     *status = OVERFLOW_ERR;
3003                     output[ii] = LONGLONG_MIN;
3004                 }
3005                 else if (dvalue > DLONGLONG_MAX)
3006                 {
3007                     *status = OVERFLOW_ERR;
3008                     output[ii] = LONGLONG_MAX;
3009                 }
3010                 else
3011                     output[ii] = (LONGLONG) dvalue;
3012             }
3013         }
3014     }
3015     else        /* must check for null values */
3016     {
3017         if (scale == 1. && zero == 0.)  /* no scaling */
3018         {
3019             for (ii = 0; ii < ntodo; ii++)
3020             {
3021                 if (input[ii] == tnull)
3022                 {
3023                     *anynull = 1;
3024                     if (nullcheck == 1)
3025                         output[ii] = nullval;
3026                     else
3027                         nullarray[ii] = 1;
3028                 }
3029                 else
3030                     output[ii] = (LONGLONG) input[ii];
3031             }
3032         }
3033         else                  /* must scale the data */
3034         {
3035             for (ii = 0; ii < ntodo; ii++)
3036             {
3037                 if (input[ii] == tnull)
3038                 {
3039                     *anynull = 1;
3040                     if (nullcheck == 1)
3041                         output[ii] = nullval;
3042                     else
3043                         nullarray[ii] = 1;
3044                 }
3045                 else
3046                 {
3047                     dvalue = input[ii] * scale + zero;
3048 
3049                     if (dvalue < DLONGLONG_MIN)
3050                     {
3051                         *status = OVERFLOW_ERR;
3052                         output[ii] = LONGLONG_MIN;
3053                     }
3054                     else if (dvalue > DLONGLONG_MAX)
3055                     {
3056                         *status = OVERFLOW_ERR;
3057                         output[ii] = LONGLONG_MAX;
3058                     }
3059                     else
3060                         output[ii] = (LONGLONG) dvalue;
3061                 }
3062             }
3063         }
3064     }
3065     return(*status);
3066 }
3067 /*--------------------------------------------------------------------------*/
fffi4i8(INT32BIT * input,long ntodo,double scale,double zero,int nullcheck,INT32BIT tnull,LONGLONG nullval,char * nullarray,int * anynull,LONGLONG * output,int * status)3068 int fffi4i8(INT32BIT *input,      /* I - array of values to be converted     */
3069             long ntodo,           /* I - number of elements in the array     */
3070             double scale,         /* I - FITS TSCALn or BSCALE value         */
3071             double zero,          /* I - FITS TZEROn or BZERO  value         */
3072             int nullcheck,        /* I - null checking code; 0 = don't check */
3073                                   /*     1:set null pixels = nullval         */
3074                                   /*     2: if null pixel, set nullarray = 1 */
3075             INT32BIT tnull,       /* I - value of FITS TNULLn keyword if any */
3076             LONGLONG nullval,     /* I - set null pixels, if nullcheck = 1   */
3077             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
3078             int  *anynull,        /* O - set to 1 if any pixels are null     */
3079             LONGLONG *output,     /* O - array of converted pixels           */
3080             int *status)          /* IO - error status                       */
3081 /*
3082   Copy input to output following reading of the input from a FITS file.
3083   Check for null values and do datatype conversion and scaling if required.
3084   The nullcheck code value determines how any null values in the input array
3085   are treated.  A null value is an input pixel that is equal to tnull.  If
3086   nullcheck = 0, then no checking for nulls is performed and any null values
3087   will be transformed just like any other pixel.  If nullcheck = 1, then the
3088   output pixel will be set = nullval if the corresponding input pixel is null.
3089   If nullcheck = 2, then if the pixel is null then the corresponding value of
3090   nullarray will be set to 1; the value of nullarray for non-null pixels
3091   will = 0.  The anynull parameter will be set = 1 if any of the returned
3092   pixels are null, otherwise anynull will be returned with a value = 0;
3093 */
3094 {
3095     long ii;
3096     double dvalue;
3097 
3098     if (nullcheck == 0)     /* no null checking required */
3099     {
3100         if (scale == 1. && zero == 0.)      /* no scaling */
3101         {
3102             for (ii = 0; ii < ntodo; ii++)
3103                 output[ii] = (LONGLONG) input[ii];   /* copy input to output */
3104         }
3105         else             /* must scale the data */
3106         {
3107             for (ii = 0; ii < ntodo; ii++)
3108             {
3109                 dvalue = input[ii] * scale + zero;
3110 
3111                 if (dvalue < DLONGLONG_MIN)
3112                 {
3113                     *status = OVERFLOW_ERR;
3114                     output[ii] = LONGLONG_MIN;
3115                 }
3116                 else if (dvalue > DLONGLONG_MAX)
3117                 {
3118                     *status = OVERFLOW_ERR;
3119                     output[ii] = LONGLONG_MAX;
3120                 }
3121                 else
3122                     output[ii] = (LONGLONG) dvalue;
3123             }
3124         }
3125     }
3126     else        /* must check for null values */
3127     {
3128         if (scale == 1. && zero == 0.)  /* no scaling */
3129         {
3130             for (ii = 0; ii < ntodo; ii++)
3131             {
3132                 if (input[ii] == tnull)
3133                 {
3134                     *anynull = 1;
3135                     if (nullcheck == 1)
3136                         output[ii] = nullval;
3137                     else
3138                         nullarray[ii] = 1;
3139                 }
3140                 else
3141                     output[ii] = (LONGLONG) input[ii];
3142 
3143             }
3144         }
3145         else                  /* must scale the data */
3146         {
3147             for (ii = 0; ii < ntodo; ii++)
3148             {
3149                 if (input[ii] == tnull)
3150                 {
3151                     *anynull = 1;
3152                     if (nullcheck == 1)
3153                         output[ii] = nullval;
3154                     else
3155                         nullarray[ii] = 1;
3156                 }
3157                 else
3158                 {
3159                     dvalue = input[ii] * scale + zero;
3160 
3161                     if (dvalue < DLONGLONG_MIN)
3162                     {
3163                         *status = OVERFLOW_ERR;
3164                         output[ii] = LONGLONG_MIN;
3165                     }
3166                     else if (dvalue > DLONGLONG_MAX)
3167                     {
3168                         *status = OVERFLOW_ERR;
3169                         output[ii] = LONGLONG_MAX;
3170                     }
3171                     else
3172                         output[ii] = (LONGLONG) dvalue;
3173                 }
3174             }
3175         }
3176     }
3177     return(*status);
3178 }
3179 /*--------------------------------------------------------------------------*/
fffi8i8(LONGLONG * input,long ntodo,double scale,double zero,int nullcheck,LONGLONG tnull,LONGLONG nullval,char * nullarray,int * anynull,LONGLONG * output,int * status)3180 int fffi8i8(LONGLONG *input,      /* I - array of values to be converted     */
3181             long ntodo,           /* I - number of elements in the array     */
3182             double scale,         /* I - FITS TSCALn or BSCALE value         */
3183             double zero,          /* I - FITS TZEROn or BZERO  value         */
3184             int nullcheck,        /* I - null checking code; 0 = don't check */
3185                                   /*     1:set null pixels = nullval         */
3186                                   /*     2: if null pixel, set nullarray = 1 */
3187             LONGLONG tnull,       /* I - value of FITS TNULLn keyword if any */
3188             LONGLONG nullval,     /* I - set null pixels, if nullcheck = 1   */
3189             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
3190             int  *anynull,        /* O - set to 1 if any pixels are null     */
3191             LONGLONG *output,     /* O - array of converted pixels           */
3192             int *status)          /* IO - error status                       */
3193 /*
3194   Copy input to output following reading of the input from a FITS file.
3195   Check for null values and do datatype conversion and scaling if required.
3196   The nullcheck code value determines how any null values in the input array
3197   are treated.  A null value is an input pixel that is equal to tnull.  If
3198   nullcheck = 0, then no checking for nulls is performed and any null values
3199   will be transformed just like any other pixel.  If nullcheck = 1, then the
3200   output pixel will be set = nullval if the corresponding input pixel is null.
3201   If nullcheck = 2, then if the pixel is null then the corresponding value of
3202   nullarray will be set to 1; the value of nullarray for non-null pixels
3203   will = 0.  The anynull parameter will be set = 1 if any of the returned
3204   pixels are null, otherwise anynull will be returned with a value = 0;
3205 */
3206 {
3207     long ii;
3208     double dvalue;
3209     ULONGLONG ulltemp;
3210 
3211     if (nullcheck == 0)     /* no null checking required */
3212     {
3213         if (scale == 1. && zero ==  9223372036854775808.)
3214         {
3215             /* The column we read contains unsigned long long values. */
3216             /* Instead of adding 9223372036854775808, it is more efficient */
3217             /* and more precise to just flip the sign bit with the XOR operator */
3218 
3219             for (ii = 0; ii < ntodo; ii++) {
3220 
3221                 ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000);
3222 
3223                 if (ulltemp > LONGLONG_MAX)
3224                 {
3225                     *status = OVERFLOW_ERR;
3226                     output[ii] = LONGLONG_MAX;
3227                 }
3228                 else
3229 		{
3230                     output[ii] = (LONGLONG) ulltemp;
3231 		}
3232             }
3233         }
3234         else if (scale == 1. && zero == 0.)      /* no scaling */
3235         {
3236             for (ii = 0; ii < ntodo; ii++)
3237             {
3238                 output[ii] =  input[ii];   /* copy input to output */
3239             }
3240         }
3241         else             /* must scale the data */
3242         {
3243             for (ii = 0; ii < ntodo; ii++)
3244             {
3245                 dvalue = input[ii] * scale + zero;
3246 
3247                 if (dvalue < DLONGLONG_MIN)
3248                 {
3249                     *status = OVERFLOW_ERR;
3250                     output[ii] = LONGLONG_MIN;
3251                 }
3252                 else if (dvalue > DLONGLONG_MAX)
3253                 {
3254                     *status = OVERFLOW_ERR;
3255                     output[ii] = LONGLONG_MAX;
3256                 }
3257                 else
3258                     output[ii] = (LONGLONG) dvalue;
3259             }
3260         }
3261     }
3262     else        /* must check for null values */
3263     {
3264         if (scale == 1. && zero ==  9223372036854775808.)
3265         {
3266             /* The column we read contains unsigned long long values. */
3267             /* Instead of subtracting 9223372036854775808, it is more efficient */
3268             /* and more precise to just flip the sign bit with the XOR operator */
3269 
3270             for (ii = 0; ii < ntodo; ii++) {
3271                 if (input[ii] == tnull)
3272                 {
3273                     *anynull = 1;
3274                     if (nullcheck == 1)
3275                         output[ii] = nullval;
3276                     else
3277                         nullarray[ii] = 1;
3278                 }
3279                 else
3280 		{
3281                     ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000);
3282 
3283                     if (ulltemp > LONGLONG_MAX)
3284                     {
3285                         *status = OVERFLOW_ERR;
3286                         output[ii] = LONGLONG_MAX;
3287                     }
3288                     else
3289 		    {
3290                         output[ii] = (LONGLONG) ulltemp;
3291 		    }
3292                 }
3293             }
3294         }
3295         else if (scale == 1. && zero == 0.)  /* no scaling */
3296         {
3297             for (ii = 0; ii < ntodo; ii++)
3298             {
3299                 if (input[ii] == tnull)
3300                 {
3301                     *anynull = 1;
3302                     if (nullcheck == 1)
3303                         output[ii] = nullval;
3304                     else
3305                         nullarray[ii] = 1;
3306                 }
3307                 else
3308                     output[ii] = input[ii];
3309 
3310             }
3311         }
3312         else                  /* must scale the data */
3313         {
3314             for (ii = 0; ii < ntodo; ii++)
3315             {
3316                 if (input[ii] == tnull)
3317                 {
3318                     *anynull = 1;
3319                     if (nullcheck == 1)
3320                         output[ii] = nullval;
3321                     else
3322                         nullarray[ii] = 1;
3323                 }
3324                 else
3325                 {
3326                     dvalue = input[ii] * scale + zero;
3327 
3328                     if (dvalue < DLONGLONG_MIN)
3329                     {
3330                         *status = OVERFLOW_ERR;
3331                         output[ii] = LONGLONG_MIN;
3332                     }
3333                     else if (dvalue > DLONGLONG_MAX)
3334                     {
3335                         *status = OVERFLOW_ERR;
3336                         output[ii] = LONGLONG_MAX;
3337                     }
3338                     else
3339                         output[ii] = (LONGLONG) dvalue;
3340                 }
3341             }
3342         }
3343     }
3344     return(*status);
3345 }
3346 /*--------------------------------------------------------------------------*/
fffr4i8(float * input,long ntodo,double scale,double zero,int nullcheck,LONGLONG nullval,char * nullarray,int * anynull,LONGLONG * output,int * status)3347 int fffr4i8(float *input,         /* I - array of values to be converted     */
3348             long ntodo,           /* I - number of elements in the array     */
3349             double scale,         /* I - FITS TSCALn or BSCALE value         */
3350             double zero,          /* I - FITS TZEROn or BZERO  value         */
3351             int nullcheck,        /* I - null checking code; 0 = don't check */
3352                                   /*     1:set null pixels = nullval         */
3353                                   /*     2: if null pixel, set nullarray = 1 */
3354             LONGLONG nullval,     /* I - set null pixels, if nullcheck = 1   */
3355             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
3356             int  *anynull,        /* O - set to 1 if any pixels are null     */
3357             LONGLONG *output,     /* O - array of converted pixels           */
3358             int *status)          /* IO - error status                       */
3359 /*
3360   Copy input to output following reading of the input from a FITS file.
3361   Check for null values and do datatype conversion and scaling if required.
3362   The nullcheck code value determines how any null values in the input array
3363   are treated.  A null value is an input pixel that is equal to NaN.  If
3364   nullcheck = 0, then no checking for nulls is performed and any null values
3365   will be transformed just like any other pixel.  If nullcheck = 1, then the
3366   output pixel will be set = nullval if the corresponding input pixel is null.
3367   If nullcheck = 2, then if the pixel is null then the corresponding value of
3368   nullarray will be set to 1; the value of nullarray for non-null pixels
3369   will = 0.  The anynull parameter will be set = 1 if any of the returned
3370   pixels are null, otherwise anynull will be returned with a value = 0;
3371 */
3372 {
3373     long ii;
3374     double dvalue;
3375     short *sptr, iret;
3376 
3377     if (nullcheck == 0)     /* no null checking required */
3378     {
3379         if (scale == 1. && zero == 0.)      /* no scaling */
3380         {
3381             for (ii = 0; ii < ntodo; ii++)
3382             {
3383                 if (input[ii] < DLONGLONG_MIN)
3384                 {
3385                     *status = OVERFLOW_ERR;
3386                     output[ii] = LONGLONG_MIN;
3387                 }
3388                 else if (input[ii] > DLONGLONG_MAX)
3389                 {
3390                     *status = OVERFLOW_ERR;
3391                     output[ii] = LONGLONG_MAX;
3392                 }
3393                 else
3394                     output[ii] = (LONGLONG) input[ii];
3395             }
3396         }
3397         else             /* must scale the data */
3398         {
3399             for (ii = 0; ii < ntodo; ii++)
3400             {
3401                 dvalue = input[ii] * scale + zero;
3402 
3403                 if (dvalue < DLONGLONG_MIN)
3404                 {
3405                     *status = OVERFLOW_ERR;
3406                     output[ii] = LONGLONG_MIN;
3407                 }
3408                 else if (dvalue > DLONGLONG_MAX)
3409                 {
3410                     *status = OVERFLOW_ERR;
3411                     output[ii] = LONGLONG_MAX;
3412                 }
3413                 else
3414                     output[ii] = (LONGLONG) dvalue;
3415             }
3416         }
3417     }
3418     else        /* must check for null values */
3419     {
3420         sptr = (short *) input;
3421 
3422 #if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
3423         sptr++;       /* point to MSBs */
3424 #endif
3425 
3426         if (scale == 1. && zero == 0.)  /* no scaling */
3427         {
3428             for (ii = 0; ii < ntodo; ii++, sptr += 2)
3429             {
3430               if (0 != (iret = fnan(*sptr) ) )  /* test for NaN or underflow */
3431               {
3432                   if (iret == 1)  /* is it a NaN? */
3433                   {
3434                     *anynull = 1;
3435                     if (nullcheck == 1)
3436                         output[ii] = nullval;
3437                     else
3438                         nullarray[ii] = 1;
3439                   }
3440                   else            /* it's an underflow */
3441                      output[ii] = 0;
3442               }
3443               else
3444                 {
3445                     if (input[ii] < DLONGLONG_MIN)
3446                     {
3447                         *status = OVERFLOW_ERR;
3448                         output[ii] = LONGLONG_MIN;
3449                     }
3450                     else if (input[ii] > DLONGLONG_MAX)
3451                     {
3452                         *status = OVERFLOW_ERR;
3453                         output[ii] = LONGLONG_MAX;
3454                     }
3455                     else
3456                         output[ii] = (LONGLONG) input[ii];
3457                 }
3458             }
3459         }
3460         else                  /* must scale the data */
3461         {
3462             for (ii = 0; ii < ntodo; ii++, sptr += 2)
3463             {
3464               if (0 != (iret = fnan(*sptr) ) )  /* test for NaN or underflow */
3465               {
3466                   if (iret == 1)  /* is it a NaN? */
3467                   {
3468                     *anynull = 1;
3469                     if (nullcheck == 1)
3470                         output[ii] = nullval;
3471                     else
3472                         nullarray[ii] = 1;
3473                   }
3474                   else            /* it's an underflow */
3475                   {
3476                     if (zero < DLONGLONG_MIN)
3477                     {
3478                         *status = OVERFLOW_ERR;
3479                         output[ii] = LONGLONG_MIN;
3480                     }
3481                     else if (zero > DLONGLONG_MAX)
3482                     {
3483                         *status = OVERFLOW_ERR;
3484                         output[ii] = LONGLONG_MAX;
3485                     }
3486                     else
3487                         output[ii] = (LONGLONG) zero;
3488                   }
3489               }
3490               else
3491                 {
3492                     dvalue = input[ii] * scale + zero;
3493 
3494                     if (dvalue < DLONGLONG_MIN)
3495                     {
3496                         *status = OVERFLOW_ERR;
3497                         output[ii] = LONGLONG_MIN;
3498                     }
3499                     else if (dvalue > DLONGLONG_MAX)
3500                     {
3501                         *status = OVERFLOW_ERR;
3502                         output[ii] = LONGLONG_MAX;
3503                     }
3504                     else
3505                         output[ii] = (LONGLONG) dvalue;
3506                 }
3507             }
3508         }
3509     }
3510     return(*status);
3511 }
3512 /*--------------------------------------------------------------------------*/
fffr8i8(double * input,long ntodo,double scale,double zero,int nullcheck,LONGLONG nullval,char * nullarray,int * anynull,LONGLONG * output,int * status)3513 int fffr8i8(double *input,        /* I - array of values to be converted     */
3514             long ntodo,           /* I - number of elements in the array     */
3515             double scale,         /* I - FITS TSCALn or BSCALE value         */
3516             double zero,          /* I - FITS TZEROn or BZERO  value         */
3517             int nullcheck,        /* I - null checking code; 0 = don't check */
3518                                   /*     1:set null pixels = nullval         */
3519                                   /*     2: if null pixel, set nullarray = 1 */
3520             LONGLONG nullval,     /* I - set null pixels, if nullcheck = 1   */
3521             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
3522             int  *anynull,        /* O - set to 1 if any pixels are null     */
3523             LONGLONG *output,     /* O - array of converted pixels           */
3524             int *status)          /* IO - error status                       */
3525 /*
3526   Copy input to output following reading of the input from a FITS file.
3527   Check for null values and do datatype conversion and scaling if required.
3528   The nullcheck code value determines how any null values in the input array
3529   are treated.  A null value is an input pixel that is equal to NaN.  If
3530   nullcheck = 0, then no checking for nulls is performed and any null values
3531   will be transformed just like any other pixel.  If nullcheck = 1, then the
3532   output pixel will be set = nullval if the corresponding input pixel is null.
3533   If nullcheck = 2, then if the pixel is null then the corresponding value of
3534   nullarray will be set to 1; the value of nullarray for non-null pixels
3535   will = 0.  The anynull parameter will be set = 1 if any of the returned
3536   pixels are null, otherwise anynull will be returned with a value = 0;
3537 */
3538 {
3539     long ii;
3540     double dvalue;
3541     short *sptr, iret;
3542 
3543     if (nullcheck == 0)     /* no null checking required */
3544     {
3545         if (scale == 1. && zero == 0.)      /* no scaling */
3546         {
3547             for (ii = 0; ii < ntodo; ii++)
3548             {
3549                 if (input[ii] < DLONGLONG_MIN)
3550                 {
3551                     *status = OVERFLOW_ERR;
3552                     output[ii] = LONGLONG_MIN;
3553                 }
3554                 else if (input[ii] > DLONGLONG_MAX)
3555                 {
3556                     *status = OVERFLOW_ERR;
3557                     output[ii] = LONGLONG_MAX;
3558                 }
3559                 else
3560                     output[ii] = (LONGLONG) input[ii];
3561             }
3562         }
3563         else             /* must scale the data */
3564         {
3565             for (ii = 0; ii < ntodo; ii++)
3566             {
3567                 dvalue = input[ii] * scale + zero;
3568 
3569                 if (dvalue < DLONGLONG_MIN)
3570                 {
3571                     *status = OVERFLOW_ERR;
3572                     output[ii] = LONGLONG_MIN;
3573                 }
3574                 else if (dvalue > DLONGLONG_MAX)
3575                 {
3576                     *status = OVERFLOW_ERR;
3577                     output[ii] = LONGLONG_MAX;
3578                 }
3579                 else
3580                     output[ii] = (LONGLONG) dvalue;
3581             }
3582         }
3583     }
3584     else        /* must check for null values */
3585     {
3586         sptr = (short *) input;
3587 
3588 #if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
3589         sptr += 3;       /* point to MSBs */
3590 #endif
3591         if (scale == 1. && zero == 0.)  /* no scaling */
3592         {
3593             for (ii = 0; ii < ntodo; ii++, sptr += 4)
3594             {
3595               if (0 != (iret = dnan(*sptr)) )  /* test for NaN or underflow */
3596               {
3597                   if (iret == 1)  /* is it a NaN? */
3598                   {
3599                     *anynull = 1;
3600                     if (nullcheck == 1)
3601                         output[ii] = nullval;
3602                     else
3603                         nullarray[ii] = 1;
3604                   }
3605                   else            /* it's an underflow */
3606                      output[ii] = 0;
3607               }
3608               else
3609                 {
3610                     if (input[ii] < DLONGLONG_MIN)
3611                     {
3612                         *status = OVERFLOW_ERR;
3613                         output[ii] = LONGLONG_MIN;
3614                     }
3615                     else if (input[ii] > DLONGLONG_MAX)
3616                     {
3617                         *status = OVERFLOW_ERR;
3618                         output[ii] = LONGLONG_MAX;
3619                     }
3620                     else
3621                         output[ii] = (LONGLONG) input[ii];
3622                 }
3623             }
3624         }
3625         else                  /* must scale the data */
3626         {
3627             for (ii = 0; ii < ntodo; ii++, sptr += 4)
3628             {
3629               if (0 != (iret = dnan(*sptr)) )  /* test for NaN or underflow */
3630               {
3631                   if (iret == 1)  /* is it a NaN? */
3632                   {
3633                     *anynull = 1;
3634                     if (nullcheck == 1)
3635                         output[ii] = nullval;
3636                     else
3637                         nullarray[ii] = 1;
3638                   }
3639                   else            /* it's an underflow */
3640                   {
3641                     if (zero < DLONGLONG_MIN)
3642                     {
3643                         *status = OVERFLOW_ERR;
3644                         output[ii] = LONGLONG_MIN;
3645                     }
3646                     else if (zero > DLONGLONG_MAX)
3647                     {
3648                         *status = OVERFLOW_ERR;
3649                         output[ii] = LONGLONG_MAX;
3650                     }
3651                     else
3652                         output[ii] = (LONGLONG) zero;
3653                   }
3654               }
3655               else
3656                 {
3657                     dvalue = input[ii] * scale + zero;
3658 
3659                     if (dvalue < DLONGLONG_MIN)
3660                     {
3661                         *status = OVERFLOW_ERR;
3662                         output[ii] = LONGLONG_MIN;
3663                     }
3664                     else if (dvalue > DLONGLONG_MAX)
3665                     {
3666                         *status = OVERFLOW_ERR;
3667                         output[ii] = LONGLONG_MAX;
3668                     }
3669                     else
3670                         output[ii] = (LONGLONG) dvalue;
3671                 }
3672             }
3673         }
3674     }
3675     return(*status);
3676 }
3677 /*--------------------------------------------------------------------------*/
fffstri8(char * input,long ntodo,double scale,double zero,long twidth,double implipower,int nullcheck,char * snull,LONGLONG nullval,char * nullarray,int * anynull,LONGLONG * output,int * status)3678 int fffstri8(char *input,         /* I - array of values to be converted     */
3679             long ntodo,           /* I - number of elements in the array     */
3680             double scale,         /* I - FITS TSCALn or BSCALE value         */
3681             double zero,          /* I - FITS TZEROn or BZERO  value         */
3682             long twidth,          /* I - width of each substring of chars    */
3683             double implipower,    /* I - power of 10 of implied decimal      */
3684             int nullcheck,        /* I - null checking code; 0 = don't check */
3685                                   /*     1:set null pixels = nullval         */
3686                                   /*     2: if null pixel, set nullarray = 1 */
3687             char  *snull,         /* I - value of FITS null string, if any   */
3688             LONGLONG nullval,     /* I - set null pixels, if nullcheck = 1   */
3689             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
3690             int  *anynull,        /* O - set to 1 if any pixels are null     */
3691             LONGLONG *output,     /* O - array of converted pixels           */
3692             int *status)          /* IO - error status                       */
3693 /*
3694   Copy input to output following reading of the input from a FITS file. Check
3695   for null values and do scaling if required. The nullcheck code value
3696   determines how any null values in the input array are treated. A null
3697   value is an input pixel that is equal to snull.  If nullcheck= 0, then
3698   no special checking for nulls is performed.  If nullcheck = 1, then the
3699   output pixel will be set = nullval if the corresponding input pixel is null.
3700   If nullcheck = 2, then if the pixel is null then the corresponding value of
3701   nullarray will be set to 1; the value of nullarray for non-null pixels
3702   will = 0.  The anynull parameter will be set = 1 if any of the returned
3703   pixels are null, otherwise anynull will be returned with a value = 0;
3704 */
3705 {
3706     int nullen;
3707     long ii;
3708     double dvalue;
3709     char *cstring, message[FLEN_ERRMSG];
3710     char *cptr, *tpos;
3711     char tempstore, chrzero = '0';
3712     double val, power;
3713     int exponent, sign, esign, decpt;
3714 
3715     nullen = strlen(snull);
3716     cptr = input;  /* pointer to start of input string */
3717     for (ii = 0; ii < ntodo; ii++)
3718     {
3719       cstring = cptr;
3720       /* temporarily insert a null terminator at end of the string */
3721       tpos = cptr + twidth;
3722       tempstore = *tpos;
3723       *tpos = 0;
3724 
3725       /* check if null value is defined, and if the    */
3726       /* column string is identical to the null string */
3727       if (snull[0] != ASCII_NULL_UNDEFINED &&
3728          !strncmp(snull, cptr, nullen) )
3729       {
3730         if (nullcheck)
3731         {
3732           *anynull = 1;
3733           if (nullcheck == 1)
3734             output[ii] = nullval;
3735           else
3736             nullarray[ii] = 1;
3737         }
3738         cptr += twidth;
3739       }
3740       else
3741       {
3742         /* value is not the null value, so decode it */
3743         /* remove any embedded blank characters from the string */
3744 
3745         decpt = 0;
3746         sign = 1;
3747         val  = 0.;
3748         power = 1.;
3749         exponent = 0;
3750         esign = 1;
3751 
3752         while (*cptr == ' ')               /* skip leading blanks */
3753            cptr++;
3754 
3755         if (*cptr == '-' || *cptr == '+')  /* check for leading sign */
3756         {
3757           if (*cptr == '-')
3758              sign = -1;
3759 
3760           cptr++;
3761 
3762           while (*cptr == ' ')         /* skip blanks between sign and value */
3763             cptr++;
3764         }
3765 
3766         while (*cptr >= '0' && *cptr <= '9')
3767         {
3768           val = val * 10. + *cptr - chrzero;  /* accumulate the value */
3769           cptr++;
3770 
3771           while (*cptr == ' ')         /* skip embedded blanks in the value */
3772             cptr++;
3773         }
3774 
3775         if (*cptr == '.' || *cptr == ',')    /* check for decimal point */
3776         {
3777           decpt = 1;       /* set flag to show there was a decimal point */
3778           cptr++;
3779           while (*cptr == ' ')         /* skip any blanks */
3780             cptr++;
3781 
3782           while (*cptr >= '0' && *cptr <= '9')
3783           {
3784             val = val * 10. + *cptr - chrzero;  /* accumulate the value */
3785             power = power * 10.;
3786             cptr++;
3787 
3788             while (*cptr == ' ')         /* skip embedded blanks in the value */
3789               cptr++;
3790           }
3791         }
3792 
3793         if (*cptr == 'E' || *cptr == 'D')  /* check for exponent */
3794         {
3795           cptr++;
3796           while (*cptr == ' ')         /* skip blanks */
3797               cptr++;
3798 
3799           if (*cptr == '-' || *cptr == '+')  /* check for exponent sign */
3800           {
3801             if (*cptr == '-')
3802                esign = -1;
3803 
3804             cptr++;
3805 
3806             while (*cptr == ' ')        /* skip blanks between sign and exp */
3807               cptr++;
3808           }
3809 
3810           while (*cptr >= '0' && *cptr <= '9')
3811           {
3812             exponent = exponent * 10 + *cptr - chrzero;  /* accumulate exp */
3813             cptr++;
3814 
3815             while (*cptr == ' ')         /* skip embedded blanks */
3816               cptr++;
3817           }
3818         }
3819 
3820         if (*cptr  != 0)  /* should end up at the null terminator */
3821         {
3822           snprintf(message, FLEN_ERRMSG, "Cannot read number from ASCII table");
3823           ffpmsg(message);
3824           snprintf(message, FLEN_ERRMSG,"Column field = %s.", cstring);
3825           ffpmsg(message);
3826           /* restore the char that was overwritten by the null */
3827           *tpos = tempstore;
3828           return(*status = BAD_C2D);
3829         }
3830 
3831         if (!decpt)  /* if no explicit decimal, use implied */
3832            power = implipower;
3833 
3834         dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
3835 
3836         dvalue = dvalue * scale + zero;   /* apply the scaling */
3837 
3838         if (dvalue < DLONGLONG_MIN)
3839         {
3840             *status = OVERFLOW_ERR;
3841             output[ii] = LONGLONG_MIN;
3842         }
3843         else if (dvalue > DLONGLONG_MAX)
3844         {
3845             *status = OVERFLOW_ERR;
3846             output[ii] = LONGLONG_MAX;
3847         }
3848         else
3849             output[ii] = (LONGLONG) dvalue;
3850       }
3851       /* restore the char that was overwritten by the null */
3852       *tpos = tempstore;
3853     }
3854     return(*status);
3855 }
3856