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