1 /*  This file, getcoli.c, contains routines that read data elements from   */
2 /*  a FITS image or table, with short datatype.                            */
3 
4 /*  The FITSIO software was written by William Pence at the High Energy    */
5 /*  Astrophysic Science Archive Research Center (HEASARC) at the NASA      */
6 /*  Goddard Space Flight Center.                                           */
7 
8 #include <math.h>
9 #include <stdlib.h>
10 #include <limits.h>
11 #include <string.h>
12 #include "fitsio2.h"
13 
14 /*--------------------------------------------------------------------------*/
ffgpvi(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,short nulval,short * array,int * anynul,int * status)15 int ffgpvi( 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             short nulval,     /* I - value for undefined pixels              */
20             short *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     short 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         fits_read_compressed_pixels(fptr, TSHORT, firstelem, nelem,
42             nullcheck, &nullvalue, array, NULL, anynul, status);
43         return(*status);
44     }
45     /*
46       the primary array is represented as a binary table:
47       each group of the primary array is a row in the table,
48       where the first column contains the group parameters
49       and the second column contains the image itself.
50     */
51 
52     row=maxvalue(1,group);
53 
54     ffgcli(fptr, 2, row, firstelem, nelem, 1, 1, nulval,
55                array, &cdummy, anynul, status);
56     return(*status);
57 }
58 /*--------------------------------------------------------------------------*/
ffgpfi(fitsfile * fptr,long group,LONGLONG firstelem,LONGLONG nelem,short * array,char * nularray,int * anynul,int * status)59 int ffgpfi( fitsfile *fptr,   /* I - FITS file pointer                       */
60             long  group,      /* I - group to read (1 = 1st group)           */
61             LONGLONG  firstelem,  /* I - first vector element to read (1 = 1st)  */
62             LONGLONG  nelem,      /* I - number of values to read                */
63             short *array,     /* O - array of values that are returned       */
64             char *nularray,   /* O - array of null pixel flags               */
65             int  *anynul,     /* O - set to 1 if any values are null; else 0 */
66             int  *status)     /* IO - error status                           */
67 /*
68   Read an array of values from the primary array. Data conversion
69   and scaling will be performed if necessary (e.g, if the datatype of
70   the FITS array is not the same as the array being read).
71   Any undefined pixels in the returned array will be set = 0 and the
72   corresponding nularray value will be set = 1.
73   ANYNUL is returned with a value of .true. if any pixels are undefined.
74 */
75 {
76     long row;
77     int nullcheck = 2;
78 
79     if (fits_is_compressed_image(fptr, status))
80     {
81         /* this is a compressed image in a binary table */
82 
83         fits_read_compressed_pixels(fptr, TSHORT, firstelem, nelem,
84             nullcheck, NULL, array, nularray, anynul, status);
85         return(*status);
86     }
87 
88     /*
89       the primary array is represented as a binary table:
90       each group of the primary array is a row in the table,
91       where the first column contains the group parameters
92       and the second column contains the image itself.
93     */
94 
95     row=maxvalue(1,group);
96 
97     ffgcli(fptr, 2, row, firstelem, nelem, 1, 2, 0,
98                array, nularray, anynul, status);
99     return(*status);
100 }
101 /*--------------------------------------------------------------------------*/
ffg2di(fitsfile * fptr,long group,short nulval,LONGLONG ncols,LONGLONG naxis1,LONGLONG naxis2,short * array,int * anynul,int * status)102 int ffg2di(fitsfile *fptr,  /* I - FITS file pointer                       */
103            long  group,     /* I - group to read (1 = 1st group)           */
104            short nulval,    /* set undefined pixels equal to this          */
105            LONGLONG  ncols,     /* I - number of pixels in each row of array   */
106            LONGLONG  naxis1,    /* I - FITS image NAXIS1 value                 */
107            LONGLONG  naxis2,    /* I - FITS image NAXIS2 value                 */
108            short *array,    /* O - array to be filled and returned         */
109            int  *anynul,    /* O - set to 1 if any values are null; else 0 */
110            int  *status)    /* IO - error status                           */
111 /*
112   Read an entire 2-D array of values to the primary array. Data conversion
113   and scaling will be performed if necessary (e.g, if the datatype of the
114   FITS array is not the same as the array being read).  Any null
115   values in the array will be set equal to the value of nulval, unless
116   nulval = 0 in which case no null checking will be performed.
117 */
118 {
119     /* call the 3D reading routine, with the 3rd dimension = 1 */
120 
121     ffg3di(fptr, group, nulval, ncols, naxis2, naxis1, naxis2, 1, array,
122            anynul, status);
123 
124     return(*status);
125 }
126 /*--------------------------------------------------------------------------*/
ffg3di(fitsfile * fptr,long group,short nulval,LONGLONG ncols,LONGLONG nrows,LONGLONG naxis1,LONGLONG naxis2,LONGLONG naxis3,short * array,int * anynul,int * status)127 int ffg3di(fitsfile *fptr,  /* I - FITS file pointer                       */
128            long  group,     /* I - group to read (1 = 1st group)           */
129            short nulval,    /* set undefined pixels equal to this          */
130            LONGLONG  ncols,     /* I - number of pixels in each row of array   */
131            LONGLONG  nrows,     /* I - number of rows in each plane of array   */
132            LONGLONG  naxis1,    /* I - FITS image NAXIS1 value                 */
133            LONGLONG  naxis2,    /* I - FITS image NAXIS2 value                 */
134            LONGLONG  naxis3,    /* I - FITS image NAXIS3 value                 */
135            short *array,    /* O - array to be filled and returned         */
136            int  *anynul,    /* O - set to 1 if any values are null; else 0 */
137            int  *status)    /* IO - error status                           */
138 /*
139   Read an entire 3-D array of values to the primary array. Data conversion
140   and scaling will be performed if necessary (e.g, if the datatype of the
141   FITS array is not the same as the array being read).  Any null
142   values in the array will be set equal to the value of nulval, unless
143   nulval = 0 in which case no null checking will be performed.
144 */
145 {
146     long tablerow, ii, jj;
147     LONGLONG nfits, narray;
148     char cdummy;
149     int nullcheck = 1;
150     long inc[] = {1,1,1};
151     LONGLONG fpixel[] = {1,1,1};
152     LONGLONG lpixel[3];
153     short 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, TSHORT, 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        ffgcli(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 (ffgcli(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 /*--------------------------------------------------------------------------*/
ffgsvi(fitsfile * fptr,int colnum,int naxis,long * naxes,long * blc,long * trc,long * inc,short nulval,short * array,int * anynul,int * status)212 int ffgsvi(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            short nulval,   /* I - value to set undefined pixels             */
220            short *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     short nullvalue;
236 
237     if (naxis < 1 || naxis > 9)
238     {
239         snprintf(msg,FLEN_ERRMSG, "NAXIS = %d in call to ffgsvi 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, TSHORT, blcll, trcll, inc,
256             nullcheck, &nullvalue, array, NULL, anynul, status);
257 
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,"ffgsvi: 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 ( ffgcli(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 /*--------------------------------------------------------------------------*/
ffgsfi(fitsfile * fptr,int colnum,int naxis,long * naxes,long * blc,long * trc,long * inc,short * array,char * flagval,int * anynul,int * status)390 int ffgsfi(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            short *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     short 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 ffgsvi 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, TSHORT, 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,"ffgsvi: 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 ( ffgcli(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 /*--------------------------------------------------------------------------*/
ffggpi(fitsfile * fptr,long group,long firstelem,long nelem,short * array,int * status)554 int ffggpi( 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             short *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     ffgcli(fptr, 1, row, firstelem, nelem, 1, 1, 0,
579                array, &cdummy, &idummy, status);
580     return(*status);
581 }
582 /*--------------------------------------------------------------------------*/
ffgcvi(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,short nulval,short * array,int * anynul,int * status)583 int ffgcvi(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            short nulval,     /* I - value for null pixels                   */
589            short *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     ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 1, nulval,
604            array, &cdummy, anynul, status);
605     return(*status);
606 }
607 /*--------------------------------------------------------------------------*/
ffgcfi(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,short * array,char * nularray,int * anynul,int * status)608 int ffgcfi(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            short *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     short dummy = 0;
627 
628     ffgcli(fptr, colnum, firstrow, firstelem, nelem, 1, 2, dummy,
629            array, nularray, anynul, status);
630     return(*status);
631 }
632 /*--------------------------------------------------------------------------*/
ffgcli(fitsfile * fptr,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,long elemincre,int nultyp,short nulval,short * array,char * nularray,int * anynul,int * status)633 int ffgcli( 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             short nulval,     /* I - value for null pixels if nultyp = 1     */
643             short *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, maxelem2, hdutype, xcode, decimals;
663     long twidth, incre;
664     long ii, xwidth, ntodo;
665     int convert, nulcheck, readcheck = 0;
666     LONGLONG repeat, startpos, elemnum, readptr, tnull;
667     LONGLONG rowlen, rownum, remain, next, rowincre, maxelem;
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     if (*status > 0 || nelem == 0)  /* inherit input status value if > 0 */
676         return(*status);
677 
678     buffer = cbuff;
679 
680     if (anynul)
681         *anynul = 0;
682 
683     if (nultyp == 2)
684         memset(nularray, 0, (size_t) nelem);   /* initialize nullarray */
685 
686     /*---------------------------------------------------*/
687     /*  Check input and get parameters about the column: */
688     /*---------------------------------------------------*/
689     if (elemincre < 0)
690         readcheck = -1;  /* don't do range checking in this case */
691 
692     if ( ffgcprll( fptr, colnum, firstrow, firstelem, nelem, readcheck, &scale, &zero,
693          tform, &twidth, &tcode, &maxelem2, &startpos, &elemnum, &incre,
694          &repeat, &rowlen, &hdutype, &tnull, snull, status) > 0 )
695          return(*status);
696     maxelem = maxelem2;
697 
698     incre *= elemincre;   /* multiply incre to just get every nth pixel */
699 
700     if (tcode == TSTRING)    /* setup for ASCII tables */
701     {
702       /* get the number of implied decimal places if no explicit decmal point */
703       ffasfm(tform, &xcode, &xwidth, &decimals, status);
704       for(ii = 0; ii < decimals; ii++)
705         power *= 10.;
706     }
707     /*------------------------------------------------------------------*/
708     /*  Decide whether to check for null values in the input FITS file: */
709     /*------------------------------------------------------------------*/
710     nulcheck = nultyp; /* by default check for null values in the FITS file */
711 
712     if (nultyp == 1 && nulval == 0)
713        nulcheck = 0;    /* calling routine does not want to check for nulls */
714 
715     else if (tcode%10 == 1 &&        /* if reading an integer column, and  */
716             tnull == NULL_UNDEFINED) /* if a null value is not defined,    */
717             nulcheck = 0;            /* then do not check for null values. */
718 
719     else if (tcode == TSHORT && (tnull > SHRT_MAX || tnull < SHRT_MIN) )
720             nulcheck = 0;            /* Impossible null value */
721 
722     else if (tcode == TBYTE && (tnull > 255 || tnull < 0) )
723             nulcheck = 0;            /* Impossible null value */
724 
725     else if (tcode == TSTRING && snull[0] == ASCII_NULL_UNDEFINED)
726          nulcheck = 0;
727 
728     /*----------------------------------------------------------------------*/
729     /*  If FITS column and output data array have same datatype, then we do */
730     /*  not need to use a temporary buffer to store intermediate datatype.  */
731     /*----------------------------------------------------------------------*/
732     convert = 1;
733     if (tcode == TSHORT) /* Special Case:                        */
734     {                             /* no type convertion required, so read */
735                                   /* data directly into output buffer.    */
736 
737         if (nelem < (LONGLONG)INT32_MAX/2) {
738             maxelem = nelem;
739         } else {
740             maxelem = INT32_MAX/2;
741         }
742 
743         if (nulcheck == 0 && scale == 1. && zero == 0.)
744             convert = 0;  /* no need to scale data or find nulls */
745     }
746 
747     /*---------------------------------------------------------------------*/
748     /*  Now read the pixels from the FITS column. If the column does not   */
749     /*  have the same datatype as the output array, then we have to read   */
750     /*  the raw values into a temporary buffer (of limited size).  In      */
751     /*  the case of a vector colum read only 1 vector of values at a time  */
752     /*  then skip to the next row if more values need to be read.          */
753     /*  After reading the raw values, then call the fffXXYY routine to (1) */
754     /*  test for undefined values, (2) convert the datatype if necessary,  */
755     /*  and (3) scale the values by the FITS TSCALn and TZEROn linear      */
756     /*  scaling parameters.                                                */
757     /*---------------------------------------------------------------------*/
758     remain = nelem;           /* remaining number of values to read */
759     next = 0;                 /* next element in array to be read   */
760     rownum = 0;               /* row number, relative to firstrow   */
761 
762     while (remain)
763     {
764         /* limit the number of pixels to read at one time to the number that
765            will fit in the buffer or to the number of pixels that remain in
766            the current vector, which ever is smaller.
767         */
768         ntodo = (long) minvalue(remain, maxelem);
769         if (elemincre >= 0)
770         {
771           ntodo = (long) minvalue(ntodo, ((repeat - elemnum - 1)/elemincre +1));
772         }
773         else
774         {
775           ntodo = (long) minvalue(ntodo, (elemnum/(-elemincre) +1));
776         }
777 
778         readptr = startpos + ((LONGLONG)rownum * rowlen) + (elemnum * (incre / elemincre));
779 
780         switch (tcode)
781         {
782             case (TSHORT):
783                 ffgi2b(fptr, readptr, ntodo, incre, &array[next], status);
784                 if (convert)
785                     fffi2i2(&array[next], ntodo, scale, zero, nulcheck,
786                            (short) tnull, nulval, &nularray[next], anynul,
787                            &array[next], status);
788                 break;
789             case (TLONGLONG):
790 
791                 ffgi8b(fptr, readptr, ntodo, incre, (long *) buffer, status);
792                 fffi8i2( (LONGLONG *) buffer, ntodo, scale, zero,
793                            nulcheck, tnull, nulval, &nularray[next],
794                             anynul, &array[next], status);
795                 break;
796             case (TBYTE):
797                 ffgi1b(fptr, readptr, ntodo, incre, (unsigned char *) buffer,
798                       status);
799                 fffi1i2((unsigned char *) buffer, ntodo, scale, zero, nulcheck,
800                     (unsigned char) tnull, nulval, &nularray[next], anynul,
801                     &array[next], status);
802                 break;
803             case (TLONG):
804                 ffgi4b(fptr, readptr, ntodo, incre, (INT32BIT *) buffer,
805                        status);
806                 fffi4i2((INT32BIT *) buffer, ntodo, scale, zero, nulcheck,
807                        (INT32BIT) tnull, nulval, &nularray[next], anynul,
808                        &array[next], status);
809                 break;
810             case (TFLOAT):
811                 ffgr4b(fptr, readptr, ntodo, incre, (float  *) buffer, status);
812                 fffr4i2((float  *) buffer, ntodo, scale, zero, nulcheck,
813                        nulval, &nularray[next], anynul,
814                        &array[next], status);
815                 break;
816             case (TDOUBLE):
817                 ffgr8b(fptr, readptr, ntodo, incre, (double *) buffer, status);
818                 fffr8i2((double *) buffer, ntodo, scale, zero, nulcheck,
819                           nulval, &nularray[next], anynul,
820                           &array[next], status);
821                 break;
822             case (TSTRING):
823                 ffmbyt(fptr, readptr, REPORT_EOF, status);
824 
825                 if (incre == twidth)    /* contiguous bytes */
826                      ffgbyt(fptr, ntodo * twidth, buffer, status);
827                 else
828                      ffgbytoff(fptr, twidth, ntodo, incre - twidth, buffer,
829                                status);
830 
831                 fffstri2((char *) buffer, ntodo, scale, zero, twidth, power,
832                      nulcheck, snull, nulval, &nularray[next], anynul,
833                      &array[next], status);
834                 break;
835 
836             default:  /*  error trap for invalid column format */
837                 snprintf(message, FLEN_ERRMSG,
838                    "Cannot read numbers from column %d which has format %s",
839                     colnum, tform);
840                 ffpmsg(message);
841                 if (hdutype == ASCII_TBL)
842                     return(*status = BAD_ATABLE_FORMAT);
843                 else
844                     return(*status = BAD_BTABLE_FORMAT);
845 
846         } /* End of switch block */
847 
848         /*-------------------------*/
849         /*  Check for fatal error  */
850         /*-------------------------*/
851         if (*status > 0)  /* test for error during previous read operation */
852         {
853 	  dtemp = (double) next;
854           if (hdutype > 0)
855             snprintf(message,FLEN_ERRMSG,
856             "Error reading elements %.0f thru %.0f from column %d (ffgcli).",
857               dtemp+1, dtemp+ntodo, colnum);
858           else
859             snprintf(message,FLEN_ERRMSG,
860             "Error reading elements %.0f thru %.0f from image (ffgcli).",
861               dtemp+1, dtemp+ntodo);
862 
863           ffpmsg(message);
864           return(*status);
865         }
866 
867         /*--------------------------------------------*/
868         /*  increment the counters for the next loop  */
869         /*--------------------------------------------*/
870         remain -= ntodo;
871         if (remain)
872         {
873             next += ntodo;
874             elemnum = elemnum + (ntodo * elemincre);
875 
876             if (elemnum >= repeat)  /* completed a row; start on later row */
877             {
878                 rowincre = elemnum / repeat;
879                 rownum += rowincre;
880                 elemnum = elemnum - (rowincre * repeat);
881             }
882             else if (elemnum < 0) /* completed a row; start on a previous row */
883             {
884                 rowincre = (-elemnum - 1) / repeat + 1;
885                 rownum -= rowincre;
886                 elemnum = (rowincre * repeat) + elemnum;
887             }
888         }
889     }  /*  End of main while Loop  */
890 
891 
892     /*--------------------------------*/
893     /*  check for numerical overflow  */
894     /*--------------------------------*/
895     if (*status == OVERFLOW_ERR)
896     {
897         ffpmsg(
898         "Numerical overflow during type conversion while reading FITS data.");
899         *status = NUM_OVERFLOW;
900     }
901 
902     return(*status);
903 }
904 /*--------------------------------------------------------------------------*/
fffi1i2(unsigned char * input,long ntodo,double scale,double zero,int nullcheck,unsigned char tnull,short nullval,char * nullarray,int * anynull,short * output,int * status)905 int fffi1i2(unsigned char *input, /* I - array of values to be converted     */
906             long ntodo,           /* I - number of elements in the array     */
907             double scale,         /* I - FITS TSCALn or BSCALE value         */
908             double zero,          /* I - FITS TZEROn or BZERO  value         */
909             int nullcheck,        /* I - null checking code; 0 = don't check */
910                                   /*     1:set null pixels = nullval         */
911                                   /*     2: if null pixel, set nullarray = 1 */
912             unsigned char tnull,  /* I - value of FITS TNULLn keyword if any */
913             short nullval,        /* I - set null pixels, if nullcheck = 1   */
914             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
915             int  *anynull,        /* O - set to 1 if any pixels are null     */
916             short *output,        /* O - array of converted pixels           */
917             int *status)          /* IO - error status                       */
918 /*
919   Copy input to output following reading of the input from a FITS file.
920   Check for null values and do datatype conversion and scaling if required.
921   The nullcheck code value determines how any null values in the input array
922   are treated.  A null value is an input pixel that is equal to tnull.  If
923   nullcheck = 0, then no checking for nulls is performed and any null values
924   will be transformed just like any other pixel.  If nullcheck = 1, then the
925   output pixel will be set = nullval if the corresponding input pixel is null.
926   If nullcheck = 2, then if the pixel is null then the corresponding value of
927   nullarray will be set to 1; the value of nullarray for non-null pixels
928   will = 0.  The anynull parameter will be set = 1 if any of the returned
929   pixels are null, otherwise anynull will be returned with a value = 0;
930 */
931 {
932     long ii;
933     double dvalue;
934 
935     if (nullcheck == 0)     /* no null checking required */
936     {
937         if (scale == 1. && zero == 0.)      /* no scaling */
938         {
939             for (ii = 0; ii < ntodo; ii++)
940                 output[ii] = (short) input[ii];  /* copy input to output */
941         }
942         else             /* must scale the data */
943         {
944             for (ii = 0; ii < ntodo; ii++)
945             {
946                 dvalue = input[ii] * scale + zero;
947 
948                 if (dvalue < DSHRT_MIN)
949                 {
950                     *status = OVERFLOW_ERR;
951                     output[ii] = SHRT_MIN;
952                 }
953                 else if (dvalue > DSHRT_MAX)
954                 {
955                     *status = OVERFLOW_ERR;
956                     output[ii] = SHRT_MAX;
957                 }
958                 else
959                     output[ii] = (short) dvalue;
960             }
961         }
962     }
963     else        /* must check for null values */
964     {
965         if (scale == 1. && zero == 0.)  /* no scaling */
966         {
967             for (ii = 0; ii < ntodo; ii++)
968             {
969                 if (input[ii] == tnull)
970                 {
971                     *anynull = 1;
972                     if (nullcheck == 1)
973                         output[ii] = nullval;
974                     else
975                         nullarray[ii] = 1;
976                 }
977                 else
978                     output[ii] = (short) input[ii];
979             }
980         }
981         else                  /* must scale the data */
982         {
983             for (ii = 0; ii < ntodo; ii++)
984             {
985                 if (input[ii] == tnull)
986                 {
987                     *anynull = 1;
988                     if (nullcheck == 1)
989                         output[ii] = nullval;
990                     else
991                         nullarray[ii] = 1;
992                 }
993                 else
994                 {
995                     dvalue = input[ii] * scale + zero;
996 
997                     if (dvalue < DSHRT_MIN)
998                     {
999                         *status = OVERFLOW_ERR;
1000                         output[ii] = SHRT_MIN;
1001                     }
1002                     else if (dvalue > DSHRT_MAX)
1003                     {
1004                         *status = OVERFLOW_ERR;
1005                         output[ii] = SHRT_MAX;
1006                     }
1007                     else
1008                         output[ii] = (short) dvalue;
1009                 }
1010             }
1011         }
1012     }
1013     return(*status);
1014 }
1015 /*--------------------------------------------------------------------------*/
fffi2i2(short * input,long ntodo,double scale,double zero,int nullcheck,short tnull,short nullval,char * nullarray,int * anynull,short * output,int * status)1016 int fffi2i2(short *input,         /* I - array of values to be converted     */
1017             long ntodo,           /* I - number of elements in the array     */
1018             double scale,         /* I - FITS TSCALn or BSCALE value         */
1019             double zero,          /* I - FITS TZEROn or BZERO  value         */
1020             int nullcheck,        /* I - null checking code; 0 = don't check */
1021                                   /*     1:set null pixels = nullval         */
1022                                   /*     2: if null pixel, set nullarray = 1 */
1023             short tnull,          /* I - value of FITS TNULLn keyword if any */
1024             short nullval,        /* I - set null pixels, if nullcheck = 1   */
1025             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1026             int  *anynull,        /* O - set to 1 if any pixels are null     */
1027             short *output,        /* O - array of converted pixels           */
1028             int *status)          /* IO - error status                       */
1029 /*
1030   Copy input to output following reading of the input from a FITS file.
1031   Check for null values and do datatype conversion and scaling if required.
1032   The nullcheck code value determines how any null values in the input array
1033   are treated.  A null value is an input pixel that is equal to tnull.  If
1034   nullcheck = 0, then no checking for nulls is performed and any null values
1035   will be transformed just like any other pixel.  If nullcheck = 1, then the
1036   output pixel will be set = nullval if the corresponding input pixel is null.
1037   If nullcheck = 2, then if the pixel is null then the corresponding value of
1038   nullarray will be set to 1; the value of nullarray for non-null pixels
1039   will = 0.  The anynull parameter will be set = 1 if any of the returned
1040   pixels are null, otherwise anynull will be returned with a value = 0;
1041 */
1042 {
1043     long ii;
1044     double dvalue;
1045 
1046     if (nullcheck == 0)     /* no null checking required */
1047     {
1048         if (scale == 1. && zero == 0.)      /* no scaling */
1049         {
1050             memmove(output, input, ntodo * sizeof(short) );
1051         }
1052         else             /* must scale the data */
1053         {
1054             for (ii = 0; ii < ntodo; ii++)
1055             {
1056                 dvalue = input[ii] * scale + zero;
1057 
1058                 if (dvalue < DSHRT_MIN)
1059                 {
1060                     *status = OVERFLOW_ERR;
1061                     output[ii] = SHRT_MIN;
1062                 }
1063                 else if (dvalue > DSHRT_MAX)
1064                 {
1065                     *status = OVERFLOW_ERR;
1066                     output[ii] = SHRT_MAX;
1067                 }
1068                 else
1069                     output[ii] = (short) dvalue;
1070             }
1071         }
1072     }
1073     else        /* must check for null values */
1074     {
1075         if (scale == 1. && zero == 0.)  /* no scaling */
1076         {
1077             for (ii = 0; ii < ntodo; ii++)
1078             {
1079                 if (input[ii] == tnull)
1080                 {
1081                     *anynull = 1;
1082                     if (nullcheck == 1)
1083                         output[ii] = nullval;
1084                     else
1085                         nullarray[ii] = 1;
1086                 }
1087                 else
1088                     output[ii] = input[ii];
1089             }
1090         }
1091         else                  /* must scale the data */
1092         {
1093             for (ii = 0; ii < ntodo; ii++)
1094             {
1095                 if (input[ii] == tnull)
1096                 {
1097                     *anynull = 1;
1098                     if (nullcheck == 1)
1099                         output[ii] = nullval;
1100                     else
1101                         nullarray[ii] = 1;
1102                 }
1103                 else
1104                 {
1105                     dvalue = input[ii] * scale + zero;
1106 
1107                     if (dvalue < DSHRT_MIN)
1108                     {
1109                         *status = OVERFLOW_ERR;
1110                         output[ii] = SHRT_MIN;
1111                     }
1112                     else if (dvalue > DSHRT_MAX)
1113                     {
1114                         *status = OVERFLOW_ERR;
1115                         output[ii] = SHRT_MAX;
1116                     }
1117                     else
1118                         output[ii] = (short) dvalue;
1119                 }
1120             }
1121         }
1122     }
1123     return(*status);
1124 }
1125 /*--------------------------------------------------------------------------*/
fffi4i2(INT32BIT * input,long ntodo,double scale,double zero,int nullcheck,INT32BIT tnull,short nullval,char * nullarray,int * anynull,short * output,int * status)1126 int fffi4i2(INT32BIT *input,      /* I - array of values to be converted     */
1127             long ntodo,           /* I - number of elements in the array     */
1128             double scale,         /* I - FITS TSCALn or BSCALE value         */
1129             double zero,          /* I - FITS TZEROn or BZERO  value         */
1130             int nullcheck,        /* I - null checking code; 0 = don't check */
1131                                   /*     1:set null pixels = nullval         */
1132                                   /*     2: if null pixel, set nullarray = 1 */
1133             INT32BIT tnull,       /* I - value of FITS TNULLn keyword if any */
1134             short nullval,        /* I - set null pixels, if nullcheck = 1   */
1135             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1136             int  *anynull,        /* O - set to 1 if any pixels are null     */
1137             short *output,        /* O - array of converted pixels           */
1138             int *status)          /* IO - error status                       */
1139 /*
1140   Copy input to output following reading of the input from a FITS file.
1141   Check for null values and do datatype conversion and scaling if required.
1142   The nullcheck code value determines how any null values in the input array
1143   are treated.  A null value is an input pixel that is equal to tnull.  If
1144   nullcheck = 0, then no checking for nulls is performed and any null values
1145   will be transformed just like any other pixel.  If nullcheck = 1, then the
1146   output pixel will be set = nullval if the corresponding input pixel is null.
1147   If nullcheck = 2, then if the pixel is null then the corresponding value of
1148   nullarray will be set to 1; the value of nullarray for non-null pixels
1149   will = 0.  The anynull parameter will be set = 1 if any of the returned
1150   pixels are null, otherwise anynull will be returned with a value = 0;
1151 */
1152 {
1153     long ii;
1154     double dvalue;
1155 
1156     if (nullcheck == 0)     /* no null checking required */
1157     {
1158         if (scale == 1. && zero == 0.)      /* no scaling */
1159         {
1160             for (ii = 0; ii < ntodo; ii++)
1161             {
1162                 if (input[ii] < SHRT_MIN)
1163                 {
1164                     *status = OVERFLOW_ERR;
1165                     output[ii] = SHRT_MIN;
1166                 }
1167                 else if (input[ii] > SHRT_MAX)
1168                 {
1169                     *status = OVERFLOW_ERR;
1170                     output[ii] = SHRT_MAX;
1171                 }
1172                 else
1173                     output[ii] = (short) input[ii];
1174             }
1175         }
1176         else             /* must scale the data */
1177         {
1178             for (ii = 0; ii < ntodo; ii++)
1179             {
1180                 dvalue = input[ii] * scale + zero;
1181 
1182                 if (dvalue < DSHRT_MIN)
1183                 {
1184                     *status = OVERFLOW_ERR;
1185                     output[ii] = SHRT_MIN;
1186                 }
1187                 else if (dvalue > DSHRT_MAX)
1188                 {
1189                     *status = OVERFLOW_ERR;
1190                     output[ii] = SHRT_MAX;
1191                 }
1192                 else
1193                     output[ii] = (short) dvalue;
1194             }
1195         }
1196     }
1197     else        /* must check for null values */
1198     {
1199         if (scale == 1. && zero == 0.)  /* no scaling */
1200         {
1201             for (ii = 0; ii < ntodo; ii++)
1202             {
1203                 if (input[ii] == tnull)
1204                 {
1205                     *anynull = 1;
1206                     if (nullcheck == 1)
1207                         output[ii] = nullval;
1208                     else
1209                         nullarray[ii] = 1;
1210                 }
1211                 else
1212                 {
1213                     if (input[ii] < SHRT_MIN)
1214                     {
1215                         *status = OVERFLOW_ERR;
1216                         output[ii] = SHRT_MIN;
1217                     }
1218                     else if (input[ii] > SHRT_MAX)
1219                     {
1220                         *status = OVERFLOW_ERR;
1221                         output[ii] = SHRT_MAX;
1222                     }
1223                     else
1224                         output[ii] = (short) input[ii];
1225                 }
1226             }
1227         }
1228         else                  /* must scale the data */
1229         {
1230             for (ii = 0; ii < ntodo; ii++)
1231             {
1232                 if (input[ii] == tnull)
1233                 {
1234                     *anynull = 1;
1235                     if (nullcheck == 1)
1236                         output[ii] = nullval;
1237                     else
1238                         nullarray[ii] = 1;
1239                 }
1240                 else
1241                 {
1242                     dvalue = input[ii] * scale + zero;
1243 
1244                     if (dvalue < DSHRT_MIN)
1245                     {
1246                         *status = OVERFLOW_ERR;
1247                         output[ii] = SHRT_MIN;
1248                     }
1249                     else if (dvalue > DSHRT_MAX)
1250                     {
1251                         *status = OVERFLOW_ERR;
1252                         output[ii] = SHRT_MAX;
1253                     }
1254                     else
1255                         output[ii] = (short) dvalue;
1256                 }
1257             }
1258         }
1259     }
1260     return(*status);
1261 }
1262 /*--------------------------------------------------------------------------*/
fffi8i2(LONGLONG * input,long ntodo,double scale,double zero,int nullcheck,LONGLONG tnull,short nullval,char * nullarray,int * anynull,short * output,int * status)1263 int fffi8i2(LONGLONG *input,      /* I - array of values to be converted     */
1264             long ntodo,           /* I - number of elements in the array     */
1265             double scale,         /* I - FITS TSCALn or BSCALE value         */
1266             double zero,          /* I - FITS TZEROn or BZERO  value         */
1267             int nullcheck,        /* I - null checking code; 0 = don't check */
1268                                   /*     1:set null pixels = nullval         */
1269                                   /*     2: if null pixel, set nullarray = 1 */
1270             LONGLONG tnull,       /* I - value of FITS TNULLn keyword if any */
1271             short nullval,        /* I - set null pixels, if nullcheck = 1   */
1272             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1273             int  *anynull,        /* O - set to 1 if any pixels are null     */
1274             short *output,        /* O - array of converted pixels           */
1275             int *status)          /* IO - error status                       */
1276 /*
1277   Copy input to output following reading of the input from a FITS file.
1278   Check for null values and do datatype conversion and scaling if required.
1279   The nullcheck code value determines how any null values in the input array
1280   are treated.  A null value is an input pixel that is equal to tnull.  If
1281   nullcheck = 0, then no checking for nulls is performed and any null values
1282   will be transformed just like any other pixel.  If nullcheck = 1, then the
1283   output pixel will be set = nullval if the corresponding input pixel is null.
1284   If nullcheck = 2, then if the pixel is null then the corresponding value of
1285   nullarray will be set to 1; the value of nullarray for non-null pixels
1286   will = 0.  The anynull parameter will be set = 1 if any of the returned
1287   pixels are null, otherwise anynull will be returned with a value = 0;
1288 */
1289 {
1290     long ii;
1291     double dvalue;
1292     ULONGLONG ulltemp;
1293 
1294     if (nullcheck == 0)     /* no null checking required */
1295     {
1296         if (scale == 1. && zero ==  9223372036854775808.)
1297         {
1298             /* The column we read contains unsigned long long values. */
1299             /* Instead of adding 9223372036854775808, it is more efficient */
1300             /* and more precise to just flip the sign bit with the XOR operator */
1301 
1302             for (ii = 0; ii < ntodo; ii++) {
1303 
1304                 ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000);
1305 
1306                 if (ulltemp > SHRT_MAX)
1307                 {
1308                     *status = OVERFLOW_ERR;
1309                     output[ii] = SHRT_MAX;
1310                 }
1311                 else
1312 		{
1313                     output[ii] = (short) ulltemp;
1314 		}
1315             }
1316         }
1317         else if (scale == 1. && zero == 0.)      /* no scaling */
1318         {
1319             for (ii = 0; ii < ntodo; ii++)
1320             {
1321                 if (input[ii] < SHRT_MIN)
1322                 {
1323                     *status = OVERFLOW_ERR;
1324                     output[ii] = SHRT_MIN;
1325                 }
1326                 else if (input[ii] > SHRT_MAX)
1327                 {
1328                     *status = OVERFLOW_ERR;
1329                     output[ii] = SHRT_MAX;
1330                 }
1331                 else
1332                     output[ii] = (short) input[ii];
1333             }
1334         }
1335         else             /* must scale the data */
1336         {
1337             for (ii = 0; ii < ntodo; ii++)
1338             {
1339                 dvalue = input[ii] * scale + zero;
1340 
1341                 if (dvalue < DSHRT_MIN)
1342                 {
1343                     *status = OVERFLOW_ERR;
1344                     output[ii] = SHRT_MIN;
1345                 }
1346                 else if (dvalue > DSHRT_MAX)
1347                 {
1348                     *status = OVERFLOW_ERR;
1349                     output[ii] = SHRT_MAX;
1350                 }
1351                 else
1352                     output[ii] = (short) dvalue;
1353             }
1354         }
1355     }
1356     else        /* must check for null values */
1357     {
1358         if (scale == 1. && zero ==  9223372036854775808.)
1359         {
1360             /* The column we read contains unsigned long long values. */
1361             /* Instead of subtracting 9223372036854775808, it is more efficient */
1362             /* and more precise to just flip the sign bit with the XOR operator */
1363 
1364             for (ii = 0; ii < ntodo; ii++) {
1365 
1366                 if (input[ii] == tnull)
1367                 {
1368                     *anynull = 1;
1369                     if (nullcheck == 1)
1370                         output[ii] = nullval;
1371                     else
1372                         nullarray[ii] = 1;
1373                 }
1374                 else
1375 		{
1376                     ulltemp = (ULONGLONG) (((LONGLONG) input[ii]) ^ 0x8000000000000000);
1377 
1378                     if (ulltemp > SHRT_MAX)
1379                     {
1380                         *status = OVERFLOW_ERR;
1381                         output[ii] = SHRT_MAX;
1382                     }
1383                     else
1384 		    {
1385                         output[ii] = (short) ulltemp;
1386 		    }
1387                 }
1388             }
1389         }
1390         else if (scale == 1. && zero == 0.)  /* no scaling */
1391         {
1392             for (ii = 0; ii < ntodo; ii++)
1393             {
1394                 if (input[ii] == tnull)
1395                 {
1396                     *anynull = 1;
1397                     if (nullcheck == 1)
1398                         output[ii] = nullval;
1399                     else
1400                         nullarray[ii] = 1;
1401                 }
1402                 else
1403                 {
1404                     if (input[ii] < SHRT_MIN)
1405                     {
1406                         *status = OVERFLOW_ERR;
1407                         output[ii] = SHRT_MIN;
1408                     }
1409                     else if (input[ii] > SHRT_MAX)
1410                     {
1411                         *status = OVERFLOW_ERR;
1412                         output[ii] = SHRT_MAX;
1413                     }
1414                     else
1415                         output[ii] = (short) input[ii];
1416                 }
1417             }
1418         }
1419         else                  /* must scale the data */
1420         {
1421             for (ii = 0; ii < ntodo; ii++)
1422             {
1423                 if (input[ii] == tnull)
1424                 {
1425                     *anynull = 1;
1426                     if (nullcheck == 1)
1427                         output[ii] = nullval;
1428                     else
1429                         nullarray[ii] = 1;
1430                 }
1431                 else
1432                 {
1433                     dvalue = input[ii] * scale + zero;
1434 
1435                     if (dvalue < DSHRT_MIN)
1436                     {
1437                         *status = OVERFLOW_ERR;
1438                         output[ii] = SHRT_MIN;
1439                     }
1440                     else if (dvalue > DSHRT_MAX)
1441                     {
1442                         *status = OVERFLOW_ERR;
1443                         output[ii] = SHRT_MAX;
1444                     }
1445                     else
1446                         output[ii] = (short) dvalue;
1447                 }
1448             }
1449         }
1450     }
1451     return(*status);
1452 }
1453 /*--------------------------------------------------------------------------*/
fffr4i2(float * input,long ntodo,double scale,double zero,int nullcheck,short nullval,char * nullarray,int * anynull,short * output,int * status)1454 int fffr4i2(float *input,         /* I - array of values to be converted     */
1455             long ntodo,           /* I - number of elements in the array     */
1456             double scale,         /* I - FITS TSCALn or BSCALE value         */
1457             double zero,          /* I - FITS TZEROn or BZERO  value         */
1458             int nullcheck,        /* I - null checking code; 0 = don't check */
1459                                   /*     1:set null pixels = nullval         */
1460                                   /*     2: if null pixel, set nullarray = 1 */
1461             short nullval,        /* I - set null pixels, if nullcheck = 1   */
1462             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1463             int  *anynull,        /* O - set to 1 if any pixels are null     */
1464             short *output,        /* O - array of converted pixels           */
1465             int *status)          /* IO - error status                       */
1466 /*
1467   Copy input to output following reading of the input from a FITS file.
1468   Check for null values and do datatype conversion and scaling if required.
1469   The nullcheck code value determines how any null values in the input array
1470   are treated.  A null value is an input pixel that is equal to NaN.  If
1471   nullcheck = 0, then no checking for nulls is performed and any null values
1472   will be transformed just like any other pixel.  If nullcheck = 1, then the
1473   output pixel will be set = nullval if the corresponding input pixel is null.
1474   If nullcheck = 2, then if the pixel is null then the corresponding value of
1475   nullarray will be set to 1; the value of nullarray for non-null pixels
1476   will = 0.  The anynull parameter will be set = 1 if any of the returned
1477   pixels are null, otherwise anynull will be returned with a value = 0;
1478 */
1479 {
1480     long ii;
1481     double dvalue;
1482     short *sptr, iret;
1483 
1484     if (nullcheck == 0)     /* no null checking required */
1485     {
1486         if (scale == 1. && zero == 0.)      /* no scaling */
1487         {
1488             for (ii = 0; ii < ntodo; ii++)
1489             {
1490                 if (input[ii] < DSHRT_MIN)
1491                 {
1492                     *status = OVERFLOW_ERR;
1493                     output[ii] = SHRT_MIN;
1494                 }
1495                 else if (input[ii] > DSHRT_MAX)
1496                 {
1497                     *status = OVERFLOW_ERR;
1498                     output[ii] = SHRT_MAX;
1499                 }
1500                 else
1501                     output[ii] = (short) input[ii];
1502             }
1503         }
1504         else             /* must scale the data */
1505         {
1506             for (ii = 0; ii < ntodo; ii++)
1507             {
1508                 dvalue = input[ii] * scale + zero;
1509 
1510                 if (dvalue < DSHRT_MIN)
1511                 {
1512                     *status = OVERFLOW_ERR;
1513                     output[ii] = SHRT_MIN;
1514                 }
1515                 else if (dvalue > DSHRT_MAX)
1516                 {
1517                     *status = OVERFLOW_ERR;
1518                     output[ii] = SHRT_MAX;
1519                 }
1520                 else
1521                     output[ii] = (short) dvalue;
1522             }
1523         }
1524     }
1525     else        /* must check for null values */
1526     {
1527         sptr = (short *) input;
1528 
1529 #if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
1530         sptr++;       /* point to MSBs */
1531 #endif
1532 
1533         if (scale == 1. && zero == 0.)  /* no scaling */
1534         {
1535             for (ii = 0; ii < ntodo; ii++, sptr += 2)
1536             {
1537               if (0 != (iret = fnan(*sptr) ) )  /* test for NaN or underflow */
1538               {
1539                   if (iret == 1)  /* is it a NaN? */
1540                   {
1541                     *anynull = 1;
1542                     if (nullcheck == 1)
1543                         output[ii] = nullval;
1544                     else
1545                         nullarray[ii] = 1;
1546                   }
1547                   else            /* it's an underflow */
1548                      output[ii] = 0;
1549               }
1550               else
1551                 {
1552                     if (input[ii] < DSHRT_MIN)
1553                     {
1554                         *status = OVERFLOW_ERR;
1555                         output[ii] = SHRT_MIN;
1556                     }
1557                     else if (input[ii] > DSHRT_MAX)
1558                     {
1559                         *status = OVERFLOW_ERR;
1560                         output[ii] = SHRT_MAX;
1561                     }
1562                     else
1563                         output[ii] = (short) input[ii];
1564                 }
1565             }
1566         }
1567         else                  /* must scale the data */
1568         {
1569             for (ii = 0; ii < ntodo; ii++, sptr += 2)
1570             {
1571               if (0 != (iret = fnan(*sptr) ) )  /* test for NaN or underflow */
1572               {
1573                   if (iret == 1)  /* is it a NaN? */
1574                   {
1575                     *anynull = 1;
1576                     if (nullcheck == 1)
1577                         output[ii] = nullval;
1578                     else
1579                         nullarray[ii] = 1;
1580                   }
1581                   else            /* it's an underflow */
1582                   {
1583                     if (zero < DSHRT_MIN)
1584                     {
1585                         *status = OVERFLOW_ERR;
1586                         output[ii] = SHRT_MIN;
1587                     }
1588                     else if (zero > DSHRT_MAX)
1589                     {
1590                         *status = OVERFLOW_ERR;
1591                         output[ii] = SHRT_MAX;
1592                     }
1593                     else
1594                         output[ii] = (short) zero;
1595                   }
1596               }
1597               else
1598                 {
1599                     dvalue = input[ii] * scale + zero;
1600 
1601                     if (dvalue < DSHRT_MIN)
1602                     {
1603                         *status = OVERFLOW_ERR;
1604                         output[ii] = SHRT_MIN;
1605                     }
1606                     else if (dvalue > DSHRT_MAX)
1607                     {
1608                         *status = OVERFLOW_ERR;
1609                         output[ii] = SHRT_MAX;
1610                     }
1611                     else
1612                         output[ii] = (short) dvalue;
1613                 }
1614             }
1615         }
1616     }
1617     return(*status);
1618 }
1619 /*--------------------------------------------------------------------------*/
fffr8i2(double * input,long ntodo,double scale,double zero,int nullcheck,short nullval,char * nullarray,int * anynull,short * output,int * status)1620 int fffr8i2(double *input,        /* I - array of values to be converted     */
1621             long ntodo,           /* I - number of elements in the array     */
1622             double scale,         /* I - FITS TSCALn or BSCALE value         */
1623             double zero,          /* I - FITS TZEROn or BZERO  value         */
1624             int nullcheck,        /* I - null checking code; 0 = don't check */
1625                                   /*     1:set null pixels = nullval         */
1626                                   /*     2: if null pixel, set nullarray = 1 */
1627             short nullval,        /* I - set null pixels, if nullcheck = 1   */
1628             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1629             int  *anynull,        /* O - set to 1 if any pixels are null     */
1630             short *output,        /* O - array of converted pixels           */
1631             int *status)          /* IO - error status                       */
1632 /*
1633   Copy input to output following reading of the input from a FITS file.
1634   Check for null values and do datatype conversion and scaling if required.
1635   The nullcheck code value determines how any null values in the input array
1636   are treated.  A null value is an input pixel that is equal to NaN.  If
1637   nullcheck = 0, then no checking for nulls is performed and any null values
1638   will be transformed just like any other pixel.  If nullcheck = 1, then the
1639   output pixel will be set = nullval if the corresponding input pixel is null.
1640   If nullcheck = 2, then if the pixel is null then the corresponding value of
1641   nullarray will be set to 1; the value of nullarray for non-null pixels
1642   will = 0.  The anynull parameter will be set = 1 if any of the returned
1643   pixels are null, otherwise anynull will be returned with a value = 0;
1644 */
1645 {
1646     long ii;
1647     double dvalue;
1648     short *sptr, iret;
1649 
1650     if (nullcheck == 0)     /* no null checking required */
1651     {
1652         if (scale == 1. && zero == 0.)      /* no scaling */
1653         {
1654             for (ii = 0; ii < ntodo; ii++)
1655             {
1656                 if (input[ii] < DSHRT_MIN)
1657                 {
1658                     *status = OVERFLOW_ERR;
1659                     output[ii] = SHRT_MIN;
1660                 }
1661                 else if (input[ii] > DSHRT_MAX)
1662                 {
1663                     *status = OVERFLOW_ERR;
1664                     output[ii] = SHRT_MAX;
1665                 }
1666                 else
1667                     output[ii] = (short) input[ii];
1668             }
1669         }
1670         else             /* must scale the data */
1671         {
1672             for (ii = 0; ii < ntodo; ii++)
1673             {
1674                 dvalue = input[ii] * scale + zero;
1675 
1676                 if (dvalue < DSHRT_MIN)
1677                 {
1678                     *status = OVERFLOW_ERR;
1679                     output[ii] = SHRT_MIN;
1680                 }
1681                 else if (dvalue > DSHRT_MAX)
1682                 {
1683                     *status = OVERFLOW_ERR;
1684                     output[ii] = SHRT_MAX;
1685                 }
1686                 else
1687                     output[ii] = (short) dvalue;
1688             }
1689         }
1690     }
1691     else        /* must check for null values */
1692     {
1693         sptr = (short *) input;
1694 
1695 #if BYTESWAPPED && MACHINE != VAXVMS && MACHINE != ALPHAVMS
1696         sptr += 3;       /* point to MSBs */
1697 #endif
1698         if (scale == 1. && zero == 0.)  /* no scaling */
1699         {
1700             for (ii = 0; ii < ntodo; ii++, sptr += 4)
1701             {
1702               if (0 != (iret = dnan(*sptr)) )  /* test for NaN or underflow */
1703               {
1704                   if (iret == 1)  /* is it a NaN? */
1705                   {
1706                     *anynull = 1;
1707                     if (nullcheck == 1)
1708                         output[ii] = nullval;
1709                     else
1710                         nullarray[ii] = 1;
1711                   }
1712                   else            /* it's an underflow */
1713                      output[ii] = 0;
1714               }
1715               else
1716                 {
1717                     if (input[ii] < DSHRT_MIN)
1718                     {
1719                         *status = OVERFLOW_ERR;
1720                         output[ii] = SHRT_MIN;
1721                     }
1722                     else if (input[ii] > DSHRT_MAX)
1723                     {
1724                         *status = OVERFLOW_ERR;
1725                         output[ii] = SHRT_MAX;
1726                     }
1727                     else
1728                         output[ii] = (short) input[ii];
1729                 }
1730             }
1731         }
1732         else                  /* must scale the data */
1733         {
1734             for (ii = 0; ii < ntodo; ii++, sptr += 4)
1735             {
1736               if (0 != (iret = dnan(*sptr)) )  /* test for NaN or underflow */
1737               {
1738                   if (iret == 1)  /* is it a NaN? */
1739                   {
1740                     *anynull = 1;
1741                     if (nullcheck == 1)
1742                         output[ii] = nullval;
1743                     else
1744                         nullarray[ii] = 1;
1745                   }
1746                   else            /* it's an underflow */
1747                   {
1748                     if (zero < DSHRT_MIN)
1749                     {
1750                         *status = OVERFLOW_ERR;
1751                         output[ii] = SHRT_MIN;
1752                     }
1753                     else if (zero > DSHRT_MAX)
1754                     {
1755                         *status = OVERFLOW_ERR;
1756                         output[ii] = SHRT_MAX;
1757                     }
1758                     else
1759                         output[ii] = (short) zero;
1760                   }
1761               }
1762               else
1763                 {
1764                     dvalue = input[ii] * scale + zero;
1765 
1766                     if (dvalue < DSHRT_MIN)
1767                     {
1768                         *status = OVERFLOW_ERR;
1769                         output[ii] = SHRT_MIN;
1770                     }
1771                     else if (dvalue > DSHRT_MAX)
1772                     {
1773                         *status = OVERFLOW_ERR;
1774                         output[ii] = SHRT_MAX;
1775                     }
1776                     else
1777                         output[ii] = (short) dvalue;
1778                 }
1779             }
1780         }
1781     }
1782     return(*status);
1783 }
1784 /*--------------------------------------------------------------------------*/
fffstri2(char * input,long ntodo,double scale,double zero,long twidth,double implipower,int nullcheck,char * snull,short nullval,char * nullarray,int * anynull,short * output,int * status)1785 int fffstri2(char *input,         /* I - array of values to be converted     */
1786             long ntodo,           /* I - number of elements in the array     */
1787             double scale,         /* I - FITS TSCALn or BSCALE value         */
1788             double zero,          /* I - FITS TZEROn or BZERO  value         */
1789             long twidth,          /* I - width of each substring of chars    */
1790             double implipower,    /* I - power of 10 of implied decimal      */
1791             int nullcheck,        /* I - null checking code; 0 = don't check */
1792                                   /*     1:set null pixels = nullval         */
1793                                   /*     2: if null pixel, set nullarray = 1 */
1794             char  *snull,         /* I - value of FITS null string, if any   */
1795             short nullval,        /* I - set null pixels, if nullcheck = 1   */
1796             char *nullarray,      /* I - bad pixel array, if nullcheck = 2   */
1797             int  *anynull,        /* O - set to 1 if any pixels are null     */
1798             short *output,        /* O - array of converted pixels           */
1799             int *status)          /* IO - error status                       */
1800 /*
1801   Copy input to output following reading of the input from a FITS file. Check
1802   for null values and do scaling if required. The nullcheck code value
1803   determines how any null values in the input array are treated. A null
1804   value is an input pixel that is equal to snull.  If nullcheck= 0, then
1805   no special checking for nulls is performed.  If nullcheck = 1, then the
1806   output pixel will be set = nullval if the corresponding input pixel is null.
1807   If nullcheck = 2, then if the pixel is null then the corresponding value of
1808   nullarray will be set to 1; the value of nullarray for non-null pixels
1809   will = 0.  The anynull parameter will be set = 1 if any of the returned
1810   pixels are null, otherwise anynull will be returned with a value = 0;
1811 */
1812 {
1813     int nullen;
1814     long ii;
1815     double dvalue;
1816     char *cstring, message[FLEN_ERRMSG];
1817     char *cptr, *tpos;
1818     char tempstore, chrzero = '0';
1819     double val, power;
1820     int exponent, sign, esign, decpt;
1821 
1822     nullen = strlen(snull);
1823     cptr = input;  /* pointer to start of input string */
1824     for (ii = 0; ii < ntodo; ii++)
1825     {
1826       cstring = cptr;
1827       /* temporarily insert a null terminator at end of the string */
1828       tpos = cptr + twidth;
1829       tempstore = *tpos;
1830       *tpos = 0;
1831 
1832       /* check if null value is defined, and if the    */
1833       /* column string is identical to the null string */
1834       if (snull[0] != ASCII_NULL_UNDEFINED &&
1835          !strncmp(snull, cptr, nullen) )
1836       {
1837         if (nullcheck)
1838         {
1839           *anynull = 1;
1840           if (nullcheck == 1)
1841             output[ii] = nullval;
1842           else
1843             nullarray[ii] = 1;
1844         }
1845         cptr += twidth;
1846       }
1847       else
1848       {
1849         /* value is not the null value, so decode it */
1850         /* remove any embedded blank characters from the string */
1851 
1852         decpt = 0;
1853         sign = 1;
1854         val  = 0.;
1855         power = 1.;
1856         exponent = 0;
1857         esign = 1;
1858 
1859         while (*cptr == ' ')               /* skip leading blanks */
1860            cptr++;
1861 
1862         if (*cptr == '-' || *cptr == '+')  /* check for leading sign */
1863         {
1864           if (*cptr == '-')
1865              sign = -1;
1866 
1867           cptr++;
1868 
1869           while (*cptr == ' ')         /* skip blanks between sign and value */
1870             cptr++;
1871         }
1872 
1873         while (*cptr >= '0' && *cptr <= '9')
1874         {
1875           val = val * 10. + *cptr - chrzero;  /* accumulate the value */
1876           cptr++;
1877 
1878           while (*cptr == ' ')         /* skip embedded blanks in the value */
1879             cptr++;
1880         }
1881 
1882         if (*cptr == '.' || *cptr == ',')       /* check for decimal point */
1883         {
1884           decpt = 1;       /* set flag to show there was a decimal point */
1885           cptr++;
1886           while (*cptr == ' ')         /* skip any blanks */
1887             cptr++;
1888 
1889           while (*cptr >= '0' && *cptr <= '9')
1890           {
1891             val = val * 10. + *cptr - chrzero;  /* accumulate the value */
1892             power = power * 10.;
1893             cptr++;
1894 
1895             while (*cptr == ' ')         /* skip embedded blanks in the value */
1896               cptr++;
1897           }
1898         }
1899 
1900         if (*cptr == 'E' || *cptr == 'D')  /* check for exponent */
1901         {
1902           cptr++;
1903           while (*cptr == ' ')         /* skip blanks */
1904               cptr++;
1905 
1906           if (*cptr == '-' || *cptr == '+')  /* check for exponent sign */
1907           {
1908             if (*cptr == '-')
1909                esign = -1;
1910 
1911             cptr++;
1912 
1913             while (*cptr == ' ')        /* skip blanks between sign and exp */
1914               cptr++;
1915           }
1916 
1917           while (*cptr >= '0' && *cptr <= '9')
1918           {
1919             exponent = exponent * 10 + *cptr - chrzero;  /* accumulate exp */
1920             cptr++;
1921 
1922             while (*cptr == ' ')         /* skip embedded blanks */
1923               cptr++;
1924           }
1925         }
1926 
1927         if (*cptr  != 0)  /* should end up at the null terminator */
1928         {
1929           snprintf(message, FLEN_ERRMSG,"Cannot read number from ASCII table");
1930           ffpmsg(message);
1931           snprintf(message, FLEN_ERRMSG,"Column field = %s.", cstring);
1932           ffpmsg(message);
1933           /* restore the char that was overwritten by the null */
1934           *tpos = tempstore;
1935           return(*status = BAD_C2D);
1936         }
1937 
1938         if (!decpt)  /* if no explicit decimal, use implied */
1939            power = implipower;
1940 
1941         dvalue = (sign * val / power) * pow(10., (double) (esign * exponent));
1942 
1943         dvalue = dvalue * scale + zero;   /* apply the scaling */
1944 
1945         if (dvalue < DSHRT_MIN)
1946         {
1947             *status = OVERFLOW_ERR;
1948             output[ii] = SHRT_MIN;
1949         }
1950         else if (dvalue > DSHRT_MAX)
1951         {
1952             *status = OVERFLOW_ERR;
1953             output[ii] = SHRT_MAX;
1954         }
1955         else
1956             output[ii] = (short) dvalue;
1957       }
1958       /* restore the char that was overwritten by the null */
1959       *tpos = tempstore;
1960     }
1961     return(*status);
1962 }
1963