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=0, 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             /* handle special case of a 0-width string column */
1429             if (hdutype == BINARY_TBL && rept == 0)
1430                cols[jj].repeat = 0;
1431 
1432             /* get the BLANK keyword value, if it exists */
1433             if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1434                 || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1435             {
1436                 tstatus = 0;
1437                 ffgkyj(cols[jj].fptr, "BLANK", &tnull, 0, &tstatus);
1438                 if (tstatus)
1439                 {
1440                     tnull = 0L;  /* no null values */
1441                 }
1442             }
1443         }
1444         else
1445         {
1446 	    if (typecode < 0)
1447 	    {
1448               /* get max size of the variable length vector; dont't trust the value
1449 	         given by the TFORM keyword  */
1450 	      rept = 1;
1451 	      for (ii = 0; ii < totaln; ii++) {
1452 		ffgdes(cols[jj].fptr, cols[jj].colnum, frow + ii, &rowrept, NULL, status);
1453 
1454 		rept = maxvalue(rept, rowrept);
1455 	      }
1456             }
1457 
1458             ntodo = n_optimum * rept;   /* vector columns */
1459             cols[jj].repeat = rept;
1460 
1461             /* get the TNULL keyword value, if it exists */
1462             if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1463                 || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1464             {
1465                 tstatus = 0;
1466                 if (hdutype == ASCII_TBL) /* TNULLn value is a string */
1467                 {
1468                     ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus);
1469                     ffgkys(cols[jj].fptr, keyname, nullstr, 0, &tstatus);
1470                     if (tstatus)
1471                     {
1472                         tnull = 0L; /* keyword doesn't exist; no null values */
1473                     }
1474                     else
1475                     {
1476                         cptr = nullstr;
1477                         while (*cptr == ' ')  /* skip over leading blanks */
1478                            cptr++;
1479 
1480                         if (*cptr == '\0')  /* TNULLn is all blanks? */
1481                             tnull = LONG_MIN;
1482                         else
1483                         {
1484                             /* attempt to read TNULLn string as an integer */
1485                             ffc2ii(nullstr, &tnull, &tstatus);
1486 
1487                             if (tstatus)
1488                                 tnull = LONG_MIN;  /* choose smallest value */
1489                         }                          /* to represent nulls */
1490                     }
1491                 }
1492                 else  /* Binary table; TNULLn value is an integer */
1493                 {
1494                     ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus);
1495                     ffgkyj(cols[jj].fptr, keyname, &tnull, 0, &tstatus);
1496                     if (tstatus)
1497                     {
1498                         tnull = 0L; /* keyword doesn't exist; no null values */
1499                     }
1500                     else if (tnull == 0)
1501                     {
1502                         /* worst possible case: a value of 0 is used to   */
1503                         /* represent nulls in the FITS file.  We have to  */
1504                         /* use a non-zero null value here (zero is used to */
1505                         /* mean there are no null values in the array) so we */
1506                         /* will use the smallest possible integer instead. */
1507 
1508                         tnull = LONG_MIN;  /* choose smallest possible value */
1509                     }
1510                 }
1511             }
1512         }
1513 
1514         /* Note that the data array starts with 2nd element;  */
1515         /* 1st element of the array gives the null data value */
1516 
1517         switch (cols[jj].datatype)
1518         {
1519          case TBYTE:
1520           cols[jj].array = calloc(ntodo + 1, sizeof(char));
1521           col[jj].nullsize  = sizeof(char);  /* number of bytes per value */
1522 
1523           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1524               || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1525           {
1526               tnull = minvalue(tnull, 255);
1527               tnull = maxvalue(tnull, 0);
1528               col[jj].null.charnull = (unsigned char) tnull;
1529           }
1530           else
1531           {
1532               col[jj].null.charnull = (unsigned char) 255; /* use 255 as null */
1533           }
1534           break;
1535 
1536          case TSBYTE:
1537           cols[jj].array = calloc(ntodo + 1, sizeof(char));
1538           col[jj].nullsize  = sizeof(char);  /* number of bytes per value */
1539 
1540           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1541               || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1542           {
1543               tnull = minvalue(tnull, 127);
1544               tnull = maxvalue(tnull, -128);
1545               col[jj].null.scharnull = (signed char) tnull;
1546           }
1547           else
1548           {
1549               col[jj].null.scharnull = (signed char) -128; /* use -128  null */
1550           }
1551           break;
1552 
1553          case TSHORT:
1554           cols[jj].array = calloc(ntodo + 1, sizeof(short));
1555           col[jj].nullsize  = sizeof(short);  /* number of bytes per value */
1556 
1557           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1558               || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1559           {
1560               tnull = minvalue(tnull, SHRT_MAX);
1561               tnull = maxvalue(tnull, SHRT_MIN);
1562               col[jj].null.shortnull = (short) tnull;
1563           }
1564           else
1565           {
1566               col[jj].null.shortnull = SHRT_MIN;  /* use minimum as null */
1567           }
1568           break;
1569 
1570          case TUSHORT:
1571           cols[jj].array = calloc(ntodo + 1, sizeof(unsigned short));
1572           col[jj].nullsize  = sizeof(unsigned short);  /* bytes per value */
1573 
1574           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1575                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1576           {
1577               tnull = minvalue(tnull, (long) USHRT_MAX);
1578               tnull = maxvalue(tnull, 0);  /* don't allow negative value */
1579               col[jj].null.ushortnull = (unsigned short) tnull;
1580           }
1581           else
1582           {
1583               col[jj].null.ushortnull = USHRT_MAX;   /* use maximum null */
1584           }
1585           break;
1586 
1587          case TINT:
1588           cols[jj].array = calloc(sizeof(int), ntodo + 1);
1589           col[jj].nullsize  = sizeof(int);  /* number of bytes per value */
1590 
1591           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1592                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1593           {
1594               tnull = minvalue(tnull, INT_MAX);
1595               tnull = maxvalue(tnull, INT_MIN);
1596               col[jj].null.intnull = (int) tnull;
1597           }
1598           else
1599           {
1600               col[jj].null.intnull = INT_MIN;  /* use minimum as null */
1601           }
1602           break;
1603 
1604          case TUINT:
1605           cols[jj].array = calloc(ntodo + 1, sizeof(unsigned int));
1606           col[jj].nullsize  = sizeof(unsigned int);  /* bytes per value */
1607 
1608           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1609                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1610           {
1611               tnull = minvalue(tnull, INT32_MAX);
1612               tnull = maxvalue(tnull, 0);
1613               col[jj].null.uintnull = (unsigned int) tnull;
1614           }
1615           else
1616           {
1617               col[jj].null.uintnull = UINT_MAX;  /* use maximum as null */
1618           }
1619           break;
1620 
1621          case TLONG:
1622           cols[jj].array = calloc(ntodo + 1, sizeof(long));
1623           col[jj].nullsize  = sizeof(long);  /* number of bytes per value */
1624 
1625           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1626                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1627           {
1628               col[jj].null.longnull = tnull;
1629           }
1630           else
1631           {
1632               col[jj].null.longnull = LONG_MIN;   /* use minimum as null */
1633           }
1634           break;
1635 
1636          case TULONG:
1637           cols[jj].array = calloc(ntodo + 1, sizeof(unsigned long));
1638           col[jj].nullsize  = sizeof(unsigned long);  /* bytes per value */
1639 
1640           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1641                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1642           {
1643               if (tnull < 0)  /* can't use a negative null value */
1644                   col[jj].null.ulongnull = LONG_MAX;
1645               else
1646                   col[jj].null.ulongnull = (unsigned long) tnull;
1647           }
1648           else
1649           {
1650               col[jj].null.ulongnull = LONG_MAX;   /* use maximum as null */
1651           }
1652           break;
1653 
1654          case TFLOAT:
1655           cols[jj].array = calloc(ntodo + 1, sizeof(float));
1656           col[jj].nullsize  = sizeof(float);  /* number of bytes per value */
1657 
1658           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1659                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1660           {
1661               col[jj].null.floatnull = (float) tnull;
1662           }
1663           else
1664           {
1665               col[jj].null.floatnull = FLOATNULLVALUE;  /* special value */
1666           }
1667           break;
1668 
1669          case TCOMPLEX:
1670           cols[jj].array = calloc((ntodo * 2) + 1, sizeof(float));
1671           col[jj].nullsize  = sizeof(float);  /* number of bytes per value */
1672           col[jj].null.floatnull = FLOATNULLVALUE;  /* special value */
1673           break;
1674 
1675          case TDOUBLE:
1676           cols[jj].array = calloc(ntodo + 1, sizeof(double));
1677           col[jj].nullsize  = sizeof(double);  /* number of bytes per value */
1678 
1679           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG
1680                || abs(typecode) == TINT || abs(typecode) == TLONGLONG)
1681           {
1682               col[jj].null.doublenull = (double) tnull;
1683           }
1684           else
1685           {
1686               col[jj].null.doublenull = DOUBLENULLVALUE;  /* special value */
1687           }
1688           break;
1689 
1690          case TDBLCOMPLEX:
1691           cols[jj].array = calloc((ntodo * 2) + 1, sizeof(double));
1692           col[jj].nullsize  = sizeof(double);  /* number of bytes per value */
1693           col[jj].null.doublenull = DOUBLENULLVALUE;  /* special value */
1694           break;
1695 
1696          case TSTRING:
1697           /* allocate array of pointers to all the strings  */
1698 	  if( hdutype==ASCII_TBL ) rept = width;
1699           stringptr = calloc((ntodo + 1) , sizeof(stringptr));
1700           cols[jj].array = stringptr;
1701           col[jj].nullsize  = rept + 1;  /* number of bytes per value */
1702 
1703           if (stringptr)
1704           {
1705             /* allocate string to store the null string value */
1706             col[jj].null.stringnull = calloc(rept + 1, sizeof(char) );
1707             if (rept > 0)
1708                col[jj].null.stringnull[1] = 1; /* to make sure string != 0 */
1709 
1710             /* allocate big block for the array of table column strings */
1711             stringptr[0] = calloc((ntodo + 1) * (rept + 1), sizeof(char) );
1712 
1713             if (stringptr[0])
1714             {
1715               for (ii = 1; ii <= ntodo; ii++)
1716               {   /* pointer to each string */
1717                 stringptr[ii] = stringptr[ii - 1] + (rept + 1);
1718               }
1719 
1720               /* get the TNULL keyword value, if it exists */
1721               tstatus = 0;
1722               ffkeyn("TNULL", cols[jj].colnum, keyname, &tstatus);
1723               ffgkys(cols[jj].fptr, keyname, nullstr, 0, &tstatus);
1724               if (!tstatus)
1725                   strncat(col[jj].null.stringnull, nullstr, rept);
1726             }
1727             else
1728             {
1729               ffpmsg("ffiter failed to allocate memory arrays");
1730               *status = MEMORY_ALLOCATION;  /* memory allocation failed */
1731               goto cleanup;
1732             }
1733           }
1734           break;
1735 
1736          case TLOGICAL:
1737 
1738           cols[jj].array = calloc(ntodo + 1, sizeof(char));
1739           col[jj].nullsize  = sizeof(char);  /* number of bytes per value */
1740 
1741           /* use value = 2 to flag null values in logical columns */
1742           col[jj].null.charnull = 2;
1743           break;
1744 
1745          case TLONGLONG:
1746           cols[jj].array = calloc(ntodo + 1, sizeof(LONGLONG));
1747           col[jj].nullsize  = sizeof(LONGLONG);  /* number of bytes per value */
1748 
1749           if (abs(typecode) == TBYTE || abs(typecode) == TSHORT || abs(typecode) == TLONG ||
1750 	      abs(typecode) == TLONGLONG || abs(typecode) == TINT)
1751           {
1752               col[jj].null.longlongnull = tnull;
1753           }
1754           else
1755           {
1756               col[jj].null.longlongnull = LONGLONG_MIN;   /* use minimum as null */
1757           }
1758           break;
1759 
1760          default:
1761           snprintf(message,FLEN_ERRMSG,
1762                   "Column %d datatype currently not supported: %d:  (ffiter)",
1763                    jj + 1, cols[jj].datatype);
1764           ffpmsg(message);
1765           *status = BAD_DATATYPE;
1766           goto cleanup;
1767 
1768         }   /* end of switch block */
1769 
1770         /* check that all the arrays were allocated successfully */
1771         if (!cols[jj].array)
1772         {
1773             ffpmsg("ffiter failed to allocate memory arrays");
1774             *status = MEMORY_ALLOCATION;  /* memory allocation failed */
1775             goto cleanup;
1776         }
1777     }
1778 
1779     /*--------------------------------------------------*/
1780     /* main loop while there are values left to process */
1781     /*--------------------------------------------------*/
1782 
1783     nleft = totaln;
1784 
1785     while (nleft)
1786     {
1787       ntodo = minvalue(nleft, n_optimum); /* no. of values for this loop */
1788 
1789       /*  read input columns from FITS file(s)  */
1790       for (jj = 0; jj < n_cols; jj++)
1791       {
1792         if (cols[jj].iotype != OutputCol)
1793         {
1794           if (cols[jj].datatype == TSTRING)
1795           {
1796             stringptr = cols[jj].array;
1797             dataptr = stringptr + 1;
1798             defaultnull = col[jj].null.stringnull; /* ptr to the null value */
1799           }
1800           else
1801           {
1802             dataptr = (char *) cols[jj].array + col[jj].nullsize;
1803             defaultnull = &col[jj].null.charnull; /* ptr to the null value */
1804           }
1805 
1806           if (hdutype == IMAGE_HDU)
1807           {
1808               if (ffgpv(cols[jj].fptr, cols[jj].datatype,
1809                     felement, cols[jj].repeat * ntodo, defaultnull,
1810                     dataptr,  &anynul, status) > 0)
1811               {
1812                  break;
1813               }
1814           }
1815           else
1816           {
1817 	      if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0)
1818 	          goto cleanup;
1819 
1820 	      if (typecode<0)
1821 	      {
1822 	        /* get size of the variable length vector */
1823 		ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status);
1824 	      }
1825 
1826               if (ffgcv(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum,
1827                     frow, felement, cols[jj].repeat * ntodo, defaultnull,
1828                     dataptr,  &anynul, status) > 0)
1829               {
1830                  break;
1831               }
1832           }
1833 
1834           /* copy the appropriate null value into first array element */
1835 
1836           if (anynul)   /* are there any nulls in the data? */
1837           {
1838             if (cols[jj].datatype == TSTRING)
1839             {
1840               stringptr = cols[jj].array;
1841               memcpy(*stringptr, col[jj].null.stringnull, col[jj].nullsize);
1842             }
1843             else
1844             {
1845               memcpy(cols[jj].array, defaultnull, col[jj].nullsize);
1846             }
1847           }
1848           else /* no null values so copy zero into first element */
1849           {
1850             if (cols[jj].datatype == TSTRING)
1851             {
1852               stringptr = cols[jj].array;
1853               memset(*stringptr, 0, col[jj].nullsize);
1854             }
1855             else
1856             {
1857               memset(cols[jj].array, 0, col[jj].nullsize);
1858             }
1859           }
1860         }
1861       }
1862 
1863       if (*status > 0)
1864          break;   /* looks like an error occurred; quit immediately */
1865 
1866       /* call work function */
1867 
1868       if (hdutype == IMAGE_HDU)
1869           *status = work_fn(totaln, offset, felement, ntodo, n_cols, cols,
1870                     userPointer);
1871       else
1872           *status = work_fn(totaln, offset, frow, ntodo, n_cols, cols,
1873                     userPointer);
1874 
1875       if (*status > 0 || *status < -1 )
1876          break;   /* looks like an error occurred; quit immediately */
1877 
1878       /*  write output columns  before quiting if status = -1 */
1879       tstatus = 0;
1880       for (jj = 0; jj < n_cols; jj++)
1881       {
1882         if (cols[jj].iotype != InputCol)
1883         {
1884           if (cols[jj].datatype == TSTRING)
1885           {
1886             stringptr = cols[jj].array;
1887             dataptr = stringptr + 1;
1888             nullptr = *stringptr;
1889             nbytes = 2;
1890           }
1891           else
1892           {
1893             dataptr = (char *) cols[jj].array + col[jj].nullsize;
1894             nullptr = (char *) cols[jj].array;
1895             nbytes = col[jj].nullsize;
1896           }
1897 
1898           if (memcmp(nullptr, &zeros, nbytes) )
1899           {
1900             /* null value flag not zero; must check for and write nulls */
1901             if (hdutype == IMAGE_HDU)
1902             {
1903                 if (ffppn(cols[jj].fptr, cols[jj].datatype,
1904                       felement, cols[jj].repeat * ntodo, dataptr,
1905                       nullptr, &tstatus) > 0)
1906                 break;
1907             }
1908             else
1909             {
1910 	    	if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0)
1911 		    goto cleanup;
1912 
1913 		if (typecode<0)  /* variable length array colum */
1914 		{
1915 		   ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status);
1916 		}
1917 
1918                 if (ffpcn(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum, frow,
1919                       felement, cols[jj].repeat * ntodo, dataptr,
1920                       nullptr, &tstatus) > 0)
1921                 break;
1922             }
1923           }
1924           else
1925           {
1926             /* no null values; just write the array */
1927             if (hdutype == IMAGE_HDU)
1928             {
1929                 if (ffppr(cols[jj].fptr, cols[jj].datatype,
1930                       felement, cols[jj].repeat * ntodo, dataptr,
1931                       &tstatus) > 0)
1932                 break;
1933             }
1934             else
1935             {
1936 	    	if (ffgtcl(cols[jj].fptr, cols[jj].colnum, &typecode, &rept,&width, status) > 0)
1937 		    goto cleanup;
1938 
1939 		if (typecode<0)  /* variable length array column */
1940 		{
1941 		   ffgdes(cols[jj].fptr, cols[jj].colnum, frow,&cols[jj].repeat, NULL,status);
1942 		}
1943 
1944                  if (ffpcl(cols[jj].fptr, cols[jj].datatype, cols[jj].colnum, frow,
1945                       felement, cols[jj].repeat * ntodo, dataptr,
1946                       &tstatus) > 0)
1947                 break;
1948             }
1949           }
1950         }
1951       }
1952 
1953       if (*status == 0)
1954          *status = tstatus;   /* propagate any error status from the writes */
1955 
1956       if (*status)
1957          break;   /* exit on any error */
1958 
1959       nleft -= ntodo;
1960 
1961       if (hdutype == IMAGE_HDU)
1962           felement += ntodo;
1963       else
1964           frow  += ntodo;
1965     }
1966 
1967 cleanup:
1968 
1969     /*----------------------------------*/
1970     /* free work arrays for the columns */
1971     /*----------------------------------*/
1972 
1973     for (jj = 0; jj < n_cols; jj++)
1974     {
1975         if (cols[jj].datatype == TSTRING)
1976         {
1977             if (cols[jj].array)
1978             {
1979                 stringptr = cols[jj].array;
1980                 free(*stringptr);     /* free the block of strings */
1981                 free(col[jj].null.stringnull); /* free the null string */
1982             }
1983         }
1984         if (cols[jj].array)
1985             free(cols[jj].array); /* memory for the array of values from the col */
1986     }
1987     free(col);   /* the structure containing the null values */
1988     return(*status);
1989 }
1990 
1991