1 /*  This file, putcol.c, contains routines that write data elements to     */
2 /*  a FITS image or table. These are the generic routines.                 */
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 <string.h>
9 #include <stdlib.h>
10 #include <limits.h>
11 #include "fitsio2.h"
12 
13 /*--------------------------------------------------------------------------*/
ffppx(fitsfile * fptr,int datatype,long * firstpix,LONGLONG nelem,void * array,int * status)14 int ffppx(  fitsfile *fptr,  /* I - FITS file pointer                       */
15             int  datatype,   /* I - datatype of the value                   */
16             long  *firstpix, /* I - coord of  first pixel to write(1 based) */
17             LONGLONG  nelem,     /* I - number of values to write               */
18             void  *array,    /* I - array of values that are written        */
19             int  *status)    /* IO - error status                           */
20 /*
21   Write an array of pixels to the primary array.  The datatype of the
22   input array is defined by the 2nd argument. Data conversion
23   and scaling will be performed if necessary (e.g, if the datatype of
24   the FITS array is not the same as the array being written).
25 
26   This routine is simillar to ffppr, except it supports writing to
27   large images with more than 2**31 pixels.
28 */
29 {
30     int naxis, ii;
31     long group = 1;
32     LONGLONG firstelem, dimsize = 1, naxes[9];
33 
34     if (*status > 0)           /* inherit input status value if > 0 */
35         return(*status);
36 
37     /* get the size of the image */
38     ffgidm(fptr, &naxis, status);
39     ffgiszll(fptr, 9, naxes, status);
40 
41     firstelem = 0;
42     for (ii=0; ii < naxis; ii++)
43     {
44         firstelem += ((firstpix[ii] - 1) * dimsize);
45         dimsize *= naxes[ii];
46     }
47     firstelem++;
48 
49     if (datatype == TBYTE)
50     {
51       ffpprb(fptr, group, firstelem, nelem, (unsigned char *) array, status);
52     }
53     else if (datatype == TSBYTE)
54     {
55       ffpprsb(fptr, group, firstelem, nelem, (signed char *) array, status);
56     }
57     else if (datatype == TUSHORT)
58     {
59       ffpprui(fptr, group, firstelem, nelem, (unsigned short *) array,
60               status);
61     }
62     else if (datatype == TSHORT)
63     {
64       ffppri(fptr, group, firstelem, nelem, (short *) array, status);
65     }
66     else if (datatype == TUINT)
67     {
68       ffppruk(fptr, group, firstelem, nelem, (unsigned int *) array, status);
69     }
70     else if (datatype == TINT)
71     {
72       ffpprk(fptr, group, firstelem, nelem, (int *) array, status);
73     }
74     else if (datatype == TULONG)
75     {
76       ffppruj(fptr, group, firstelem, nelem, (unsigned long *) array, status);
77     }
78     else if (datatype == TLONG)
79     {
80       ffpprj(fptr, group, firstelem, nelem, (long *) array, status);
81     }
82     else if (datatype == TULONGLONG)
83     {
84       ffpprujj(fptr, group, firstelem, nelem, (ULONGLONG *) array, status);
85     }
86     else if (datatype == TLONGLONG)
87     {
88       ffpprjj(fptr, group, firstelem, nelem, (LONGLONG *) array, status);
89     }
90     else if (datatype == TFLOAT)
91     {
92       ffppre(fptr, group, firstelem, nelem, (float *) array, status);
93     }
94     else if (datatype == TDOUBLE)
95     {
96       ffpprd(fptr, group, firstelem, nelem, (double *) array, status);
97     }
98     else
99       *status = BAD_DATATYPE;
100 
101     return(*status);
102 }
103 /*--------------------------------------------------------------------------*/
ffppxll(fitsfile * fptr,int datatype,LONGLONG * firstpix,LONGLONG nelem,void * array,int * status)104 int ffppxll(  fitsfile *fptr,  /* I - FITS file pointer                       */
105             int  datatype,   /* I - datatype of the value                   */
106             LONGLONG  *firstpix, /* I - coord of  first pixel to write(1 based) */
107             LONGLONG  nelem,     /* I - number of values to write               */
108             void  *array,    /* I - array of values that are written        */
109             int  *status)    /* IO - error status                           */
110 /*
111   Write an array of pixels to the primary array.  The datatype of the
112   input array is defined by the 2nd argument. Data conversion
113   and scaling will be performed if necessary (e.g, if the datatype of
114   the FITS array is not the same as the array being written).
115 
116   This routine is simillar to ffppr, except it supports writing to
117   large images with more than 2**31 pixels.
118 */
119 {
120     int naxis, ii;
121     long group = 1;
122     LONGLONG firstelem, dimsize = 1, naxes[9];
123 
124     if (*status > 0)           /* inherit input status value if > 0 */
125         return(*status);
126 
127     /* get the size of the image */
128     ffgidm(fptr, &naxis, status);
129     ffgiszll(fptr, 9, naxes, status);
130 
131     firstelem = 0;
132     for (ii=0; ii < naxis; ii++)
133     {
134         firstelem += ((firstpix[ii] - 1) * dimsize);
135         dimsize *= naxes[ii];
136     }
137     firstelem++;
138 
139     if (datatype == TBYTE)
140     {
141       ffpprb(fptr, group, firstelem, nelem, (unsigned char *) array, status);
142     }
143     else if (datatype == TSBYTE)
144     {
145       ffpprsb(fptr, group, firstelem, nelem, (signed char *) array, status);
146     }
147     else if (datatype == TUSHORT)
148     {
149       ffpprui(fptr, group, firstelem, nelem, (unsigned short *) array,
150               status);
151     }
152     else if (datatype == TSHORT)
153     {
154       ffppri(fptr, group, firstelem, nelem, (short *) array, status);
155     }
156     else if (datatype == TUINT)
157     {
158       ffppruk(fptr, group, firstelem, nelem, (unsigned int *) array, status);
159     }
160     else if (datatype == TINT)
161     {
162       ffpprk(fptr, group, firstelem, nelem, (int *) array, status);
163     }
164     else if (datatype == TULONG)
165     {
166       ffppruj(fptr, group, firstelem, nelem, (unsigned long *) array, status);
167     }
168     else if (datatype == TLONG)
169     {
170       ffpprj(fptr, group, firstelem, nelem, (long *) array, status);
171     }
172     else if (datatype == TULONGLONG)
173     {
174       ffpprujj(fptr, group, firstelem, nelem, (ULONGLONG *) array, status);
175     }
176     else if (datatype == TLONGLONG)
177     {
178       ffpprjj(fptr, group, firstelem, nelem, (LONGLONG *) array, status);
179     }
180     else if (datatype == TFLOAT)
181     {
182       ffppre(fptr, group, firstelem, nelem, (float *) array, status);
183     }
184     else if (datatype == TDOUBLE)
185     {
186       ffpprd(fptr, group, firstelem, nelem, (double *) array, status);
187     }
188     else
189       *status = BAD_DATATYPE;
190 
191     return(*status);
192 }
193 /*--------------------------------------------------------------------------*/
ffppxn(fitsfile * fptr,int datatype,long * firstpix,LONGLONG nelem,void * array,void * nulval,int * status)194 int ffppxn(  fitsfile *fptr,  /* I - FITS file pointer                       */
195             int  datatype,   /* I - datatype of the value                   */
196             long  *firstpix, /* I - first vector element to write(1 = 1st)  */
197             LONGLONG  nelem,     /* I - number of values to write               */
198             void  *array,    /* I - array of values that are written        */
199             void  *nulval,   /* I - pointer to the null value               */
200             int  *status)    /* IO - error status                           */
201 /*
202   Write an array of values to the primary array.  The datatype of the
203   input array is defined by the 2nd argument. Data conversion
204   and scaling will be performed if necessary (e.g, if the datatype of
205   the FITS array is not the same as the array being written).
206 
207   This routine supports writing to large images with
208   more than 2**31 pixels.
209 */
210 {
211     int naxis, ii;
212     long group = 1;
213     LONGLONG firstelem, dimsize = 1, naxes[9];
214 
215     if (*status > 0)           /* inherit input status value if > 0 */
216         return(*status);
217 
218     if (nulval == NULL)  /* null value not defined? */
219     {
220         ffppx(fptr, datatype, firstpix, nelem, array, status);
221         return(*status);
222     }
223 
224     /* get the size of the image */
225     ffgidm(fptr, &naxis, status);
226     ffgiszll(fptr, 9, naxes, status);
227 
228     firstelem = 0;
229     for (ii=0; ii < naxis; ii++)
230     {
231         firstelem += ((firstpix[ii] - 1) * dimsize);
232         dimsize *= naxes[ii];
233     }
234     firstelem++;
235 
236     if (datatype == TBYTE)
237     {
238       ffppnb(fptr, group, firstelem, nelem, (unsigned char *) array,
239              *(unsigned char *) nulval, status);
240     }
241     else if (datatype == TSBYTE)
242     {
243       ffppnsb(fptr, group, firstelem, nelem, (signed char *) array,
244              *(signed char *) nulval, status);
245     }
246     else if (datatype == TUSHORT)
247     {
248       ffppnui(fptr, group, firstelem, nelem, (unsigned short *) array,
249               *(unsigned short *) nulval,status);
250     }
251     else if (datatype == TSHORT)
252     {
253       ffppni(fptr, group, firstelem, nelem, (short *) array,
254              *(short *) nulval, status);
255     }
256     else if (datatype == TUINT)
257     {
258       ffppnuk(fptr, group, firstelem, nelem, (unsigned int *) array,
259              *(unsigned int *) nulval, status);
260     }
261     else if (datatype == TINT)
262     {
263       ffppnk(fptr, group, firstelem, nelem, (int *) array,
264              *(int *) nulval, status);
265     }
266     else if (datatype == TULONG)
267     {
268       ffppnuj(fptr, group, firstelem, nelem, (unsigned long *) array,
269               *(unsigned long *) nulval,status);
270     }
271     else if (datatype == TLONG)
272     {
273       ffppnj(fptr, group, firstelem, nelem, (long *) array,
274              *(long *) nulval, status);
275     }
276     else if (datatype == TULONGLONG)
277     {
278       ffppnujj(fptr, group, firstelem, nelem, (ULONGLONG *) array,
279              *(ULONGLONG *) nulval, status);
280     }
281     else if (datatype == TLONGLONG)
282     {
283       ffppnjj(fptr, group, firstelem, nelem, (LONGLONG *) array,
284              *(LONGLONG *) nulval, status);
285     }
286     else if (datatype == TFLOAT)
287     {
288       ffppne(fptr, group, firstelem, nelem, (float *) array,
289              *(float *) nulval, status);
290     }
291     else if (datatype == TDOUBLE)
292     {
293       ffppnd(fptr, group, firstelem, nelem, (double *) array,
294              *(double *) nulval, status);
295     }
296     else
297       *status = BAD_DATATYPE;
298 
299     return(*status);
300 }
301 /*--------------------------------------------------------------------------*/
ffppxnll(fitsfile * fptr,int datatype,LONGLONG * firstpix,LONGLONG nelem,void * array,void * nulval,int * status)302 int ffppxnll(  fitsfile *fptr,  /* I - FITS file pointer                       */
303             int  datatype,   /* I - datatype of the value                   */
304             LONGLONG  *firstpix, /* I - first vector element to write(1 = 1st)  */
305             LONGLONG  nelem,     /* I - number of values to write               */
306             void  *array,    /* I - array of values that are written        */
307             void  *nulval,   /* I - pointer to the null value               */
308             int  *status)    /* IO - error status                           */
309 /*
310   Write an array of values to the primary array.  The datatype of the
311   input array is defined by the 2nd argument. Data conversion
312   and scaling will be performed if necessary (e.g, if the datatype of
313   the FITS array is not the same as the array being written).
314 
315   This routine supports writing to large images with
316   more than 2**31 pixels.
317 */
318 {
319     int naxis, ii;
320     long  group = 1;
321     LONGLONG firstelem, dimsize = 1, naxes[9];
322 
323     if (*status > 0)           /* inherit input status value if > 0 */
324         return(*status);
325 
326     if (nulval == NULL)  /* null value not defined? */
327     {
328         ffppxll(fptr, datatype, firstpix, nelem, array, status);
329         return(*status);
330     }
331 
332     /* get the size of the image */
333     ffgidm(fptr, &naxis, status);
334     ffgiszll(fptr, 9, naxes, status);
335 
336     firstelem = 0;
337     for (ii=0; ii < naxis; ii++)
338     {
339         firstelem += ((firstpix[ii] - 1) * dimsize);
340         dimsize *= naxes[ii];
341     }
342     firstelem++;
343 
344     if (datatype == TBYTE)
345     {
346       ffppnb(fptr, group, firstelem, nelem, (unsigned char *) array,
347              *(unsigned char *) nulval, status);
348     }
349     else if (datatype == TSBYTE)
350     {
351       ffppnsb(fptr, group, firstelem, nelem, (signed char *) array,
352              *(signed char *) nulval, status);
353     }
354     else if (datatype == TUSHORT)
355     {
356       ffppnui(fptr, group, firstelem, nelem, (unsigned short *) array,
357               *(unsigned short *) nulval,status);
358     }
359     else if (datatype == TSHORT)
360     {
361       ffppni(fptr, group, firstelem, nelem, (short *) array,
362              *(short *) nulval, status);
363     }
364     else if (datatype == TUINT)
365     {
366       ffppnuk(fptr, group, firstelem, nelem, (unsigned int *) array,
367              *(unsigned int *) nulval, status);
368     }
369     else if (datatype == TINT)
370     {
371       ffppnk(fptr, group, firstelem, nelem, (int *) array,
372              *(int *) nulval, status);
373     }
374     else if (datatype == TULONG)
375     {
376       ffppnuj(fptr, group, firstelem, nelem, (unsigned long *) array,
377               *(unsigned long *) nulval,status);
378     }
379     else if (datatype == TLONG)
380     {
381       ffppnj(fptr, group, firstelem, nelem, (long *) array,
382              *(long *) nulval, status);
383     }
384     else if (datatype == TULONGLONG)
385     {
386       ffppnujj(fptr, group, firstelem, nelem, (ULONGLONG *) array,
387              *(ULONGLONG *) nulval, status);
388     }
389     else if (datatype == TLONGLONG)
390     {
391       ffppnjj(fptr, group, firstelem, nelem, (LONGLONG *) array,
392              *(LONGLONG *) nulval, status);
393     }
394     else if (datatype == TFLOAT)
395     {
396       ffppne(fptr, group, firstelem, nelem, (float *) array,
397              *(float *) nulval, status);
398     }
399     else if (datatype == TDOUBLE)
400     {
401       ffppnd(fptr, group, firstelem, nelem, (double *) array,
402              *(double *) nulval, status);
403     }
404     else
405       *status = BAD_DATATYPE;
406 
407     return(*status);
408 }
409 /*--------------------------------------------------------------------------*/
ffppr(fitsfile * fptr,int datatype,LONGLONG firstelem,LONGLONG nelem,void * array,int * status)410 int ffppr(  fitsfile *fptr,  /* I - FITS file pointer                       */
411             int  datatype,   /* I - datatype of the value                   */
412             LONGLONG  firstelem, /* I - first vector element to write(1 = 1st)  */
413             LONGLONG  nelem,     /* I - number of values to write               */
414             void  *array,    /* I - array of values that are written        */
415             int  *status)    /* IO - error status                           */
416 /*
417   Write an array of values to the primary array.  The datatype of the
418   input array is defined by the 2nd argument. Data conversion
419   and scaling will be performed if necessary (e.g, if the datatype of
420   the FITS array is not the same as the array being written).
421 
422 */
423 {
424     long group = 1;
425 
426     if (*status > 0)           /* inherit input status value if > 0 */
427         return(*status);
428 
429     if (datatype == TBYTE)
430     {
431       ffpprb(fptr, group, firstelem, nelem, (unsigned char *) array, status);
432     }
433     else if (datatype == TSBYTE)
434     {
435       ffpprsb(fptr, group, firstelem, nelem, (signed char *) array, status);
436     }
437     else if (datatype == TUSHORT)
438     {
439       ffpprui(fptr, group, firstelem, nelem, (unsigned short *) array,
440               status);
441     }
442     else if (datatype == TSHORT)
443     {
444       ffppri(fptr, group, firstelem, nelem, (short *) array, status);
445     }
446     else if (datatype == TUINT)
447     {
448       ffppruk(fptr, group, firstelem, nelem, (unsigned int *) array, status);
449     }
450     else if (datatype == TINT)
451     {
452       ffpprk(fptr, group, firstelem, nelem, (int *) array, status);
453     }
454     else if (datatype == TULONG)
455     {
456       ffppruj(fptr, group, firstelem, nelem, (unsigned long *) array, status);
457     }
458     else if (datatype == TLONG)
459     {
460       ffpprj(fptr, group, firstelem, nelem, (long *) array, status);
461     }
462     else if (datatype == TULONGLONG)
463     {
464       ffpprujj(fptr, group, firstelem, nelem, (ULONGLONG *) array, status);
465     }
466     else if (datatype == TLONGLONG)
467     {
468       ffpprjj(fptr, group, firstelem, nelem, (LONGLONG *) array, status);
469     }
470     else if (datatype == TFLOAT)
471     {
472       ffppre(fptr, group, firstelem, nelem, (float *) array, status);
473     }
474     else if (datatype == TDOUBLE)
475     {
476       ffpprd(fptr, group, firstelem, nelem, (double *) array, status);
477     }
478     else
479       *status = BAD_DATATYPE;
480 
481     return(*status);
482 }
483 /*--------------------------------------------------------------------------*/
ffppn(fitsfile * fptr,int datatype,LONGLONG firstelem,LONGLONG nelem,void * array,void * nulval,int * status)484 int ffppn(  fitsfile *fptr,  /* I - FITS file pointer                       */
485             int  datatype,   /* I - datatype of the value                   */
486             LONGLONG  firstelem, /* I - first vector element to write(1 = 1st)  */
487             LONGLONG  nelem,     /* I - number of values to write               */
488             void  *array,    /* I - array of values that are written        */
489             void  *nulval,   /* I - pointer to the null value               */
490             int  *status)    /* IO - error status                           */
491 /*
492   Write an array of values to the primary array.  The datatype of the
493   input array is defined by the 2nd argument. Data conversion
494   and scaling will be performed if necessary (e.g, if the datatype of
495   the FITS array is not the same as the array being written).
496 
497 */
498 {
499     long group = 1;
500 
501     if (*status > 0)           /* inherit input status value if > 0 */
502         return(*status);
503 
504     if (nulval == NULL)  /* null value not defined? */
505     {
506         ffppr(fptr, datatype, firstelem, nelem, array, status);
507         return(*status);
508     }
509 
510     if (datatype == TBYTE)
511     {
512       ffppnb(fptr, group, firstelem, nelem, (unsigned char *) array,
513              *(unsigned char *) nulval, status);
514     }
515     else if (datatype == TSBYTE)
516     {
517       ffppnsb(fptr, group, firstelem, nelem, (signed char *) array,
518              *(signed char *) nulval, status);
519     }
520     else if (datatype == TUSHORT)
521     {
522       ffppnui(fptr, group, firstelem, nelem, (unsigned short *) array,
523               *(unsigned short *) nulval,status);
524     }
525     else if (datatype == TSHORT)
526     {
527       ffppni(fptr, group, firstelem, nelem, (short *) array,
528              *(short *) nulval, status);
529     }
530     else if (datatype == TUINT)
531     {
532       ffppnuk(fptr, group, firstelem, nelem, (unsigned int *) array,
533              *(unsigned int *) nulval, status);
534     }
535     else if (datatype == TINT)
536     {
537       ffppnk(fptr, group, firstelem, nelem, (int *) array,
538              *(int *) nulval, status);
539     }
540     else if (datatype == TULONG)
541     {
542       ffppnuj(fptr, group, firstelem, nelem, (unsigned long *) array,
543               *(unsigned long *) nulval,status);
544     }
545     else if (datatype == TLONG)
546     {
547       ffppnj(fptr, group, firstelem, nelem, (long *) array,
548              *(long *) nulval, status);
549     }
550     else if (datatype == TULONGLONG)
551     {
552       ffppnujj(fptr, group, firstelem, nelem, (ULONGLONG *) array,
553              *(ULONGLONG *) nulval, status);
554     }
555     else if (datatype == TLONGLONG)
556     {
557       ffppnjj(fptr, group, firstelem, nelem, (LONGLONG *) array,
558              *(LONGLONG *) nulval, status);
559     }
560     else if (datatype == TFLOAT)
561     {
562       ffppne(fptr, group, firstelem, nelem, (float *) array,
563              *(float *) nulval, status);
564     }
565     else if (datatype == TDOUBLE)
566     {
567       ffppnd(fptr, group, firstelem, nelem, (double *) array,
568              *(double *) nulval, status);
569     }
570     else
571       *status = BAD_DATATYPE;
572 
573     return(*status);
574 }
575 /*--------------------------------------------------------------------------*/
ffpss(fitsfile * fptr,int datatype,long * blc,long * trc,void * array,int * status)576 int ffpss(  fitsfile *fptr,   /* I - FITS file pointer                       */
577             int  datatype,    /* I - datatype of the value                   */
578             long *blc,        /* I - 'bottom left corner' of the subsection  */
579             long *trc ,       /* I - 'top right corner' of the subsection    */
580             void *array,      /* I - array of values that are written        */
581             int  *status)     /* IO - error status                           */
582 /*
583   Write a section of values to the primary array. The datatype of the
584   input array is defined by the 2nd argument.  Data conversion
585   and scaling will be performed if necessary (e.g, if the datatype of
586   the FITS array is not the same as the array being written).
587 
588   This routine supports writing to large images with
589   more than 2**31 pixels.
590 */
591 {
592     int naxis;
593     long naxes[9];
594 
595     if (*status > 0)   /* inherit input status value if > 0 */
596         return(*status);
597 
598     /* get the size of the image */
599     ffgidm(fptr, &naxis, status);
600     ffgisz(fptr, 9, naxes, status);
601 
602     if (datatype == TBYTE)
603     {
604         ffpssb(fptr, 1, naxis, naxes, blc, trc,
605                (unsigned char *) array, status);
606     }
607     else if (datatype == TSBYTE)
608     {
609         ffpsssb(fptr, 1, naxis, naxes, blc, trc,
610                (signed char *) array, status);
611     }
612     else if (datatype == TUSHORT)
613     {
614         ffpssui(fptr, 1, naxis, naxes, blc, trc,
615                (unsigned short *) array, status);
616     }
617     else if (datatype == TSHORT)
618     {
619         ffpssi(fptr, 1, naxis, naxes, blc, trc,
620                (short *) array, status);
621     }
622     else if (datatype == TUINT)
623     {
624         ffpssuk(fptr, 1, naxis, naxes, blc, trc,
625                (unsigned int *) array, status);
626     }
627     else if (datatype == TINT)
628     {
629         ffpssk(fptr, 1, naxis, naxes, blc, trc,
630                (int *) array, status);
631     }
632     else if (datatype == TULONG)
633     {
634         ffpssuj(fptr, 1, naxis, naxes, blc, trc,
635                (unsigned long *) array, status);
636     }
637     else if (datatype == TLONG)
638     {
639         ffpssj(fptr, 1, naxis, naxes, blc, trc,
640                (long *) array, status);
641     }
642     else if (datatype == TULONGLONG)
643     {
644         ffpssujj(fptr, 1, naxis, naxes, blc, trc,
645                (ULONGLONG *) array, status);
646     }
647     else if (datatype == TLONGLONG)
648     {
649         ffpssjj(fptr, 1, naxis, naxes, blc, trc,
650                (LONGLONG *) array, status);
651     }
652     else if (datatype == TFLOAT)
653     {
654         ffpsse(fptr, 1, naxis, naxes, blc, trc,
655                (float *) array, status);
656     }
657     else if (datatype == TDOUBLE)
658     {
659         ffpssd(fptr, 1, naxis, naxes, blc, trc,
660                (double *) array, status);
661     }
662     else
663       *status = BAD_DATATYPE;
664 
665     return(*status);
666 }
667 /*--------------------------------------------------------------------------*/
ffpcl(fitsfile * fptr,int datatype,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,void * array,int * status)668 int ffpcl(  fitsfile *fptr,  /* I - FITS file pointer                       */
669             int  datatype,   /* I - datatype of the value                   */
670             int  colnum,     /* I - number of column to write (1 = 1st col) */
671             LONGLONG  firstrow,  /* I - first row to write (1 = 1st row)        */
672             LONGLONG  firstelem, /* I - first vector element to write (1 = 1st) */
673             LONGLONG  nelem,     /* I - number of elements to write             */
674             void  *array,    /* I - array of values that are written        */
675             int  *status)    /* IO - error status                           */
676 /*
677   Write an array of values to a table column.  The datatype of the
678   input array is defined by the 2nd argument. Data conversion
679   and scaling will be performed if necessary (e.g, if the datatype of
680   the FITS column is not the same as the array being written).
681 
682 */
683 {
684     if (*status > 0)           /* inherit input status value if > 0 */
685         return(*status);
686 
687     if (datatype == TBIT)
688     {
689       ffpclx(fptr, colnum, firstrow, (long) firstelem, (long) nelem, (char *) array,
690              status);
691     }
692     else if (datatype == TBYTE)
693     {
694       ffpclb(fptr, colnum, firstrow, firstelem, nelem, (unsigned char *) array,
695              status);
696     }
697     else if (datatype == TSBYTE)
698     {
699       ffpclsb(fptr, colnum, firstrow, firstelem, nelem, (signed char *) array,
700              status);
701     }
702     else if (datatype == TUSHORT)
703     {
704       ffpclui(fptr, colnum, firstrow, firstelem, nelem,
705              (unsigned short *) array, status);
706     }
707     else if (datatype == TSHORT)
708     {
709       ffpcli(fptr, colnum, firstrow, firstelem, nelem, (short *) array,
710              status);
711     }
712     else if (datatype == TUINT)
713     {
714       ffpcluk(fptr, colnum, firstrow, firstelem, nelem, (unsigned int *) array,
715                status);
716     }
717     else if (datatype == TINT)
718     {
719       ffpclk(fptr, colnum, firstrow, firstelem, nelem, (int *) array,
720                status);
721     }
722     else if (datatype == TULONG)
723     {
724       ffpcluj(fptr, colnum, firstrow, firstelem, nelem, (unsigned long *) array,
725               status);
726     }
727     else if (datatype == TLONG)
728     {
729       ffpclj(fptr, colnum, firstrow, firstelem, nelem, (long *) array,
730              status);
731     }
732     else if (datatype == TULONGLONG)
733     {
734       ffpclujj(fptr, colnum, firstrow, firstelem, nelem, (ULONGLONG *) array,
735              status);
736     }
737     else if (datatype == TLONGLONG)
738     {
739       ffpcljj(fptr, colnum, firstrow, firstelem, nelem, (LONGLONG *) array,
740              status);
741     }
742     else if (datatype == TFLOAT)
743     {
744       ffpcle(fptr, colnum, firstrow, firstelem, nelem, (float *) array,
745              status);
746     }
747     else if (datatype == TDOUBLE)
748     {
749       ffpcld(fptr, colnum, firstrow, firstelem, nelem, (double *) array,
750              status);
751     }
752     else if (datatype == TCOMPLEX)
753     {
754       ffpcle(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
755              (float *) array, status);
756     }
757     else if (datatype == TDBLCOMPLEX)
758     {
759       ffpcld(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
760              (double *) array, status);
761     }
762     else if (datatype == TLOGICAL)
763     {
764       ffpcll(fptr, colnum, firstrow, firstelem, nelem, (char *) array,
765              status);
766     }
767     else if (datatype == TSTRING)
768     {
769       ffpcls(fptr, colnum, firstrow, firstelem, nelem, (char **) array,
770              status);
771     }
772     else
773       *status = BAD_DATATYPE;
774 
775     return(*status);
776 }
777 /*--------------------------------------------------------------------------*/
ffpcn(fitsfile * fptr,int datatype,int colnum,LONGLONG firstrow,LONGLONG firstelem,LONGLONG nelem,void * array,void * nulval,int * status)778 int ffpcn(  fitsfile *fptr,  /* I - FITS file pointer                       */
779             int  datatype,   /* I - datatype of the value                   */
780             int  colnum,     /* I - number of column to write (1 = 1st col) */
781             LONGLONG  firstrow,  /* I - first row to write (1 = 1st row)        */
782             LONGLONG  firstelem, /* I - first vector element to write (1 = 1st) */
783             LONGLONG  nelem,     /* I - number of elements to write             */
784             void  *array,    /* I - array of values that are written        */
785             void  *nulval,   /* I - pointer to the null value               */
786             int  *status)    /* IO - error status                           */
787 /*
788   Write an array of values to a table column.  The datatype of the
789   input array is defined by the 2nd argument. Data conversion
790   and scaling will be performed if necessary (e.g, if the datatype of
791   the FITS column is not the same as the array being written).
792 
793 */
794 {
795     if (*status > 0)           /* inherit input status value if > 0 */
796         return(*status);
797 
798     if (nulval == NULL)  /* null value not defined? */
799     {
800         ffpcl(fptr, datatype, colnum, firstrow, firstelem, nelem, array,
801               status);
802         return(*status);
803     }
804 
805     if (datatype == TBYTE)
806     {
807       ffpcnb(fptr, colnum, firstrow, firstelem, nelem, (unsigned char *) array,
808             *(unsigned char *) nulval, status);
809     }
810     else if (datatype == TSBYTE)
811     {
812       ffpcnsb(fptr, colnum, firstrow, firstelem, nelem, (signed char *) array,
813             *(signed char *) nulval, status);
814     }
815     else if (datatype == TUSHORT)
816     {
817      ffpcnui(fptr, colnum, firstrow, firstelem, nelem, (unsigned short *) array,
818              *(unsigned short *) nulval, status);
819     }
820     else if (datatype == TSHORT)
821     {
822       ffpcni(fptr, colnum, firstrow, firstelem, nelem, (short *) array,
823              *(unsigned short *) nulval, status);
824     }
825     else if (datatype == TUINT)
826     {
827       ffpcnuk(fptr, colnum, firstrow, firstelem, nelem, (unsigned int *) array,
828              *(unsigned int *) nulval, status);
829     }
830     else if (datatype == TINT)
831     {
832       ffpcnk(fptr, colnum, firstrow, firstelem, nelem, (int *) array,
833              *(int *) nulval, status);
834     }
835     else if (datatype == TULONG)
836     {
837       ffpcnuj(fptr, colnum, firstrow, firstelem, nelem, (unsigned long *) array,
838               *(unsigned long *) nulval, status);
839     }
840     else if (datatype == TLONG)
841     {
842       ffpcnj(fptr, colnum, firstrow, firstelem, nelem, (long *) array,
843              *(long *) nulval, status);
844     }
845     else if (datatype == TULONGLONG)
846     {
847       ffpcnujj(fptr, colnum, firstrow, firstelem, nelem, (ULONGLONG *) array,
848              *(ULONGLONG *) nulval, status);
849     }
850     else if (datatype == TLONGLONG)
851     {
852       ffpcnjj(fptr, colnum, firstrow, firstelem, nelem, (LONGLONG *) array,
853              *(LONGLONG *) nulval, status);
854     }
855     else if (datatype == TFLOAT)
856     {
857       ffpcne(fptr, colnum, firstrow, firstelem, nelem, (float *) array,
858              *(float *) nulval, status);
859     }
860     else if (datatype == TDOUBLE)
861     {
862       ffpcnd(fptr, colnum, firstrow, firstelem, nelem, (double *) array,
863              *(double *) nulval, status);
864     }
865     else if (datatype == TCOMPLEX)
866     {
867       ffpcne(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
868              (float *) array, *(float *) nulval, status);
869     }
870     else if (datatype == TDBLCOMPLEX)
871     {
872       ffpcnd(fptr, colnum, firstrow, (firstelem - 1) * 2 + 1, nelem * 2,
873              (double *) array, *(double *) nulval, status);
874     }
875     else if (datatype == TLOGICAL)
876     {
877       ffpcnl(fptr, colnum, firstrow, firstelem, nelem, (char *) array,
878              *(char *) nulval, status);
879     }
880     else if (datatype == TSTRING)
881     {
882       ffpcns(fptr, colnum, firstrow, firstelem, nelem, (char **) array,
883              (char *) nulval, status);
884     }
885     else
886       *status = BAD_DATATYPE;
887 
888     return(*status);
889 }
890 /*--------------------------------------------------------------------------*/
fits_iter_set_by_name(iteratorCol * col,fitsfile * fptr,char * colname,int datatype,int iotype)891 int fits_iter_set_by_name(iteratorCol *col, /* I - iterator col structure */
892            fitsfile *fptr,  /* I - FITS file pointer                      */
893            char *colname,   /* I - column name                            */
894            int datatype,    /* I - column datatype                        */
895            int iotype)      /* I - InputCol, InputOutputCol, or OutputCol */
896 /*
897   set all the parameters for an iterator column, by column name
898 */
899 {
900     col->fptr = fptr;
901     strncpy(col->colname, colname,69);
902     col->colname[69]=0;
903     col->colnum = 0;  /* set column number undefined since name is given */
904     col->datatype = datatype;
905     col->iotype = iotype;
906     return(0);
907 }
908 /*--------------------------------------------------------------------------*/
fits_iter_set_by_num(iteratorCol * col,fitsfile * fptr,int colnum,int datatype,int iotype)909 int fits_iter_set_by_num(iteratorCol *col, /* I - iterator column structure */
910            fitsfile *fptr,  /* I - FITS file pointer                      */
911            int colnum,      /* I - column number                          */
912            int datatype,    /* I - column datatype                        */
913            int iotype)      /* I - InputCol, InputOutputCol, or OutputCol */
914 /*
915   set all the parameters for an iterator column, by column number
916 */
917 {
918     col->fptr = fptr;
919     col->colnum = colnum;
920     col->datatype = datatype;
921     col->iotype = iotype;
922     return(0);
923 }
924 /*--------------------------------------------------------------------------*/
fits_iter_set_file(iteratorCol * col,fitsfile * fptr)925 int fits_iter_set_file(iteratorCol *col, /* I - iterator column structure   */
926            fitsfile *fptr)   /* I - FITS file pointer                      */
927 /*
928   set iterator column parameter
929 */
930 {
931     col->fptr = fptr;
932     return(0);
933 }
934 /*--------------------------------------------------------------------------*/
fits_iter_set_colname(iteratorCol * col,char * colname)935 int fits_iter_set_colname(iteratorCol *col, /* I - iterator col structure  */
936            char *colname)    /* I - column name                            */
937 /*
938   set iterator column parameter
939 */
940 {
941     strncpy(col->colname, colname,69);
942     col->colname[69]=0;
943     col->colnum = 0;  /* set column number undefined since name is given */
944     return(0);
945 }
946 /*--------------------------------------------------------------------------*/
fits_iter_set_colnum(iteratorCol * col,int colnum)947 int fits_iter_set_colnum(iteratorCol *col, /* I - iterator column structure */
948            int colnum)       /* I - column number                          */
949 /*
950   set iterator column parameter
951 */
952 {
953     col->colnum = colnum;
954     return(0);
955 }
956 /*--------------------------------------------------------------------------*/
fits_iter_set_datatype(iteratorCol * col,int datatype)957 int fits_iter_set_datatype(iteratorCol *col, /* I - iterator col structure */
958            int datatype)    /* I - column datatype                        */
959 /*
960   set iterator column parameter
961 */
962 {
963     col->datatype = datatype;
964     return(0);
965 }
966 /*--------------------------------------------------------------------------*/
fits_iter_set_iotype(iteratorCol * col,int iotype)967 int fits_iter_set_iotype(iteratorCol *col, /* I - iterator column structure */
968            int iotype)       /* I - InputCol, InputOutputCol, or OutputCol */
969 /*
970   set iterator column parameter
971 */
972 {
973     col->iotype = iotype;
974     return(0);
975 }
976 /*--------------------------------------------------------------------------*/
fits_iter_get_file(iteratorCol * col)977 fitsfile * fits_iter_get_file(iteratorCol *col) /* I -iterator col structure */
978 /*
979   get iterator column parameter
980 */
981 {
982      return(col->fptr);
983 }
984 /*--------------------------------------------------------------------------*/
fits_iter_get_colname(iteratorCol * col)985 char * fits_iter_get_colname(iteratorCol *col) /* I -iterator col structure */
986 /*
987   get iterator column parameter
988 */
989 {
990     return(col->colname);
991 }
992 /*--------------------------------------------------------------------------*/
fits_iter_get_colnum(iteratorCol * col)993 int fits_iter_get_colnum(iteratorCol *col) /* I - iterator column structure */
994 /*
995   get iterator column parameter
996 */
997 {
998     return(col->colnum);
999 }
1000 /*--------------------------------------------------------------------------*/
fits_iter_get_datatype(iteratorCol * col)1001 int fits_iter_get_datatype(iteratorCol *col) /* I - iterator col structure */
1002 /*
1003   get iterator column parameter
1004 */
1005 {
1006     return(col->datatype);
1007 }
1008 /*--------------------------------------------------------------------------*/
fits_iter_get_iotype(iteratorCol * col)1009 int fits_iter_get_iotype(iteratorCol *col) /* I - iterator column structure */
1010 /*
1011   get iterator column parameter
1012 */
1013 {
1014      return(col->iotype);
1015 }
1016 /*--------------------------------------------------------------------------*/
fits_iter_get_array(iteratorCol * col)1017 void * fits_iter_get_array(iteratorCol *col) /* I - iterator col structure */
1018 /*
1019   get iterator column parameter
1020 */
1021 {
1022      return(col->array);
1023 }
1024 /*--------------------------------------------------------------------------*/
fits_iter_get_tlmin(iteratorCol * col)1025 long fits_iter_get_tlmin(iteratorCol *col) /* I - iterator column structure */
1026 /*
1027   get iterator column parameter
1028 */
1029 {
1030      return(col->tlmin);
1031 }
1032 /*--------------------------------------------------------------------------*/
fits_iter_get_tlmax(iteratorCol * col)1033 long fits_iter_get_tlmax(iteratorCol *col) /* I - iterator column structure */
1034 /*
1035   get iterator column parameter
1036 */
1037 {
1038      return(col->tlmax);
1039 }
1040 /*--------------------------------------------------------------------------*/
fits_iter_get_repeat(iteratorCol * col)1041 long fits_iter_get_repeat(iteratorCol *col) /* I - iterator col structure */
1042 /*
1043   get iterator column parameter
1044 */
1045 {
1046      return(col->repeat);
1047 }
1048 /*--------------------------------------------------------------------------*/
fits_iter_get_tunit(iteratorCol * col)1049 char * fits_iter_get_tunit(iteratorCol *col) /* I - iterator col structure */
1050 /*
1051   get iterator column parameter
1052 */
1053 {
1054     return(col->tunit);
1055 }
1056 /*--------------------------------------------------------------------------*/
fits_iter_get_tdisp(iteratorCol * col)1057 char * fits_iter_get_tdisp(iteratorCol *col) /* I -iterator col structure   */
1058 /*
1059   get iterator column parameter
1060 */
1061 {
1062     return(col->tdisp);
1063 }
1064 /*--------------------------------------------------------------------------*/
ffiter(int n_cols,iteratorCol * cols,long offset,long n_per_loop,int (* work_fn)(long total_n,long offset,long first_n,long n_values,int n_cols,iteratorCol * cols,void * userPointer),void * userPointer,int * status)1065 int ffiter(int n_cols,
1066            iteratorCol *cols,
1067            long offset,
1068            long n_per_loop,
1069            int (*work_fn)(long total_n,
1070                           long offset,
1071                           long first_n,
1072                           long n_values,
1073                           int n_cols,
1074                           iteratorCol *cols,
1075                           void *userPointer),
1076            void *userPointer,
1077            int *status)
1078 /*
1079    The iterator function.  This function will pass the specified
1080    columns from a FITS table or pixels from a FITS image to the
1081    user-supplied function.  Depending on the size of the table
1082    or image, only a subset of the rows or pixels may be passed to the
1083    function on each call, in which case the function will be called
1084    multiple times until all the rows or pixels have been processed.
1085 */
1086 {
1087     typedef struct  /* structure to store the column null value */
1088     {
1089         int      nullsize;    /* length of the null value, in bytes */
1090         union {   /*  default null value for the column */
1091             char   *stringnull;
1092             unsigned char   charnull;
1093             signed char scharnull;
1094             int    intnull;
1095             short  shortnull;
1096             long   longnull;
1097             unsigned int   uintnull;
1098             unsigned short ushortnull;
1099             unsigned long  ulongnull;
1100             float  floatnull;
1101             double doublenull;
1102 	    LONGLONG longlongnull;
1103         } null;
1104     } colNulls;
1105 
1106     void *dataptr, *defaultnull;
1107     colNulls *col;
1108     int ii, jj, tstatus, naxis, bitpix;
1109     int typecode, hdutype, jtype, type, anynul, nfiles, nbytes;
1110     long totaln, nleft, frow, felement, n_optimum, i_optimum, ntodo;
1111     long rept, rowrept, width, tnull, naxes[9] = {1,1,1,1,1,1,1,1,1}, groups;
1112     double zeros = 0.;
1113     char message[FLEN_ERRMSG], keyname[FLEN_KEYWORD], nullstr[FLEN_VALUE];
1114     char **stringptr, *nullptr, *cptr;
1115 
1116     if (*status > 0)
1117         return(*status);
1118 
1119     if (n_cols  < 0 || n_cols > 999 )
1120     {
1121         ffpmsg("Illegal number of columms (ffiter)");
1122         return(*status = BAD_COL_NUM);  /* negative number of columns */
1123     }
1124 
1125     /*------------------------------------------------------------*/
1126     /* Make sure column numbers and datatypes are in legal range  */
1127     /* and column numbers and datatypes are legal.                */
1128     /* Also fill in other parameters in the column structure.     */
1129     /*------------------------------------------------------------*/
1130 
1131     ffghdt(cols[0].fptr, &hdutype, status);  /* type of first HDU */
1132 
1133     for (jj = 0; jj < n_cols; jj++)
1134     {
1135         /* check that output datatype code value is legal */
1136         type = cols[jj].datatype;
1137 
1138         /* Allow variable length arrays for InputCol and InputOutputCol columns,
1139 	   but not for OutputCol columns.  Variable length arrays have a
1140 	   negative type code value. */
1141 
1142         if ((cols[jj].iotype != OutputCol) && (type<0)) {
1143             type*=-1;
1144         }
1145 
1146         if (type != 0      && type != TBYTE  &&
1147             type != TSBYTE && type != TLOGICAL && type != TSTRING &&
1148             type != TSHORT && type != TINT     && type != TLONG &&
1149             type != TFLOAT && type != TDOUBLE  && type != TCOMPLEX &&
1150             type != TULONG && type != TUSHORT  && type != TDBLCOMPLEX &&
1151 	    type != TLONGLONG )
1152         {
1153 	    if (type < 0) {
1154 	      snprintf(message,FLEN_ERRMSG,
1155               "Variable length array not allowed for output column number %d (ffiter)",
1156                     jj + 1);
1157 	    } else {
1158             snprintf(message,FLEN_ERRMSG,
1159                    "Illegal datatype for column number %d: %d  (ffiter)",
1160                     jj + 1, cols[jj].datatype);
1161 	    }
1162 
1163             ffpmsg(message);
1164             return(*status = BAD_DATATYPE);
1165         }
1166 
1167         /* initialize TLMINn, TLMAXn, column name, and display format */
1168         cols[jj].tlmin = 0;
1169         cols[jj].tlmax = 0;
1170         cols[jj].tunit[0] = '\0';
1171         cols[jj].tdisp[0] = '\0';
1172 
1173         ffghdt(cols[jj].fptr, &jtype, status);  /* get HDU type */
1174 
1175         if (hdutype == IMAGE_HDU) /* operating on FITS images */
1176         {
1177             if (jtype != IMAGE_HDU)
1178             {
1179                 snprintf(message,FLEN_ERRMSG,
1180                 "File %d not positioned to an image extension (ffiter)",
1181                     jj + 1);
1182                 return(*status = NOT_IMAGE);
1183             }
1184 
1185             /* since this is an image, set a dummy column number = 0 */
1186             cols[jj].colnum = 0;
1187             strcpy(cols[jj].colname, "IMAGE");  /* dummy name for images */
1188 
1189             tstatus = 0;
1190             ffgkys(cols[jj].fptr, "BUNIT", cols[jj].tunit, 0, &tstatus);
1191         }
1192         else  /* operating on FITS tables */
1193         {
1194             if (jtype == IMAGE_HDU)
1195             {
1196                 snprintf(message,FLEN_ERRMSG,
1197                 "File %d not positioned to a table extension (ffiter)",
1198                     jj + 1);
1199                 return(*status = NOT_TABLE);
1200             }
1201 
1202             if (cols[jj].colnum < 1)
1203             {
1204                 /* find the column number for the named column */
1205                 if (ffgcno(cols[jj].fptr, CASEINSEN, cols[jj].colname,
1206                            &cols[jj].colnum, status) )
1207                 {
1208                     snprintf(message,FLEN_ERRMSG,
1209                       "Column '%s' not found for column number %d  (ffiter)",
1210                        cols[jj].colname, jj + 1);
1211                     ffpmsg(message);
1212                     return(*status);
1213                 }
1214             }
1215 
1216             /* check that the column number is valid */
1217             if (cols[jj].colnum < 1 ||
1218                 cols[jj].colnum > ((cols[jj].fptr)->Fptr)->tfield)
1219             {
1220                 snprintf(message,FLEN_ERRMSG,
1221                   "Column %d has illegal table position number: %d  (ffiter)",
1222                     jj + 1, cols[jj].colnum);
1223                 ffpmsg(message);
1224                 return(*status = BAD_COL_NUM);
1225             }
1226 
1227             /* look for column description keywords and update structure */
1228             tstatus = 0;
1229             ffkeyn("TLMIN", cols[jj].colnum, keyname, &tstatus);
1230             ffgkyj(cols[jj].fptr, keyname, &cols[jj].tlmin, 0, &tstatus);
1231 
1232             tstatus = 0;
1233             ffkeyn("TLMAX", cols[jj].colnum, keyname, &tstatus);
1234             ffgkyj(cols[jj].fptr, keyname, &cols[jj].tlmax, 0, &tstatus);
1235 
1236             tstatus = 0;
1237             ffkeyn("TTYPE", cols[jj].colnum, keyname, &tstatus);
1238             ffgkys(cols[jj].fptr, keyname, cols[jj].colname, 0, &tstatus);
1239             if (tstatus)
1240                 cols[jj].colname[0] = '\0';
1241 
1242             tstatus = 0;
1243             ffkeyn("TUNIT", cols[jj].colnum, keyname, &tstatus);
1244             ffgkys(cols[jj].fptr, keyname, cols[jj].tunit, 0, &tstatus);
1245 
1246             tstatus = 0;
1247             ffkeyn("TDISP", cols[jj].colnum, keyname, &tstatus);
1248             ffgkys(cols[jj].fptr, keyname, cols[jj].tdisp, 0, &tstatus);
1249         }
1250     }  /* end of loop over all columns */
1251 
1252     /*-----------------------------------------------------------------*/
1253     /* use the first file to set the total number of values to process */
1254     /*-----------------------------------------------------------------*/
1255 
1256     offset = maxvalue(offset, 0L);  /* make sure offset is legal */
1257 
1258     if (hdutype == IMAGE_HDU)   /* get total number of pixels in the image */
1259     {
1260       fits_get_img_dim(cols[0].fptr, &naxis, status);
1261       fits_get_img_size(cols[0].fptr, 9, naxes, status);
1262 
1263       tstatus = 0;
1264       ffgkyj(cols[0].fptr, "GROUPS", &groups, NULL, &tstatus);
1265       if (!tstatus && groups && (naxis > 1) && (naxes[0] == 0) )
1266       {
1267          /* this is a random groups file, with NAXIS1 = 0 */
1268          /* Use GCOUNT, the number of groups, as the first multiplier  */
1269          /* to calculate the total number of pixels in all the groups. */
1270          ffgkyj(cols[0].fptr, "GCOUNT", &totaln, NULL, status);
1271 
1272       }  else {
1273          totaln = naxes[0];
1274       }
1275 
1276       for (ii = 1; ii < naxis; ii++)
1277           totaln *= naxes[ii];
1278 
1279       frow = 1;
1280       felement = 1 + offset;
1281     }
1282     else   /* get total number or rows in the table */
1283     {
1284       ffgkyj(cols[0].fptr, "NAXIS2", &totaln, 0, status);
1285       frow = 1 + offset;
1286       felement = 1;
1287     }
1288 
1289     /*  adjust total by the input starting offset value */
1290     totaln -= offset;
1291     totaln = maxvalue(totaln, 0L);   /* don't allow negative number */
1292 
1293     /*------------------------------------------------------------------*/
1294     /* Determine number of values to pass to work function on each loop */
1295     /*------------------------------------------------------------------*/
1296 
1297     if (n_per_loop == 0)
1298     {
1299         /* Determine optimum number of values for each iteration.    */
1300         /* Look at all the fitsfile pointers to determine the number */
1301         /* of unique files.                                          */
1302 
1303         nfiles = 1;
1304         ffgrsz(cols[0].fptr, &n_optimum, status);
1305 
1306         for (jj = 1; jj < n_cols; jj++)
1307         {
1308             for (ii = 0; ii < jj; ii++)
1309             {
1310                 if (cols[ii].fptr == cols[jj].fptr)
1311                    break;
1312             }
1313 
1314             if (ii == jj)  /* this is a new file */
1315             {
1316                 nfiles++;
1317                 ffgrsz(cols[jj].fptr, &i_optimum, status);
1318                 n_optimum = minvalue(n_optimum, i_optimum);
1319             }
1320         }
1321 
1322         /* divid n_optimum by the number of files that will be processed */
1323         n_optimum = n_optimum / nfiles;
1324         n_optimum = maxvalue(n_optimum, 1);
1325     }
1326     else if (n_per_loop < 0)  /* must pass all the values at one time */
1327     {
1328         n_optimum = totaln;
1329     }
1330     else /* calling routine specified how many values to pass at a time */
1331     {
1332         n_optimum = minvalue(n_per_loop, totaln);
1333     }
1334 
1335     /*--------------------------------------*/
1336     /* allocate work arrays for each column */
1337     /* and determine the null pixel value   */
1338     /*--------------------------------------*/
1339 
1340     col = calloc(n_cols, sizeof(colNulls) ); /* memory for the null values */
1341     if (!col)
1342     {
1343         ffpmsg("ffiter failed to allocate memory for null values");
1344         *status = MEMORY_ALLOCATION;  /* memory allocation failed */
1345         return(*status);
1346     }
1347 
1348     for (jj = 0; jj < n_cols; jj++)
1349     {
1350         /* get image or column datatype and vector length */
1351         if (hdutype == IMAGE_HDU)   /* get total number of pixels in the image */
1352         {
1353            fits_get_img_type(cols[jj].fptr, &bitpix, status);
1354            switch(bitpix) {
1355              case BYTE_IMG:
1356                  typecode = TBYTE;
1357                  break;
1358              case SHORT_IMG:
1359                  typecode = TSHORT;
1360                  break;
1361              case LONG_IMG:
1362                  typecode = TLONG;
1363                  break;
1364              case FLOAT_IMG:
1365                  typecode = TFLOAT;
1366                  break;
1367              case DOUBLE_IMG:
1368                  typecode = TDOUBLE;
1369                  break;
1370              case LONGLONG_IMG:
1371                  typecode = TLONGLONG;
1372                  break;
1373             }
1374         }
1375         else
1376         {
1377             if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,
1378                   &width, status) > 0)
1379                 goto cleanup;
1380 
1381 	    if (typecode < 0) {  /* if any variable length arrays, then the */
1382 	        n_optimum = 1;   /* must process the table 1 row at a time */
1383 
1384               /* Allow variable length arrays for InputCol and InputOutputCol columns,
1385 	       but not for OutputCol columns.  Variable length arrays have a
1386 	       negative type code value. */
1387 
1388               if (cols[jj].iotype == OutputCol) {
1389  	        snprintf(message,FLEN_ERRMSG,
1390                 "Variable length array not allowed for output column number %d (ffiter)",
1391                     jj + 1);
1392                 ffpmsg(message);
1393                 return(*status = BAD_DATATYPE);
1394               }
1395 	   }
1396         }
1397 
1398         /* special case where sizeof(long) = 8: use TINT instead of TLONG */
1399         if (abs(typecode) == TLONG && sizeof(long) == 8 && sizeof(int) == 4) {
1400 		if(typecode<0) {
1401 			typecode = -TINT;
1402 		} else {
1403 			typecode = TINT;
1404 		}
1405         }
1406 
1407         /* Special case: interprete 'X' column as 'B' */
1408         if (abs(typecode) == TBIT)
1409         {
1410             typecode  = typecode / TBIT * TBYTE;
1411             rept = (rept + 7) / 8;
1412         }
1413 
1414         if (cols[jj].datatype == 0)    /* output datatype not specified? */
1415         {
1416             /* special case if sizeof(long) = 8: use TINT instead of TLONG */
1417             if (abs(typecode) == TLONG && sizeof(long) == 8 && sizeof(int) == 4)
1418                 cols[jj].datatype = TINT;
1419             else
1420                 cols[jj].datatype = abs(typecode);
1421         }
1422 
1423         /* calc total number of elements to do on each iteration */
1424         if (hdutype == IMAGE_HDU || cols[jj].datatype == TSTRING)
1425         {
1426             ntodo = n_optimum;
1427             cols[jj].repeat = 1;
1428 
1429             /* get the BLANK keyword value, if it exists */
1430             if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1431                 || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1432             {
1433                 tstatus = 0;
1434                 ffgkyj(cols[jj].fptr, "BLANK", &tnull, 0, &tstatus);
1435                 if (tstatus)
1436                 {
1437                     tnull = 0L;  /* no null values */
1438                 }
1439             }
1440         }
1441         else
1442         {
1443 	    if (typecode < 0)
1444 	    {
1445               /* get max size of the variable length vector; dont't trust the value
1446 	         given by the TFORM keyword  */
1447 	      rept = 1;
1448 	      for (ii = 0; ii < totaln; ii++) {
1449 		ffgdes(cols[jj].fptr, cols[jj].colnum, frow + ii, &rowrept, NULL, status);
1450 
1451 		rept = maxvalue(rept, rowrept);
1452 	      }
1453             }
1454 
1455             ntodo = n_optimum * rept;   /* vector columns */
1456             cols[jj].repeat = rept;
1457 
1458             /* get the TNULL keyword value, if it exists */
1459             if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1460                 || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1461             {
1462                 tstatus = 0;
1463                 if (hdutype == ASCII_TBL) /* TNULLn value is a string */
1464                 {
1465                     ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus);
1466                     ffgkys(cols[jj].fptr, keyname, nullstr, 0, &tstatus);
1467                     if (tstatus)
1468                     {
1469                         tnull = 0L; /* keyword doesn't exist; no null values */
1470                     }
1471                     else
1472                     {
1473                         cptr = nullstr;
1474                         while (*cptr == ' ')  /* skip over leading blanks */
1475                            cptr++;
1476 
1477                         if (*cptr == '\0')  /* TNULLn is all blanks? */
1478                             tnull = LONG_MIN;
1479                         else
1480                         {
1481                             /* attempt to read TNULLn string as an integer */
1482                             ffc2ii(nullstr, &tnull, &tstatus);
1483 
1484                             if (tstatus)
1485                                 tnull = LONG_MIN;  /* choose smallest value */
1486                         }                          /* to represent nulls */
1487                     }
1488                 }
1489                 else  /* Binary table; TNULLn value is an integer */
1490                 {
1491                     ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus);
1492                     ffgkyj(cols[jj].fptr, keyname, &tnull, 0, &tstatus);
1493                     if (tstatus)
1494                     {
1495                         tnull = 0L; /* keyword doesn't exist; no null values */
1496                     }
1497                     else if (tnull == 0)
1498                     {
1499                         /* worst possible case: a value of 0 is used to   */
1500                         /* represent nulls in the FITS file.  We have to  */
1501                         /* use a non-zero null value here (zero is used to */
1502                         /* mean there are no null values in the array) so we */
1503                         /* will use the smallest possible integer instead. */
1504 
1505                         tnull = LONG_MIN;  /* choose smallest possible value */
1506                     }
1507                 }
1508             }
1509         }
1510 
1511         /* Note that the data array starts with 2nd element;  */
1512         /* 1st element of the array gives the null data value */
1513 
1514         switch (cols[jj].datatype)
1515         {
1516          case TBYTE:
1517           cols[jj].array = calloc(ntodo + 1, sizeof(char));
1518           col[jj].nullsize  = sizeof(char);  /* number of bytes per value */
1519 
1520           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1521               || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1522           {
1523               tnull = minvalue(tnull, 255);
1524               tnull = maxvalue(tnull, 0);
1525               col[jj].null.charnull = (unsigned char) tnull;
1526           }
1527           else
1528           {
1529               col[jj].null.charnull = (unsigned char) 255; /* use 255 as null */
1530           }
1531           break;
1532 
1533          case TSBYTE:
1534           cols[jj].array = calloc(ntodo + 1, sizeof(char));
1535           col[jj].nullsize  = sizeof(char);  /* number of bytes per value */
1536 
1537           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1538               || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1539           {
1540               tnull = minvalue(tnull, 127);
1541               tnull = maxvalue(tnull, -128);
1542               col[jj].null.scharnull = (signed char) tnull;
1543           }
1544           else
1545           {
1546               col[jj].null.scharnull = (signed char) -128; /* use -128  null */
1547           }
1548           break;
1549 
1550          case TSHORT:
1551           cols[jj].array = calloc(ntodo + 1, sizeof(short));
1552           col[jj].nullsize  = sizeof(short);  /* number of bytes per value */
1553 
1554           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1555               || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1556           {
1557               tnull = minvalue(tnull, SHRT_MAX);
1558               tnull = maxvalue(tnull, SHRT_MIN);
1559               col[jj].null.shortnull = (short) tnull;
1560           }
1561           else
1562           {
1563               col[jj].null.shortnull = SHRT_MIN;  /* use minimum as null */
1564           }
1565           break;
1566 
1567          case TUSHORT:
1568           cols[jj].array = calloc(ntodo + 1, sizeof(unsigned short));
1569           col[jj].nullsize  = sizeof(unsigned short);  /* bytes per value */
1570 
1571           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1572                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1573           {
1574               tnull = minvalue(tnull, (long) USHRT_MAX);
1575               tnull = maxvalue(tnull, 0);  /* don't allow negative value */
1576               col[jj].null.ushortnull = (unsigned short) tnull;
1577           }
1578           else
1579           {
1580               col[jj].null.ushortnull = USHRT_MAX;   /* use maximum null */
1581           }
1582           break;
1583 
1584          case TINT:
1585           cols[jj].array = calloc(sizeof(int), ntodo + 1);
1586           col[jj].nullsize  = sizeof(int);  /* number of bytes per value */
1587 
1588           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1589                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1590           {
1591               tnull = minvalue(tnull, INT_MAX);
1592               tnull = maxvalue(tnull, INT_MIN);
1593               col[jj].null.intnull = (int) tnull;
1594           }
1595           else
1596           {
1597               col[jj].null.intnull = INT_MIN;  /* use minimum as null */
1598           }
1599           break;
1600 
1601          case TUINT:
1602           cols[jj].array = calloc(ntodo + 1, sizeof(unsigned int));
1603           col[jj].nullsize  = sizeof(unsigned int);  /* bytes per value */
1604 
1605           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1606                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1607           {
1608               tnull = minvalue(tnull, INT32_MAX);
1609               tnull = maxvalue(tnull, 0);
1610               col[jj].null.uintnull = (unsigned int) tnull;
1611           }
1612           else
1613           {
1614               col[jj].null.uintnull = UINT_MAX;  /* use maximum as null */
1615           }
1616           break;
1617 
1618          case TLONG:
1619           cols[jj].array = calloc(ntodo + 1, sizeof(long));
1620           col[jj].nullsize  = sizeof(long);  /* number of bytes per value */
1621 
1622           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1623                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1624           {
1625               col[jj].null.longnull = tnull;
1626           }
1627           else
1628           {
1629               col[jj].null.longnull = LONG_MIN;   /* use minimum as null */
1630           }
1631           break;
1632 
1633          case TULONG:
1634           cols[jj].array = calloc(ntodo + 1, sizeof(unsigned long));
1635           col[jj].nullsize  = sizeof(unsigned long);  /* bytes per value */
1636 
1637           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1638                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1639           {
1640               if (tnull < 0)  /* can't use a negative null value */
1641                   col[jj].null.ulongnull = LONG_MAX;
1642               else
1643                   col[jj].null.ulongnull = (unsigned long) tnull;
1644           }
1645           else
1646           {
1647               col[jj].null.ulongnull = LONG_MAX;   /* use maximum as null */
1648           }
1649           break;
1650 
1651          case TFLOAT:
1652           cols[jj].array = calloc(ntodo + 1, sizeof(float));
1653           col[jj].nullsize  = sizeof(float);  /* number of bytes per value */
1654 
1655           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1656                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1657           {
1658               col[jj].null.floatnull = (float) tnull;
1659           }
1660           else
1661           {
1662               col[jj].null.floatnull = FLOATNULLVALUE;  /* special value */
1663           }
1664           break;
1665 
1666          case TCOMPLEX:
1667           cols[jj].array = calloc((ntodo * 2) + 1, sizeof(float));
1668           col[jj].nullsize  = sizeof(float);  /* number of bytes per value */
1669           col[jj].null.floatnull = FLOATNULLVALUE;  /* special value */
1670           break;
1671 
1672          case TDOUBLE:
1673           cols[jj].array = calloc(ntodo + 1, sizeof(double));
1674           col[jj].nullsize  = sizeof(double);  /* number of bytes per value */
1675 
1676           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1677                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1678           {
1679               col[jj].null.doublenull = (double) tnull;
1680           }
1681           else
1682           {
1683               col[jj].null.doublenull = DOUBLENULLVALUE;  /* special value */
1684           }
1685           break;
1686 
1687          case TDBLCOMPLEX:
1688           cols[jj].array = calloc((ntodo * 2) + 1, sizeof(double));
1689           col[jj].nullsize  = sizeof(double);  /* number of bytes per value */
1690           col[jj].null.doublenull = DOUBLENULLVALUE;  /* special value */
1691           break;
1692 
1693          case TSTRING:
1694           /* allocate array of pointers to all the strings  */
1695 	  if( hdutype==ASCII_TBL ) rept = width;
1696           stringptr = calloc((ntodo + 1) , sizeof(stringptr));
1697           cols[jj].array = stringptr;
1698           col[jj].nullsize  = rept + 1;  /* number of bytes per value */
1699 
1700           if (stringptr)
1701           {
1702             /* allocate string to store the null string value */
1703             col[jj].null.stringnull = calloc(rept + 1, sizeof(char) );
1704             col[jj].null.stringnull[1] = 1; /* to make sure string != 0 */
1705 
1706             /* allocate big block for the array of table column strings */
1707             stringptr[0] = calloc((ntodo + 1) * (rept + 1), sizeof(char) );
1708 
1709             if (stringptr[0])
1710             {
1711               for (ii = 1; ii <= ntodo; ii++)
1712               {   /* pointer to each string */
1713                 stringptr[ii] = stringptr[ii - 1] + (rept + 1);
1714               }
1715 
1716               /* get the TNULL keyword value, if it exists */
1717               tstatus = 0;
1718               ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus);
1719               ffgkys(cols[jj].fptr, keyname, nullstr, 0, &tstatus);
1720               if (!tstatus)
1721                   strncat(col[jj].null.stringnull, nullstr, rept);
1722             }
1723             else
1724             {
1725               ffpmsg("ffiter failed to allocate memory arrays");
1726               *status = MEMORY_ALLOCATION;  /* memory allocation failed */
1727               goto cleanup;
1728             }
1729           }
1730           break;
1731 
1732          case TLOGICAL:
1733 
1734           cols[jj].array = calloc(ntodo + 1, sizeof(char));
1735           col[jj].nullsize  = sizeof(char);  /* number of bytes per value */
1736 
1737           /* use value = 2 to flag null values in logical columns */
1738           col[jj].null.charnull = 2;
1739           break;
1740 
1741          case TLONGLONG:
1742           cols[jj].array = calloc(ntodo + 1, sizeof(LONGLONG));
1743           col[jj].nullsize  = sizeof(LONGLONG);  /* number of bytes per value */
1744 
1745           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG ||
1746 	      abs(typecode) == TLONGLONG || abs(typecode) == TINT)
1747           {
1748               col[jj].null.longlongnull = tnull;
1749           }
1750           else
1751           {
1752               col[jj].null.longlongnull = LONGLONG_MIN;   /* use minimum as null */
1753           }
1754           break;
1755 
1756          default:
1757           snprintf(message,FLEN_ERRMSG,
1758                   "Column %d datatype currently not supported: %d:  (ffiter)",
1759                    jj + 1, cols[jj].datatype);
1760           ffpmsg(message);
1761           *status = BAD_DATATYPE;
1762           goto cleanup;
1763 
1764         }   /* end of switch block */
1765 
1766         /* check that all the arrays were allocated successfully */
1767         if (!cols[jj].array)
1768         {
1769             ffpmsg("ffiter failed to allocate memory arrays");
1770             *status = MEMORY_ALLOCATION;  /* memory allocation failed */
1771             goto cleanup;
1772         }
1773     }
1774 
1775     /*--------------------------------------------------*/
1776     /* main loop while there are values left to process */
1777     /*--------------------------------------------------*/
1778 
1779     nleft = totaln;
1780 
1781     while (nleft)
1782     {
1783       ntodo = minvalue(nleft, n_optimum); /* no. of values for this loop */
1784 
1785       /*  read input columns from FITS file(s)  */
1786       for (jj = 0; jj < n_cols; jj++)
1787       {
1788         if (cols[jj].iotype != OutputCol)
1789         {
1790           if (cols[jj].datatype == TSTRING)
1791           {
1792             stringptr = cols[jj].array;
1793             dataptr = stringptr + 1;
1794             defaultnull = col[jj].null.stringnull; /* ptr to the null value */
1795           }
1796           else
1797           {
1798             dataptr = (char *) cols[jj].array + col[jj].nullsize;
1799             defaultnull = &col[jj].null.charnull; /* ptr to the null value */
1800           }
1801 
1802           if (hdutype == IMAGE_HDU)
1803           {
1804               if (ffgpv(cols[jj].fptr, cols[jj].datatype,
1805                     felement, cols[jj].repeat * ntodo, defaultnull,
1806                     dataptr,  &anynul, status) > 0)
1807               {
1808                  break;
1809               }
1810           }
1811           else
1812           {
1813 	      if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0)
1814 	          goto cleanup;
1815 
1816 	      if (typecode<0)
1817 	      {
1818 	        /* get size of the variable length vector */
1819 		ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status);
1820 	      }
1821 
1822               if (ffgcv(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum,
1823                     frow, felement, cols[jj].repeat * ntodo, defaultnull,
1824                     dataptr,  &anynul, status) > 0)
1825               {
1826                  break;
1827               }
1828           }
1829 
1830           /* copy the appropriate null value into first array element */
1831 
1832           if (anynul)   /* are there any nulls in the data? */
1833           {
1834             if (cols[jj].datatype == TSTRING)
1835             {
1836               stringptr = cols[jj].array;
1837               memcpy(*stringptr, col[jj].null.stringnull, col[jj].nullsize);
1838             }
1839             else
1840             {
1841               memcpy(cols[jj].array, defaultnull, col[jj].nullsize);
1842             }
1843           }
1844           else /* no null values so copy zero into first element */
1845           {
1846             if (cols[jj].datatype == TSTRING)
1847             {
1848               stringptr = cols[jj].array;
1849               memset(*stringptr, 0, col[jj].nullsize);
1850             }
1851             else
1852             {
1853               memset(cols[jj].array, 0, col[jj].nullsize);
1854             }
1855           }
1856         }
1857       }
1858 
1859       if (*status > 0)
1860          break;   /* looks like an error occurred; quit immediately */
1861 
1862       /* call work function */
1863 
1864       if (hdutype == IMAGE_HDU)
1865           *status = work_fn(totaln, offset, felement, ntodo, n_cols, cols,
1866                     userPointer);
1867       else
1868           *status = work_fn(totaln, offset, frow, ntodo, n_cols, cols,
1869                     userPointer);
1870 
1871       if (*status > 0 || *status < -1 )
1872          break;   /* looks like an error occurred; quit immediately */
1873 
1874       /*  write output columns  before quiting if status = -1 */
1875       tstatus = 0;
1876       for (jj = 0; jj < n_cols; jj++)
1877       {
1878         if (cols[jj].iotype != InputCol)
1879         {
1880           if (cols[jj].datatype == TSTRING)
1881           {
1882             stringptr = cols[jj].array;
1883             dataptr = stringptr + 1;
1884             nullptr = *stringptr;
1885             nbytes = 2;
1886           }
1887           else
1888           {
1889             dataptr = (char *) cols[jj].array + col[jj].nullsize;
1890             nullptr = (char *) cols[jj].array;
1891             nbytes = col[jj].nullsize;
1892           }
1893 
1894           if (memcmp(nullptr, &zeros, nbytes) )
1895           {
1896             /* null value flag not zero; must check for and write nulls */
1897             if (hdutype == IMAGE_HDU)
1898             {
1899                 if (ffppn(cols[jj].fptr, cols[jj].datatype,
1900                       felement, cols[jj].repeat * ntodo, dataptr,
1901                       nullptr, &tstatus) > 0)
1902                 break;
1903             }
1904             else
1905             {
1906 	    	if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0)
1907 		    goto cleanup;
1908 
1909 		if (typecode<0)  /* variable length array colum */
1910 		{
1911 		   ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status);
1912 		}
1913 
1914                 if (ffpcn(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum, frow,
1915                       felement, cols[jj].repeat * ntodo, dataptr,
1916                       nullptr, &tstatus) > 0)
1917                 break;
1918             }
1919           }
1920           else
1921           {
1922             /* no null values; just write the array */
1923             if (hdutype == IMAGE_HDU)
1924             {
1925                 if (ffppr(cols[jj].fptr, cols[jj].datatype,
1926                       felement, cols[jj].repeat * ntodo, dataptr,
1927                       &tstatus) > 0)
1928                 break;
1929             }
1930             else
1931             {
1932 	    	if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0)
1933 		    goto cleanup;
1934 
1935 		if (typecode<0)  /* variable length array column */
1936 		{
1937 		   ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status);
1938 		}
1939 
1940                  if (ffpcl(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum, frow,
1941                       felement, cols[jj].repeat * ntodo, dataptr,
1942                       &tstatus) > 0)
1943                 break;
1944             }
1945           }
1946         }
1947       }
1948 
1949       if (*status == 0)
1950          *status = tstatus;   /* propagate any error status from the writes */
1951 
1952       if (*status)
1953          break;   /* exit on any error */
1954 
1955       nleft -= ntodo;
1956 
1957       if (hdutype == IMAGE_HDU)
1958           felement += ntodo;
1959       else
1960           frow  += ntodo;
1961     }
1962 
1963 cleanup:
1964 
1965     /*----------------------------------*/
1966     /* free work arrays for the columns */
1967     /*----------------------------------*/
1968 
1969     for (jj = 0; jj < n_cols; jj++)
1970     {
1971         if (cols[jj].datatype == TSTRING)
1972         {
1973             if (cols[jj].array)
1974             {
1975                 stringptr = cols[jj].array;
1976                 free(*stringptr);     /* free the block of strings */
1977                 free(col[jj].null.stringnull); /* free the null string */
1978             }
1979         }
1980         if (cols[jj].array)
1981             free(cols[jj].array); /* memory for the array of values from the col */
1982     }
1983     free(col);   /* the structure containing the null values */
1984     return(*status);
1985 }
1986 
1987