1 /*  This file, editcol.c, contains the set of FITSIO routines that    */
2 /*  insert or delete rows or columns in a table or resize an image    */
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 <ctype.h>
10 #include <stdlib.h>
11 #include "fitsio2.h"
12 /*--------------------------------------------------------------------------*/
ffrsim(fitsfile * fptr,int bitpix,int naxis,long * naxes,int * status)13 int ffrsim(fitsfile *fptr,      /* I - FITS file pointer           */
14            int bitpix,          /* I - bits per pixel              */
15            int naxis,           /* I - number of axes in the array */
16            long *naxes,         /* I - size of each axis           */
17            int *status)         /* IO - error status               */
18 /*
19    resize an existing primary array or IMAGE extension.
20 */
21 {
22     LONGLONG tnaxes[99];
23     int ii;
24 
25     if (*status > 0)
26         return(*status);
27 
28     for (ii = 0; (ii < naxis) && (ii < 99); ii++)
29         tnaxes[ii] = naxes[ii];
30 
31     ffrsimll(fptr, bitpix, naxis, tnaxes, status);
32 
33     return(*status);
34 }
35 /*--------------------------------------------------------------------------*/
ffrsimll(fitsfile * fptr,int bitpix,int naxis,LONGLONG * naxes,int * status)36 int ffrsimll(fitsfile *fptr,    /* I - FITS file pointer           */
37            int bitpix,          /* I - bits per pixel              */
38            int naxis,           /* I - number of axes in the array */
39            LONGLONG *naxes,     /* I - size of each axis           */
40            int *status)         /* IO - error status               */
41 /*
42    resize an existing primary array or IMAGE extension.
43 */
44 {
45     int ii, simple, obitpix, onaxis, extend, nmodify;
46     long  nblocks, longval;
47     long pcount, gcount, longbitpix;
48     LONGLONG onaxes[99], newsize, oldsize;
49     char comment[FLEN_COMMENT], keyname[FLEN_KEYWORD], message[FLEN_ERRMSG];
50 
51     if (*status > 0)
52         return(*status);
53 
54     /* reset position to the correct HDU if necessary */
55     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
56     {
57         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
58     }
59          /* rescan header if data structure is undefined */
60     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
61         if ( ffrdef(fptr, status) > 0)
62             return(*status);
63 
64     /* get current image size parameters */
65     if (ffghprll(fptr, 99, &simple, &obitpix, &onaxis, onaxes, &pcount,
66                &gcount, &extend, status) > 0)
67         return(*status);
68 
69     longbitpix = bitpix;
70 
71     /* test for the 2 special cases that represent unsigned integers */
72     if (longbitpix == USHORT_IMG)
73         longbitpix = SHORT_IMG;
74     else if (longbitpix == ULONG_IMG)
75         longbitpix = LONG_IMG;
76 
77     /* test that the new values are legal */
78 
79     if (longbitpix != BYTE_IMG && longbitpix != SHORT_IMG &&
80         longbitpix != LONG_IMG && longbitpix != LONGLONG_IMG &&
81         longbitpix != FLOAT_IMG && longbitpix != DOUBLE_IMG)
82     {
83         snprintf(message, FLEN_ERRMSG,
84         "Illegal value for BITPIX keyword: %d", bitpix);
85         ffpmsg(message);
86         return(*status = BAD_BITPIX);
87     }
88 
89     if (naxis < 0 || naxis > 999)
90     {
91         snprintf(message, FLEN_ERRMSG,
92         "Illegal value for NAXIS keyword: %d", naxis);
93         ffpmsg(message);
94         return(*status = BAD_NAXIS);
95     }
96 
97     if (naxis == 0)
98         newsize = 0;
99     else
100         newsize = 1;
101 
102     for (ii = 0; ii < naxis; ii++)
103     {
104         if (naxes[ii] < 0)
105         {
106             snprintf(message, FLEN_ERRMSG,
107             "Illegal value for NAXIS%d keyword: %.0f", ii + 1,  (double) (naxes[ii]));
108             ffpmsg(message);
109             return(*status = BAD_NAXES);
110         }
111 
112         newsize *= naxes[ii];  /* compute new image size, in pixels */
113     }
114 
115     /* compute size of old image, in bytes */
116 
117     if (onaxis == 0)
118         oldsize = 0;
119     else
120     {
121         oldsize = 1;
122         for (ii = 0; ii < onaxis; ii++)
123             oldsize *= onaxes[ii];
124         oldsize = (oldsize + pcount) * gcount * (abs(obitpix) / 8);
125     }
126 
127     oldsize = (oldsize + 2879) / 2880; /* old size, in blocks */
128 
129     newsize = (newsize + pcount) * gcount * (abs(longbitpix) / 8);
130     newsize = (newsize + 2879) / 2880; /* new size, in blocks */
131 
132     if (newsize > oldsize)   /* have to insert new blocks for image */
133     {
134         nblocks = (long) (newsize - oldsize);
135         if (ffiblk(fptr, nblocks, 1, status) > 0)
136             return(*status);
137     }
138     else if (oldsize > newsize)  /* have to delete blocks from image */
139     {
140         nblocks = (long) (oldsize - newsize);
141         if (ffdblk(fptr, nblocks, status) > 0)
142             return(*status);
143     }
144 
145     /* now update the header keywords */
146 
147     strcpy(comment,"&");  /* special value to leave comments unchanged */
148 
149     if (longbitpix != obitpix)
150     {                         /* update BITPIX value */
151         ffmkyj(fptr, "BITPIX", longbitpix, comment, status);
152     }
153 
154     if (naxis != onaxis)
155     {                        /* update NAXIS value */
156         longval = naxis;
157         ffmkyj(fptr, "NAXIS", longval, comment, status);
158     }
159 
160     /* modify the existing NAXISn keywords */
161     nmodify = minvalue(naxis, onaxis);
162     for (ii = 0; ii < nmodify; ii++)
163     {
164         ffkeyn("NAXIS", ii+1, keyname, status);
165         ffmkyj(fptr, keyname, naxes[ii], comment, status);
166     }
167 
168     if (naxis > onaxis)  /* insert additional NAXISn keywords */
169     {
170         strcpy(comment,"length of data axis");
171         for (ii = onaxis; ii < naxis; ii++)
172         {
173             ffkeyn("NAXIS", ii+1, keyname, status);
174             ffikyj(fptr, keyname, naxes[ii], comment, status);
175         }
176     }
177     else if (onaxis > naxis) /* delete old NAXISn keywords */
178     {
179         for (ii = naxis; ii < onaxis; ii++)
180         {
181             ffkeyn("NAXIS", ii+1, keyname, status);
182             ffdkey(fptr, keyname, status);
183         }
184     }
185 
186     /* Update the BSCALE and BZERO keywords, if an unsigned integer image */
187     if (bitpix == USHORT_IMG)
188     {
189         strcpy(comment, "offset data range to that of unsigned short");
190         ffukyg(fptr, "BZERO", 32768., 0, comment, status);
191         strcpy(comment, "default scaling factor");
192         ffukyg(fptr, "BSCALE", 1.0, 0, comment, status);
193     }
194     else if (bitpix == ULONG_IMG)
195     {
196         strcpy(comment, "offset data range to that of unsigned long");
197         ffukyg(fptr, "BZERO", 2147483648., 0, comment, status);
198         strcpy(comment, "default scaling factor");
199         ffukyg(fptr, "BSCALE", 1.0, 0, comment, status);
200     }
201 
202     /* re-read the header, to make sure structures are updated */
203     ffrdef(fptr, status);
204     return(*status);
205 }
206 /*--------------------------------------------------------------------------*/
ffirow(fitsfile * fptr,LONGLONG firstrow,LONGLONG nrows,int * status)207 int ffirow(fitsfile *fptr,  /* I - FITS file pointer                        */
208            LONGLONG firstrow,   /* I - insert space AFTER this row              */
209                             /*     0 = insert space at beginning of table   */
210            LONGLONG nrows,      /* I - number of rows to insert                 */
211            int *status)     /* IO - error status                            */
212 /*
213  insert NROWS blank rows immediated after row firstrow (1 = first row).
214  Set firstrow = 0 to insert space at the beginning of the table.
215 */
216 {
217     int tstatus;
218     LONGLONG naxis1, naxis2;
219     LONGLONG datasize, firstbyte, nshift, nbytes;
220     LONGLONG freespace;
221     long nblock;
222 
223     if (*status > 0)
224         return(*status);
225 
226         /* reset position to the correct HDU if necessary */
227     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
228     {
229         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
230     }
231          /* rescan header if data structure is undefined */
232     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
233         if ( ffrdef(fptr, status) > 0)
234             return(*status);
235 
236     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
237     {
238         ffpmsg("Can only add rows to TABLE or BINTABLE extension (ffirow)");
239         return(*status = NOT_TABLE);
240     }
241 
242     if (nrows < 0 )
243         return(*status = NEG_BYTES);
244     else if (nrows == 0)
245         return(*status);   /* no op, so just return */
246 
247     /* get the current size of the table */
248     /* use internal structure since NAXIS2 keyword may not be up to date */
249     naxis1 = (fptr->Fptr)->rowlength;
250     naxis2 = (fptr->Fptr)->numrows;
251 
252     if (firstrow > naxis2)
253     {
254         ffpmsg(
255    "Insert position greater than the number of rows in the table (ffirow)");
256         return(*status = BAD_ROW_NUM);
257     }
258     else if (firstrow < 0)
259     {
260         ffpmsg("Insert position is less than 0 (ffirow)");
261         return(*status = BAD_ROW_NUM);
262     }
263 
264     /* current data size */
265     datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
266     freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize;
267     nshift = naxis1 * nrows;          /* no. of bytes to add to table */
268 
269     if ( (freespace - nshift) < 0)   /* not enough existing space? */
270     {
271         nblock = (long) ((nshift - freespace + 2879) / 2880);   /* number of blocks */
272         ffiblk(fptr, nblock, 1, status);               /* insert the blocks */
273     }
274 
275     firstbyte = naxis1 * firstrow;    /* relative insert position */
276     nbytes = datasize - firstbyte;           /* no. of bytes to shift down */
277     firstbyte += ((fptr->Fptr)->datastart);  /* absolute insert position */
278 
279     ffshft(fptr, firstbyte, nbytes, nshift, status); /* shift rows and heap */
280 
281     /* update the heap starting address */
282     (fptr->Fptr)->heapstart += nshift;
283 
284     /* update the THEAP keyword if it exists */
285     tstatus = 0;
286     ffmkyj(fptr, "THEAP", (fptr->Fptr)->heapstart, "&", &tstatus);
287 
288     /* update the NAXIS2 keyword */
289     ffmkyj(fptr, "NAXIS2", naxis2 + nrows, "&", status);
290     ((fptr->Fptr)->numrows) += nrows;
291     ((fptr->Fptr)->origrows) += nrows;
292 
293     return(*status);
294 }
295 /*--------------------------------------------------------------------------*/
ffdrow(fitsfile * fptr,LONGLONG firstrow,LONGLONG nrows,int * status)296 int ffdrow(fitsfile *fptr,  /* I - FITS file pointer                        */
297            LONGLONG firstrow,   /* I - first row to delete (1 = first)          */
298            LONGLONG nrows,      /* I - number of rows to delete                 */
299            int *status)     /* IO - error status                            */
300 /*
301  delete NROWS rows from table starting with firstrow (1 = first row of table).
302 */
303 {
304     int tstatus;
305     LONGLONG naxis1, naxis2;
306     LONGLONG datasize, firstbyte, nbytes, nshift;
307     LONGLONG freespace;
308     long nblock;
309     char comm[FLEN_COMMENT];
310 
311     if (*status > 0)
312         return(*status);
313 
314     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
315     {
316         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
317     }
318         /* rescan header if data structure is undefined */
319     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
320         if ( ffrdef(fptr, status) > 0)
321             return(*status);
322 
323     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
324     {
325         ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrow)");
326         return(*status = NOT_TABLE);
327     }
328 
329     if (nrows < 0 )
330         return(*status = NEG_BYTES);
331     else if (nrows == 0)
332         return(*status);   /* no op, so just return */
333 
334     ffgkyjj(fptr, "NAXIS1", &naxis1, comm, status); /* get the current   */
335 
336    /* ffgkyj(fptr, "NAXIS2", &naxis2, comm, status);*/ /* size of the table */
337 
338     /* the NAXIS2 keyword may not be up to date, so use the structure value */
339     naxis2 = (fptr->Fptr)->numrows;
340 
341     if (firstrow > naxis2)
342     {
343         ffpmsg(
344    "Delete position greater than the number of rows in the table (ffdrow)");
345         return(*status = BAD_ROW_NUM);
346     }
347     else if (firstrow < 1)
348     {
349         ffpmsg("Delete position is less than 1 (ffdrow)");
350         return(*status = BAD_ROW_NUM);
351     }
352     else if (firstrow + nrows - 1 > naxis2)
353     {
354         ffpmsg("No. of rows to delete exceeds size of table (ffdrow)");
355         return(*status = BAD_ROW_NUM);
356     }
357 
358     nshift = naxis1 * nrows;   /* no. of bytes to delete from table */
359     /* cur size of data */
360     datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
361 
362     firstbyte = naxis1 * (firstrow + nrows - 1); /* relative del pos */
363     nbytes = datasize - firstbyte;    /* no. of bytes to shift up */
364     firstbyte += ((fptr->Fptr)->datastart);   /* absolute delete position */
365 
366     ffshft(fptr, firstbyte, nbytes,  nshift * (-1), status); /* shift data */
367 
368     freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize;
369     nblock = (long) ((nshift + freespace) / 2880);   /* number of blocks */
370 
371     /* delete integral number blocks */
372     if (nblock > 0)
373         ffdblk(fptr, nblock, status);
374 
375     /* update the heap starting address */
376     (fptr->Fptr)->heapstart -= nshift;
377 
378     /* update the THEAP keyword if it exists */
379     tstatus = 0;
380     ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus);
381 
382     /* update the NAXIS2 keyword */
383     ffmkyj(fptr, "NAXIS2", naxis2 - nrows, "&", status);
384     ((fptr->Fptr)->numrows) -= nrows;
385     ((fptr->Fptr)->origrows) -= nrows;
386 
387     /* Update the heap data, if any.  This will remove any orphaned data */
388     /* that was only pointed to by the rows that have been deleted */
389     ffcmph(fptr, status);
390     return(*status);
391 }
392 /*--------------------------------------------------------------------------*/
ffdrrg(fitsfile * fptr,char * ranges,int * status)393 int ffdrrg(fitsfile *fptr,  /* I - FITS file pointer to table               */
394            char *ranges,    /* I - ranges of rows to delete (1 = first)     */
395            int *status)     /* IO - error status                            */
396 /*
397  delete the ranges of rows from the table (1 = first row of table).
398 
399 The 'ranges' parameter typically looks like:
400     '10-20, 30 - 40, 55' or '50-'
401 and gives a list of rows or row ranges separated by commas.
402 */
403 {
404     char *cptr;
405     int nranges, nranges2, ii;
406     long *minrow, *maxrow, nrows, *rowarray, jj, kk;
407     LONGLONG naxis2;
408 
409     if (*status > 0)
410         return(*status);
411 
412     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
413     {
414         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
415     }
416         /* rescan header if data structure is undefined */
417     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
418         if ( ffrdef(fptr, status) > 0)
419             return(*status);
420 
421     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
422     {
423         ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrrg)");
424         return(*status = NOT_TABLE);
425     }
426 
427     /* the NAXIS2 keyword may not be up to date, so use the structure value */
428     naxis2 = (fptr->Fptr)->numrows;
429 
430     /* find how many ranges were specified ( = no. of commas in string + 1) */
431     cptr = ranges;
432     for (nranges = 1; (cptr = strchr(cptr, ',')); nranges++)
433         cptr++;
434 
435     minrow = calloc(nranges, sizeof(long));
436     maxrow = calloc(nranges, sizeof(long));
437 
438     if (!minrow || !maxrow) {
439         *status = MEMORY_ALLOCATION;
440         ffpmsg("failed to allocate memory for row ranges (ffdrrg)");
441         if (maxrow) free(maxrow);
442         if (minrow) free(minrow);
443         return(*status);
444     }
445 
446     /* parse range list into array of range min and max values */
447     ffrwrg(ranges, naxis2, nranges, &nranges2, minrow, maxrow, status);
448     if (*status > 0 || nranges2 == 0) {
449         free(maxrow);
450         free(minrow);
451         return(*status);
452     }
453 
454     /* determine total number or rows to delete */
455     nrows = 0;
456     for (ii = 0; ii < nranges2; ii++) {
457        nrows = nrows + maxrow[ii] - minrow[ii] + 1;
458     }
459 
460     rowarray = calloc(nrows, sizeof(long));
461     if (!rowarray) {
462         *status = MEMORY_ALLOCATION;
463         ffpmsg("failed to allocate memory for row array (ffdrrg)");
464         return(*status);
465     }
466 
467     for (kk = 0, ii = 0; ii < nranges2; ii++) {
468        for (jj = minrow[ii]; jj <= maxrow[ii]; jj++) {
469            rowarray[kk] = jj;
470            kk++;
471        }
472     }
473 
474     /* delete the rows */
475     ffdrws(fptr, rowarray, nrows, status);
476 
477     free(rowarray);
478     free(maxrow);
479     free(minrow);
480     return(*status);
481 }
482 /*--------------------------------------------------------------------------*/
ffdrws(fitsfile * fptr,long * rownum,long nrows,int * status)483 int ffdrws(fitsfile *fptr,  /* I - FITS file pointer                        */
484            long *rownum,    /* I - list of rows to delete (1 = first)       */
485            long nrows,      /* I - number of rows to delete                 */
486            int *status)     /* IO - error status                            */
487 /*
488  delete the list of rows from the table (1 = first row of table).
489 */
490 {
491     LONGLONG naxis1, naxis2, insertpos, nextrowpos;
492     long ii, nextrow;
493     char comm[FLEN_COMMENT];
494     unsigned char *buffer;
495 
496     if (*status > 0)
497         return(*status);
498 
499     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
500         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
501 
502     /* rescan header if data structure is undefined */
503     if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
504         if ( ffrdef(fptr, status) > 0)
505             return(*status);
506 
507     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
508     {
509         ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrws)");
510         return(*status = NOT_TABLE);
511     }
512 
513     if (nrows < 0 )
514         return(*status = NEG_BYTES);
515     else if (nrows == 0)
516         return(*status);   /* no op, so just return */
517 
518     ffgkyjj(fptr, "NAXIS1", &naxis1, comm, status); /* row width   */
519     ffgkyjj(fptr, "NAXIS2", &naxis2, comm, status); /* number of rows */
520 
521     /* check that input row list is in ascending order */
522     for (ii = 1; ii < nrows; ii++)
523     {
524         if (rownum[ii - 1] >= rownum[ii])
525         {
526             ffpmsg("row numbers are not in increasing order (ffdrws)");
527             return(*status = BAD_ROW_NUM);
528         }
529     }
530 
531     if (rownum[0] < 1)
532     {
533         ffpmsg("first row to delete is less than 1 (ffdrws)");
534         return(*status = BAD_ROW_NUM);
535     }
536     else if (rownum[nrows - 1] > naxis2)
537     {
538         ffpmsg("last row to delete exceeds size of table (ffdrws)");
539         return(*status = BAD_ROW_NUM);
540     }
541 
542     buffer = (unsigned char *) malloc( (size_t) naxis1);  /* buffer for one row */
543 
544     if (!buffer)
545     {
546         ffpmsg("malloc failed (ffdrws)");
547         return(*status = MEMORY_ALLOCATION);
548     }
549 
550     /* byte location to start of first row to delete, and the next row */
551     insertpos = (fptr->Fptr)->datastart + ((rownum[0] - 1) * naxis1);
552     nextrowpos = insertpos + naxis1;
553     nextrow = rownum[0] + 1;
554 
555     /* work through the list of rows to delete */
556     for (ii = 1; ii < nrows; nextrow++, nextrowpos += naxis1)
557     {
558         if (nextrow < rownum[ii])
559         {   /* keep this row, so copy it to the new position */
560 
561             ffmbyt(fptr, nextrowpos, REPORT_EOF, status);
562             ffgbyt(fptr, naxis1, buffer, status);  /* read the bytes */
563 
564             ffmbyt(fptr, insertpos, IGNORE_EOF, status);
565             ffpbyt(fptr, naxis1, buffer, status);  /* write the bytes */
566 
567             if (*status > 0)
568             {
569                 ffpmsg("error while copying good rows in table (ffdrws)");
570                 free(buffer);
571                 return(*status);
572             }
573             insertpos += naxis1;
574         }
575         else
576         {   /* skip over this row since it is in the list */
577             ii++;
578         }
579     }
580 
581     /* finished with all the rows to delete; copy remaining rows */
582     while(nextrow <= naxis2)
583     {
584         ffmbyt(fptr, nextrowpos, REPORT_EOF, status);
585         ffgbyt(fptr, naxis1, buffer, status);  /* read the bytes */
586 
587         ffmbyt(fptr, insertpos, IGNORE_EOF, status);
588         ffpbyt(fptr, naxis1, buffer, status);  /* write the bytes */
589 
590         if (*status > 0)
591         {
592             ffpmsg("failed to copy remaining rows in table (ffdrws)");
593             free(buffer);
594             return(*status);
595         }
596         insertpos  += naxis1;
597         nextrowpos += naxis1;
598         nextrow++;
599     }
600     free(buffer);
601 
602     /* now delete the empty rows at the end of the table */
603     ffdrow(fptr, naxis2 - nrows + 1, nrows, status);
604 
605     /* Update the heap data, if any.  This will remove any orphaned data */
606     /* that was only pointed to by the rows that have been deleted */
607     ffcmph(fptr, status);
608 
609     return(*status);
610 }
611 /*--------------------------------------------------------------------------*/
ffdrwsll(fitsfile * fptr,LONGLONG * rownum,LONGLONG nrows,int * status)612 int ffdrwsll(fitsfile *fptr, /* I - FITS file pointer                        */
613            LONGLONG *rownum, /* I - list of rows to delete (1 = first)       */
614            LONGLONG nrows,  /* I - number of rows to delete                 */
615            int *status)     /* IO - error status                            */
616 /*
617  delete the list of rows from the table (1 = first row of table).
618 */
619 {
620     LONGLONG insertpos, nextrowpos;
621     LONGLONG naxis1, naxis2, ii, nextrow;
622     char comm[FLEN_COMMENT];
623     unsigned char *buffer;
624 
625     if (*status > 0)
626         return(*status);
627 
628     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
629         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
630 
631     /* rescan header if data structure is undefined */
632     if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
633         if ( ffrdef(fptr, status) > 0)
634             return(*status);
635 
636     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
637     {
638         ffpmsg("Can only delete rows in TABLE or BINTABLE extension (ffdrws)");
639         return(*status = NOT_TABLE);
640     }
641 
642     if (nrows < 0 )
643         return(*status = NEG_BYTES);
644     else if (nrows == 0)
645         return(*status);   /* no op, so just return */
646 
647     ffgkyjj(fptr, "NAXIS1", &naxis1, comm, status); /* row width   */
648     ffgkyjj(fptr, "NAXIS2", &naxis2, comm, status); /* number of rows */
649 
650     /* check that input row list is in ascending order */
651     for (ii = 1; ii < nrows; ii++)
652     {
653         if (rownum[ii - 1] >= rownum[ii])
654         {
655             ffpmsg("row numbers are not in increasing order (ffdrws)");
656             return(*status = BAD_ROW_NUM);
657         }
658     }
659 
660     if (rownum[0] < 1)
661     {
662         ffpmsg("first row to delete is less than 1 (ffdrws)");
663         return(*status = BAD_ROW_NUM);
664     }
665     else if (rownum[nrows - 1] > naxis2)
666     {
667         ffpmsg("last row to delete exceeds size of table (ffdrws)");
668         return(*status = BAD_ROW_NUM);
669     }
670 
671     buffer = (unsigned char *) malloc( (size_t) naxis1);  /* buffer for one row */
672 
673     if (!buffer)
674     {
675         ffpmsg("malloc failed (ffdrwsll)");
676         return(*status = MEMORY_ALLOCATION);
677     }
678 
679     /* byte location to start of first row to delete, and the next row */
680     insertpos = (fptr->Fptr)->datastart + ((rownum[0] - 1) * naxis1);
681     nextrowpos = insertpos + naxis1;
682     nextrow = rownum[0] + 1;
683 
684     /* work through the list of rows to delete */
685     for (ii = 1; ii < nrows; nextrow++, nextrowpos += naxis1)
686     {
687         if (nextrow < rownum[ii])
688         {   /* keep this row, so copy it to the new position */
689 
690             ffmbyt(fptr, nextrowpos, REPORT_EOF, status);
691             ffgbyt(fptr, naxis1, buffer, status);  /* read the bytes */
692 
693             ffmbyt(fptr, insertpos, IGNORE_EOF, status);
694             ffpbyt(fptr, naxis1, buffer, status);  /* write the bytes */
695 
696             if (*status > 0)
697             {
698                 ffpmsg("error while copying good rows in table (ffdrws)");
699                 free(buffer);
700                 return(*status);
701             }
702             insertpos += naxis1;
703         }
704         else
705         {   /* skip over this row since it is in the list */
706             ii++;
707         }
708     }
709 
710     /* finished with all the rows to delete; copy remaining rows */
711     while(nextrow <= naxis2)
712     {
713         ffmbyt(fptr, nextrowpos, REPORT_EOF, status);
714         ffgbyt(fptr, naxis1, buffer, status);  /* read the bytes */
715 
716         ffmbyt(fptr, insertpos, IGNORE_EOF, status);
717         ffpbyt(fptr, naxis1, buffer, status);  /* write the bytes */
718 
719         if (*status > 0)
720         {
721             ffpmsg("failed to copy remaining rows in table (ffdrws)");
722             free(buffer);
723             return(*status);
724         }
725         insertpos  += naxis1;
726         nextrowpos += naxis1;
727         nextrow++;
728     }
729     free(buffer);
730 
731     /* now delete the empty rows at the end of the table */
732     ffdrow(fptr, naxis2 - nrows + 1, nrows, status);
733 
734     /* Update the heap data, if any.  This will remove any orphaned data */
735     /* that was only pointed to by the rows that have been deleted */
736     ffcmph(fptr, status);
737 
738     return(*status);
739 }
740 /*--------------------------------------------------------------------------*/
ffrwrg(char * rowlist,LONGLONG maxrows,int maxranges,int * numranges,long * minrow,long * maxrow,int * status)741 int ffrwrg(
742       char *rowlist,      /* I - list of rows and row ranges */
743       LONGLONG maxrows,       /* I - number of rows in the table */
744       int maxranges,     /* I - max number of ranges to be returned */
745       int *numranges,    /* O - number ranges returned */
746       long *minrow,       /* O - first row in each range */
747       long *maxrow,       /* O - last row in each range */
748       int *status)        /* IO - status value */
749 {
750 /*
751    parse the input list of row ranges, returning the number of ranges,
752    and the min and max row value in each range.
753 
754    The only characters allowed in the input rowlist are
755        decimal digits, minus sign, and comma (and non-significant spaces)
756 
757    Example:
758 
759      list = "10-20, 30-35,50"
760 
761    would return numranges = 3, minrow[] = {10, 30, 50}, maxrow[] = {20, 35, 50}
762 
763    error is returned if min value of range is > max value of range or if the
764    ranges are not monotonically increasing.
765 */
766     char *next;
767     long minval, maxval;
768 
769     if (*status > 0)
770         return(*status);
771 
772     if (maxrows <= 0 ) {
773         *status = RANGE_PARSE_ERROR;
774         ffpmsg("Input maximum range value is <= 0 (fits_parse_ranges)");
775         return(*status);
776     }
777 
778     next = rowlist;
779     *numranges = 0;
780 
781     while (*next == ' ')next++;   /* skip spaces */
782 
783     while (*next != '\0') {
784 
785       /* find min value of next range; *next must be '-' or a digit */
786       if (*next == '-') {
787           minval = 1;    /* implied minrow value = 1 */
788       } else if ( isdigit((int) *next) ) {
789           minval = strtol(next, &next, 10);
790       } else {
791           *status = RANGE_PARSE_ERROR;
792           ffpmsg("Syntax error in this row range list:");
793           ffpmsg(rowlist);
794           return(*status);
795       }
796 
797       while (*next == ' ')next++;   /* skip spaces */
798 
799       /* find max value of next range; *next must be '-', or ',' */
800       if (*next == '-') {
801           next++;
802           while (*next == ' ')next++;   /* skip spaces */
803 
804           if ( isdigit((int) *next) ) {
805               maxval = strtol(next, &next, 10);
806           } else if (*next == ',' || *next == '\0') {
807               maxval = (long) maxrows;  /* implied max value */
808           } else {
809               *status = RANGE_PARSE_ERROR;
810               ffpmsg("Syntax error in this row range list:");
811               ffpmsg(rowlist);
812               return(*status);
813           }
814       } else if (*next == ',' || *next == '\0') {
815           maxval = minval;  /* only a single integer in this range */
816       } else {
817           *status = RANGE_PARSE_ERROR;
818           ffpmsg("Syntax error in this row range list:");
819           ffpmsg(rowlist);
820           return(*status);
821       }
822 
823       if (*numranges + 1 > maxranges) {
824           *status = RANGE_PARSE_ERROR;
825           ffpmsg("Overflowed maximum number of ranges (fits_parse_ranges)");
826           return(*status);
827       }
828 
829       if (minval < 1 ) {
830           *status = RANGE_PARSE_ERROR;
831           ffpmsg("Syntax error in this row range list: row number < 1");
832           ffpmsg(rowlist);
833           return(*status);
834       }
835 
836       if (maxval < minval) {
837           *status = RANGE_PARSE_ERROR;
838           ffpmsg("Syntax error in this row range list: min > max");
839           ffpmsg(rowlist);
840           return(*status);
841       }
842 
843       if (*numranges > 0) {
844           if (minval <= maxrow[(*numranges) - 1]) {
845              *status = RANGE_PARSE_ERROR;
846              ffpmsg("Syntax error in this row range list.  Range minimum is");
847              ffpmsg("  less than or equal to previous range maximum");
848              ffpmsg(rowlist);
849              return(*status);
850          }
851       }
852 
853       if (minval <= maxrows) {   /* ignore range if greater than maxrows */
854           if (maxval > maxrows)
855               maxval = (long) maxrows;
856 
857            minrow[*numranges] = minval;
858            maxrow[*numranges] = maxval;
859 
860            (*numranges)++;
861       }
862 
863       while (*next == ' ')next++;   /* skip spaces */
864       if (*next == ',') {
865            next++;
866            while (*next == ' ')next++;   /* skip more spaces */
867       }
868     }
869 
870     if (*numranges == 0) {  /* a null string was entered */
871          minrow[0] = 1;
872          maxrow[0] = (long) maxrows;
873          *numranges = 1;
874     }
875 
876     return(*status);
877 }
878 /*--------------------------------------------------------------------------*/
ffrwrgll(char * rowlist,LONGLONG maxrows,int maxranges,int * numranges,LONGLONG * minrow,LONGLONG * maxrow,int * status)879 int ffrwrgll(
880       char *rowlist,      /* I - list of rows and row ranges */
881       LONGLONG maxrows,       /* I - number of rows in the list */
882       int maxranges,     /* I - max number of ranges to be returned */
883       int *numranges,    /* O - number ranges returned */
884       LONGLONG *minrow,       /* O - first row in each range */
885       LONGLONG *maxrow,       /* O - last row in each range */
886       int *status)        /* IO - status value */
887 {
888 /*
889    parse the input list of row ranges, returning the number of ranges,
890    and the min and max row value in each range.
891 
892    The only characters allowed in the input rowlist are
893        decimal digits, minus sign, and comma (and non-significant spaces)
894 
895    Example:
896 
897      list = "10-20, 30-35,50"
898 
899    would return numranges = 3, minrow[] = {10, 30, 50}, maxrow[] = {20, 35, 50}
900 
901    error is returned if min value of range is > max value of range or if the
902    ranges are not monotonically increasing.
903 */
904     char *next;
905     LONGLONG minval, maxval;
906     double dvalue;
907 
908     if (*status > 0)
909         return(*status);
910 
911     if (maxrows <= 0 ) {
912         *status = RANGE_PARSE_ERROR;
913         ffpmsg("Input maximum range value is <= 0 (fits_parse_ranges)");
914         return(*status);
915     }
916 
917     next = rowlist;
918     *numranges = 0;
919 
920     while (*next == ' ')next++;   /* skip spaces */
921 
922     while (*next != '\0') {
923 
924       /* find min value of next range; *next must be '-' or a digit */
925       if (*next == '-') {
926           minval = 1;    /* implied minrow value = 1 */
927       } else if ( isdigit((int) *next) ) {
928 
929         /* read as a double, because the string to LONGLONG function */
930         /* is platform dependent (strtoll, strtol, _atoI64)          */
931 
932           dvalue = strtod(next, &next);
933           minval = (LONGLONG) (dvalue + 0.1);
934 
935       } else {
936           *status = RANGE_PARSE_ERROR;
937           ffpmsg("Syntax error in this row range list:");
938           ffpmsg(rowlist);
939           return(*status);
940       }
941 
942       while (*next == ' ')next++;   /* skip spaces */
943 
944       /* find max value of next range; *next must be '-', or ',' */
945       if (*next == '-') {
946           next++;
947           while (*next == ' ')next++;   /* skip spaces */
948 
949           if ( isdigit((int) *next) ) {
950 
951             /* read as a double, because the string to LONGLONG function */
952             /* is platform dependent (strtoll, strtol, _atoI64)          */
953 
954               dvalue = strtod(next, &next);
955               maxval = (LONGLONG) (dvalue + 0.1);
956 
957           } else if (*next == ',' || *next == '\0') {
958               maxval = maxrows;  /* implied max value */
959           } else {
960               *status = RANGE_PARSE_ERROR;
961               ffpmsg("Syntax error in this row range list:");
962               ffpmsg(rowlist);
963               return(*status);
964           }
965       } else if (*next == ',' || *next == '\0') {
966           maxval = minval;  /* only a single integer in this range */
967       } else {
968           *status = RANGE_PARSE_ERROR;
969           ffpmsg("Syntax error in this row range list:");
970           ffpmsg(rowlist);
971           return(*status);
972       }
973 
974       if (*numranges + 1 > maxranges) {
975           *status = RANGE_PARSE_ERROR;
976           ffpmsg("Overflowed maximum number of ranges (fits_parse_ranges)");
977           return(*status);
978       }
979 
980       if (minval < 1 ) {
981           *status = RANGE_PARSE_ERROR;
982           ffpmsg("Syntax error in this row range list: row number < 1");
983           ffpmsg(rowlist);
984           return(*status);
985       }
986 
987       if (maxval < minval) {
988           *status = RANGE_PARSE_ERROR;
989           ffpmsg("Syntax error in this row range list: min > max");
990           ffpmsg(rowlist);
991           return(*status);
992       }
993 
994       if (*numranges > 0) {
995           if (minval <= maxrow[(*numranges) - 1]) {
996              *status = RANGE_PARSE_ERROR;
997              ffpmsg("Syntax error in this row range list.  Range minimum is");
998              ffpmsg("  less than or equal to previous range maximum");
999              ffpmsg(rowlist);
1000              return(*status);
1001          }
1002       }
1003 
1004       if (minval <= maxrows) {   /* ignore range if greater than maxrows */
1005           if (maxval > maxrows)
1006               maxval = maxrows;
1007 
1008            minrow[*numranges] = minval;
1009            maxrow[*numranges] = maxval;
1010 
1011            (*numranges)++;
1012       }
1013 
1014       while (*next == ' ')next++;   /* skip spaces */
1015       if (*next == ',') {
1016            next++;
1017            while (*next == ' ')next++;   /* skip more spaces */
1018       }
1019     }
1020 
1021     if (*numranges == 0) {  /* a null string was entered */
1022          minrow[0] = 1;
1023          maxrow[0] = maxrows;
1024          *numranges = 1;
1025     }
1026 
1027     return(*status);
1028 }
1029 /*--------------------------------------------------------------------------*/
fficol(fitsfile * fptr,int numcol,char * ttype,char * tform,int * status)1030 int fficol(fitsfile *fptr,  /* I - FITS file pointer                        */
1031            int numcol,      /* I - position for new col. (1 = 1st)          */
1032            char *ttype,     /* I - name of column (TTYPE keyword)           */
1033            char *tform,     /* I - format of column (TFORM keyword)         */
1034            int *status)     /* IO - error status                            */
1035 /*
1036  Insert a new column into an existing table at position numcol.  If
1037  numcol is greater than the number of existing columns in the table
1038  then the new column will be appended as the last column in the table.
1039 */
1040 {
1041     char *name, *format;
1042 
1043     name = ttype;
1044     format = tform;
1045 
1046     fficls(fptr, numcol, 1, &name, &format, status);
1047     return(*status);
1048 }
1049 /*--------------------------------------------------------------------------*/
fficls(fitsfile * fptr,int fstcol,int ncols,char ** ttype,char ** tform,int * status)1050 int fficls(fitsfile *fptr,  /* I - FITS file pointer                        */
1051            int fstcol,      /* I - position for first new col. (1 = 1st)    */
1052            int ncols,       /* I - number of columns to insert              */
1053            char **ttype,    /* I - array of column names(TTYPE keywords)    */
1054            char **tform,    /* I - array of formats of column (TFORM)       */
1055            int *status)     /* IO - error status                            */
1056 /*
1057  Insert 1 or more new columns into an existing table at position numcol.  If
1058  fstcol is greater than the number of existing columns in the table
1059  then the new column will be appended as the last column in the table.
1060 */
1061 {
1062     int colnum, datacode, decims, tfields, tstatus, ii;
1063     LONGLONG datasize, firstbyte, nbytes, nadd, naxis1, naxis2, freespace;
1064     LONGLONG tbcol, firstcol, delbyte;
1065     long nblock, width, repeat;
1066     char tfm[FLEN_VALUE], keyname[FLEN_KEYWORD], comm[FLEN_COMMENT], *cptr;
1067     tcolumn *colptr;
1068 
1069     if (*status > 0)
1070         return(*status);
1071 
1072     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
1073     {
1074         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
1075     }
1076         /* rescan header if data structure is undefined */
1077     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
1078         if ( ffrdef(fptr, status) > 0)
1079             return(*status);
1080 
1081     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
1082     {
1083        ffpmsg("Can only add columns to TABLE or BINTABLE extension (fficls)");
1084        return(*status = NOT_TABLE);
1085     }
1086 
1087     /*  is the column number valid?  */
1088     tfields = (fptr->Fptr)->tfield;
1089     if (fstcol < 1 )
1090         return(*status = BAD_COL_NUM);
1091     else if (fstcol > tfields)
1092         colnum = tfields + 1;   /* append as last column */
1093     else
1094         colnum = fstcol;
1095 
1096     /* parse the tform value and calc number of bytes to add to each row */
1097     delbyte = 0;
1098     for (ii = 0; ii < ncols; ii++)
1099     {
1100         if (strlen(tform[ii]) > FLEN_VALUE-1)
1101         {
1102            ffpmsg("Column format string too long (fficls)");
1103            return (*status=BAD_TFORM);
1104         }
1105         strcpy(tfm, tform[ii]);
1106         ffupch(tfm);         /* make sure format is in upper case */
1107 
1108         if ((fptr->Fptr)->hdutype == ASCII_TBL)
1109         {
1110             ffasfm(tfm, &datacode, &width, &decims, status);
1111             delbyte += width + 1;  /*  add one space between the columns */
1112         }
1113         else
1114         {
1115             ffbnfm(tfm, &datacode, &repeat, &width, status);
1116 
1117             if (datacode < 0)  {       /* variable length array column */
1118 	        if (strchr(tfm, 'Q'))
1119 		  delbyte += 16;
1120 		else
1121                   delbyte += 8;
1122             } else if (datacode == 1)          /* bit column; round up  */
1123                 delbyte += (repeat + 7) / 8; /* to multiple of 8 bits */
1124             else if (datacode == 16)  /* ASCII string column */
1125                 delbyte += repeat;
1126             else                      /* numerical data type */
1127                 delbyte += (datacode / 10) * repeat;
1128         }
1129     }
1130 
1131     if (*status > 0)
1132         return(*status);
1133 
1134     /* get the current size of the table */
1135     /* use internal structure since NAXIS2 keyword may not be up to date */
1136     naxis1 = (fptr->Fptr)->rowlength;
1137     naxis2 = (fptr->Fptr)->numrows;
1138 
1139     /* current size of data */
1140     datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
1141     freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize;
1142     nadd = delbyte * naxis2;   /* no. of bytes to add to table */
1143 
1144     if ( (freespace - nadd) < 0)   /* not enough existing space? */
1145     {
1146         nblock = (long) ((nadd - freespace + 2879) / 2880);     /* number of blocks  */
1147         if (ffiblk(fptr, nblock, 1, status) > 0)       /* insert the blocks */
1148             return(*status);
1149     }
1150 
1151     /* shift heap down (if it exists) */
1152     if ((fptr->Fptr)->heapsize > 0)
1153     {
1154         nbytes = (fptr->Fptr)->heapsize;    /* no. of bytes to shift down */
1155 
1156         /* absolute heap pos */
1157         firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart;
1158 
1159         if (ffshft(fptr, firstbyte, nbytes, nadd, status) > 0) /* move heap */
1160             return(*status);
1161     }
1162 
1163     /* update the heap starting address */
1164     (fptr->Fptr)->heapstart += nadd;
1165 
1166     /* update the THEAP keyword if it exists */
1167     tstatus = 0;
1168     ffmkyj(fptr, "THEAP", (fptr->Fptr)->heapstart, "&", &tstatus);
1169 
1170     /* calculate byte position in the row where to insert the new column */
1171     if (colnum > tfields)
1172         firstcol = naxis1;
1173     else
1174     {
1175         colptr = (fptr->Fptr)->tableptr;
1176         colptr += (colnum - 1);
1177         firstcol = colptr->tbcol;
1178     }
1179 
1180     /* insert delbyte bytes in every row, at byte position firstcol */
1181     ffcins(fptr, naxis1, naxis2, delbyte, firstcol, status);
1182 
1183     if ((fptr->Fptr)->hdutype == ASCII_TBL)
1184     {
1185         /* adjust the TBCOL values of the existing columns */
1186         for(ii = 0; ii < tfields; ii++)
1187         {
1188             ffkeyn("TBCOL", ii + 1, keyname, status);
1189             ffgkyjj(fptr, keyname, &tbcol, comm, status);
1190             if (tbcol > firstcol)
1191             {
1192                 tbcol += delbyte;
1193                 ffmkyj(fptr, keyname, tbcol, "&", status);
1194             }
1195         }
1196     }
1197 
1198     /* update the mandatory keywords */
1199     ffmkyj(fptr, "TFIELDS", tfields + ncols, "&", status);
1200     ffmkyj(fptr, "NAXIS1", naxis1 + delbyte, "&", status);
1201 
1202     /* increment the index value on any existing column keywords */
1203     if(colnum <= tfields)
1204         ffkshf(fptr, colnum, tfields, ncols, status);
1205 
1206     /* add the required keywords for the new columns */
1207     for (ii = 0; ii < ncols; ii++, colnum++)
1208     {
1209         strcpy(comm, "label for field");
1210         ffkeyn("TTYPE", colnum, keyname, status);
1211         ffpkys(fptr, keyname, ttype[ii], comm, status);
1212 
1213         strcpy(comm, "format of field");
1214         strcpy(tfm, tform[ii]);
1215         ffupch(tfm);         /* make sure format is in upper case */
1216         ffkeyn("TFORM", colnum, keyname, status);
1217 
1218         if (abs(datacode) == TSBYTE)
1219         {
1220            /* Replace the 'S' with an 'B' in the TFORMn code */
1221            cptr = tfm;
1222            while (*cptr != 'S')
1223               cptr++;
1224 
1225            *cptr = 'B';
1226            ffpkys(fptr, keyname, tfm, comm, status);
1227 
1228            /* write the TZEROn and TSCALn keywords */
1229            ffkeyn("TZERO", colnum, keyname, status);
1230            strcpy(comm, "offset for signed bytes");
1231 
1232            ffpkyg(fptr, keyname, -128., 0, comm, status);
1233 
1234            ffkeyn("TSCAL", colnum, keyname, status);
1235            strcpy(comm, "data are not scaled");
1236            ffpkyg(fptr, keyname, 1., 0, comm, status);
1237         }
1238         else if (abs(datacode) == TUSHORT)
1239         {
1240            /* Replace the 'U' with an 'I' in the TFORMn code */
1241            cptr = tfm;
1242            while (*cptr != 'U')
1243               cptr++;
1244 
1245            *cptr = 'I';
1246            ffpkys(fptr, keyname, tfm, comm, status);
1247 
1248            /* write the TZEROn and TSCALn keywords */
1249            ffkeyn("TZERO", colnum, keyname, status);
1250            strcpy(comm, "offset for unsigned integers");
1251 
1252            ffpkyg(fptr, keyname, 32768., 0, comm, status);
1253 
1254            ffkeyn("TSCAL", colnum, keyname, status);
1255            strcpy(comm, "data are not scaled");
1256            ffpkyg(fptr, keyname, 1., 0, comm, status);
1257         }
1258         else if (abs(datacode) == TULONG)
1259         {
1260            /* Replace the 'V' with an 'J' in the TFORMn code */
1261            cptr = tfm;
1262            while (*cptr != 'V')
1263               cptr++;
1264 
1265            *cptr = 'J';
1266            ffpkys(fptr, keyname, tfm, comm, status);
1267 
1268            /* write the TZEROn and TSCALn keywords */
1269            ffkeyn("TZERO", colnum, keyname, status);
1270            strcpy(comm, "offset for unsigned integers");
1271 
1272            ffpkyg(fptr, keyname, 2147483648., 0, comm, status);
1273 
1274            ffkeyn("TSCAL", colnum, keyname, status);
1275            strcpy(comm, "data are not scaled");
1276            ffpkyg(fptr, keyname, 1., 0, comm, status);
1277         }
1278         else
1279         {
1280            ffpkys(fptr, keyname, tfm, comm, status);
1281         }
1282 
1283         if ((fptr->Fptr)->hdutype == ASCII_TBL)   /* write the TBCOL keyword */
1284         {
1285             if (colnum == tfields + 1)
1286                 tbcol = firstcol + 2;  /* allow space between preceding col */
1287             else
1288                 tbcol = firstcol + 1;
1289 
1290             strcpy(comm, "beginning column of field");
1291             ffkeyn("TBCOL", colnum, keyname, status);
1292             ffpkyj(fptr, keyname, tbcol, comm, status);
1293 
1294             /* increment the column starting position for the next column */
1295             ffasfm(tfm, &datacode, &width, &decims, status);
1296             firstcol += width + 1;  /*  add one space between the columns */
1297         }
1298     }
1299     ffrdef(fptr, status); /* initialize the new table structure */
1300     return(*status);
1301 }
1302 /*--------------------------------------------------------------------------*/
ffmvec(fitsfile * fptr,int colnum,LONGLONG newveclen,int * status)1303 int ffmvec(fitsfile *fptr,  /* I - FITS file pointer                        */
1304            int colnum,      /* I - position of col to be modified           */
1305            LONGLONG newveclen,  /* I - new vector length of column (TFORM)       */
1306            int *status)     /* IO - error status                            */
1307 /*
1308   Modify the vector length of a column in a binary table, larger or smaller.
1309   E.g., change a column from TFORMn = '1E' to '20E'.
1310 */
1311 {
1312     int datacode, tfields, tstatus;
1313     LONGLONG datasize, size, firstbyte, nbytes, nadd, ndelete;
1314     LONGLONG naxis1, naxis2, firstcol, freespace;
1315     LONGLONG width, delbyte, repeat;
1316     long nblock;
1317     char tfm[FLEN_VALUE], keyname[FLEN_KEYWORD], tcode[2];
1318     tcolumn *colptr;
1319 
1320     if (*status > 0)
1321         return(*status);
1322 
1323     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
1324     {
1325         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
1326     }
1327         /* rescan header if data structure is undefined */
1328     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
1329         if ( ffrdef(fptr, status) > 0)
1330             return(*status);
1331 
1332     if ((fptr->Fptr)->hdutype != BINARY_TBL)
1333     {
1334        ffpmsg(
1335   "Can only change vector length of a column in BINTABLE extension (ffmvec)");
1336        return(*status = NOT_TABLE);
1337     }
1338 
1339     /*  is the column number valid?  */
1340     tfields = (fptr->Fptr)->tfield;
1341     if (colnum < 1 || colnum > tfields)
1342         return(*status = BAD_COL_NUM);
1343 
1344     /* look up the current vector length and element width */
1345 
1346     colptr = (fptr->Fptr)->tableptr;
1347     colptr += (colnum - 1);
1348 
1349     datacode = colptr->tdatatype; /* datatype of the column */
1350     repeat =  colptr->trepeat;  /* field repeat count  */
1351     width =  colptr->twidth;   /*  width of a single element in chars */
1352 
1353     if (datacode < 0)
1354     {
1355         ffpmsg(
1356         "Can't modify vector length of variable length column (ffmvec)");
1357         return(*status = BAD_TFORM);
1358     }
1359 
1360     if (repeat == newveclen)
1361         return(*status);  /* column already has the desired vector length */
1362 
1363     if (datacode == TSTRING)
1364         width = 1;      /* width was equal to width of unit string */
1365 
1366     naxis1 =  (fptr->Fptr)->rowlength;   /* current width of the table */
1367     naxis2 = (fptr->Fptr)->numrows;
1368 
1369     delbyte = (newveclen - repeat) * width;    /* no. of bytes to insert */
1370     if (datacode == TBIT)  /* BIT column is a special case */
1371        delbyte = ((newveclen + 7) / 8) - ((repeat + 7) / 8);
1372 
1373     if (delbyte > 0)  /* insert space for more elements */
1374     {
1375       /* current size of data */
1376       datasize = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
1377       freespace = ( ( (datasize + 2879) / 2880) * 2880) - datasize;
1378 
1379       nadd = (LONGLONG)delbyte * naxis2;   /* no. of bytes to add to table */
1380 
1381       if ( (freespace - nadd) < 0)   /* not enough existing space? */
1382       {
1383         nblock = (long) ((nadd - freespace + 2879) / 2880);    /* number of blocks  */
1384         if (ffiblk(fptr, nblock, 1, status) > 0)      /* insert the blocks */
1385           return(*status);
1386       }
1387 
1388       /* shift heap down (if it exists) */
1389       if ((fptr->Fptr)->heapsize > 0)
1390       {
1391         nbytes = (fptr->Fptr)->heapsize;    /* no. of bytes to shift down */
1392 
1393         /* absolute heap pos */
1394         firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart;
1395 
1396         if (ffshft(fptr, firstbyte, nbytes, nadd, status) > 0) /* move heap */
1397             return(*status);
1398       }
1399 
1400       /* update the heap starting address */
1401       (fptr->Fptr)->heapstart += nadd;
1402 
1403       /* update the THEAP keyword if it exists */
1404       tstatus = 0;
1405       ffmkyj(fptr, "THEAP", (fptr->Fptr)->heapstart, "&", &tstatus);
1406 
1407       /* Must reset colptr before using it again.  (fptr->Fptr)->tableptr
1408          may have been reallocated down in ffbinit via the call to ffiblk above.*/
1409       colptr = (fptr->Fptr)->tableptr;
1410       colptr += (colnum - 1);
1411 
1412       firstcol = colptr->tbcol + (repeat * width);  /* insert position */
1413 
1414       /* insert delbyte bytes in every row, at byte position firstcol */
1415       ffcins(fptr, naxis1, naxis2, delbyte, firstcol, status);
1416     }
1417     else if (delbyte < 0)
1418     {
1419       /* current size of table */
1420       size = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
1421       freespace = ((size + 2879) / 2880) * 2880 - size - ((LONGLONG)delbyte * naxis2);
1422       nblock = (long) (freespace / 2880);   /* number of empty blocks to delete */
1423       firstcol = colptr->tbcol + (newveclen * width);  /* delete position */
1424 
1425       /* delete elements from the vector */
1426       ffcdel(fptr, naxis1, naxis2, -delbyte, firstcol, status);
1427 
1428       /* abs heap pos */
1429       firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart;
1430       ndelete = (LONGLONG)delbyte * naxis2; /* size of shift (negative) */
1431 
1432       /* shift heap up (if it exists) */
1433       if ((fptr->Fptr)->heapsize > 0)
1434       {
1435         nbytes = (fptr->Fptr)->heapsize;    /* no. of bytes to shift up */
1436         if (ffshft(fptr, firstbyte, nbytes, ndelete, status) > 0)
1437           return(*status);
1438       }
1439 
1440       /* delete the empty  blocks at the end of the HDU */
1441       if (nblock > 0)
1442         ffdblk(fptr, nblock, status);
1443 
1444       /* update the heap starting address */
1445       (fptr->Fptr)->heapstart += ndelete;  /* ndelete is negative */
1446 
1447       /* update the THEAP keyword if it exists */
1448       tstatus = 0;
1449       ffmkyj(fptr, "THEAP", (fptr->Fptr)->heapstart, "&", &tstatus);
1450     }
1451 
1452     /* construct the new TFORM keyword for the column */
1453     if (datacode == TBIT)
1454       strcpy(tcode,"X");
1455     else if (datacode == TBYTE)
1456       strcpy(tcode,"B");
1457     else if (datacode == TLOGICAL)
1458       strcpy(tcode,"L");
1459     else if (datacode == TSTRING)
1460       strcpy(tcode,"A");
1461     else if (datacode == TSHORT)
1462       strcpy(tcode,"I");
1463     else if (datacode == TLONG)
1464       strcpy(tcode,"J");
1465     else if (datacode == TLONGLONG)
1466       strcpy(tcode,"K");
1467     else if (datacode == TFLOAT)
1468       strcpy(tcode,"E");
1469     else if (datacode == TDOUBLE)
1470       strcpy(tcode,"D");
1471     else if (datacode == TCOMPLEX)
1472       strcpy(tcode,"C");
1473     else if (datacode == TDBLCOMPLEX)
1474       strcpy(tcode,"M");
1475 
1476     /* write as a double value because the LONGLONG conversion */
1477     /* character in snprintf is platform dependent ( %lld, %ld, %I64d ) */
1478 
1479     snprintf(tfm,FLEN_VALUE,"%.0f%s",(double) newveclen, tcode);
1480 
1481     ffkeyn("TFORM", colnum, keyname, status);  /* Keyword name */
1482     ffmkys(fptr, keyname, tfm, "&", status);   /* modify TFORM keyword */
1483 
1484     ffmkyj(fptr, "NAXIS1", naxis1 + delbyte, "&", status); /* modify NAXIS1 */
1485 
1486     ffrdef(fptr, status); /* reinitialize the new table structure */
1487     return(*status);
1488 }
1489 /*--------------------------------------------------------------------------*/
ffcpcl(fitsfile * infptr,fitsfile * outfptr,int incol,int outcol,int create_col,int * status)1490 int ffcpcl(fitsfile *infptr,    /* I - FITS file pointer to input file  */
1491            fitsfile *outfptr,   /* I - FITS file pointer to output file */
1492            int incol,           /* I - number of input column   */
1493            int outcol,          /* I - number for output column  */
1494            int create_col,      /* I - create new col if TRUE, else overwrite */
1495            int *status)         /* IO - error status     */
1496 /*
1497   copy a column from infptr and insert it in the outfptr table.
1498 */
1499 {
1500     int tstatus, colnum, typecode, otypecode, anynull;
1501     int inHduType, outHduType;
1502     long tfields, repeat, orepeat, width, owidth, nrows, outrows;
1503     long inloop, outloop, maxloop, ndone, ntodo, npixels;
1504     long firstrow, firstelem, ii;
1505     char keyname[FLEN_KEYWORD], ttype[FLEN_VALUE], tform[FLEN_VALUE];
1506     char ttype_comm[FLEN_COMMENT],tform_comm[FLEN_COMMENT];
1507     char *lvalues = 0, nullflag, **strarray = 0;
1508     char nulstr[] = {'\5', '\0'};  /* unique null string value */
1509     double dnull = 0.l, *dvalues = 0;
1510     float fnull = 0., *fvalues = 0;
1511 
1512     if (*status > 0)
1513         return(*status);
1514 
1515     if (infptr->HDUposition != (infptr->Fptr)->curhdu)
1516     {
1517         ffmahd(infptr, (infptr->HDUposition) + 1, NULL, status);
1518     }
1519     else if ((infptr->Fptr)->datastart == DATA_UNDEFINED)
1520         ffrdef(infptr, status);                /* rescan header */
1521     inHduType = (infptr->Fptr)->hdutype;
1522 
1523     if (outfptr->HDUposition != (outfptr->Fptr)->curhdu)
1524     {
1525         ffmahd(outfptr, (outfptr->HDUposition) + 1, NULL, status);
1526     }
1527     else if ((outfptr->Fptr)->datastart == DATA_UNDEFINED)
1528         ffrdef(outfptr, status);               /* rescan header */
1529     outHduType = (outfptr->Fptr)->hdutype;
1530 
1531     if (*status > 0)
1532         return(*status);
1533 
1534     if (inHduType == IMAGE_HDU || outHduType == IMAGE_HDU)
1535     {
1536        ffpmsg
1537        ("Can not copy columns to or from IMAGE HDUs (ffcpcl)");
1538        return(*status = NOT_TABLE);
1539     }
1540 
1541     if ( inHduType == BINARY_TBL &&  outHduType == ASCII_TBL)
1542     {
1543        ffpmsg
1544        ("Copying from Binary table to ASCII table is not supported (ffcpcl)");
1545        return(*status = NOT_BTABLE);
1546     }
1547 
1548     /* get the datatype and vector repeat length of the column */
1549     ffgtcl(infptr, incol, &typecode, &repeat, &width, status);
1550 
1551     if (typecode < 0)
1552     {
1553         ffpmsg("Variable-length columns are not supported (ffcpcl)");
1554         return(*status = BAD_TFORM);
1555     }
1556 
1557     if (create_col)    /* insert new column in output table? */
1558     {
1559         tstatus = 0;
1560         ffkeyn("TTYPE", incol, keyname, &tstatus);
1561         ffgkys(infptr, keyname, ttype, ttype_comm, &tstatus);
1562         ffkeyn("TFORM", incol, keyname, &tstatus);
1563 
1564         if (ffgkys(infptr, keyname, tform, tform_comm, &tstatus) )
1565         {
1566           ffpmsg
1567           ("Could not find TTYPE and TFORM keywords in input table (ffcpcl)");
1568           return(*status = NO_TFORM);
1569         }
1570 
1571         if (inHduType == ASCII_TBL && outHduType == BINARY_TBL)
1572         {
1573             /* convert from ASCII table to BINARY table format string */
1574             if (typecode == TSTRING)
1575                 ffnkey(width, "A", tform, status);
1576 
1577             else if (typecode == TLONG)
1578                 strcpy(tform, "1J");
1579 
1580             else if (typecode == TSHORT)
1581                 strcpy(tform, "1I");
1582 
1583             else if (typecode == TFLOAT)
1584                 strcpy(tform,"1E");
1585 
1586             else if (typecode == TDOUBLE)
1587                 strcpy(tform,"1D");
1588         }
1589 
1590         if (ffgkyj(outfptr, "TFIELDS", &tfields, 0, &tstatus))
1591         {
1592            ffpmsg
1593            ("Could not read TFIELDS keyword in output table (ffcpcl)");
1594            return(*status = NO_TFIELDS);
1595         }
1596 
1597         colnum = minvalue((int) tfields + 1, outcol); /* output col. number */
1598 
1599         /* create the empty column */
1600         if (fficol(outfptr, colnum, ttype, tform, status) > 0)
1601         {
1602            ffpmsg
1603            ("Could not append new column to output file (ffcpcl)");
1604            return(*status);
1605         }
1606 
1607         if ((infptr->Fptr == outfptr->Fptr)
1608            && (infptr->HDUposition == outfptr->HDUposition)
1609            && (colnum <= incol))  {
1610 	       incol++;  /* the input column has been shifted over */
1611         }
1612 
1613         /* copy the comment strings from the input file for TTYPE and TFORM */
1614         tstatus = 0;
1615         ffkeyn("TTYPE", colnum, keyname, &tstatus);
1616         ffmcom(outfptr, keyname, ttype_comm, &tstatus);
1617         ffkeyn("TFORM", colnum, keyname, &tstatus);
1618         ffmcom(outfptr, keyname, tform_comm, &tstatus);
1619 
1620         /* copy other column-related keywords if they exist */
1621 
1622         ffcpky(infptr, outfptr, incol, colnum, "TUNIT", status);
1623         ffcpky(infptr, outfptr, incol, colnum, "TSCAL", status);
1624         ffcpky(infptr, outfptr, incol, colnum, "TZERO", status);
1625         ffcpky(infptr, outfptr, incol, colnum, "TDISP", status);
1626         ffcpky(infptr, outfptr, incol, colnum, "TLMIN", status);
1627         ffcpky(infptr, outfptr, incol, colnum, "TLMAX", status);
1628         ffcpky(infptr, outfptr, incol, colnum, "TDIM", status);
1629 
1630         /*  WCS keywords */
1631         ffcpky(infptr, outfptr, incol, colnum, "TCTYP", status);
1632         ffcpky(infptr, outfptr, incol, colnum, "TCUNI", status);
1633         ffcpky(infptr, outfptr, incol, colnum, "TCRVL", status);
1634         ffcpky(infptr, outfptr, incol, colnum, "TCRPX", status);
1635         ffcpky(infptr, outfptr, incol, colnum, "TCDLT", status);
1636         ffcpky(infptr, outfptr, incol, colnum, "TCROT", status);
1637 
1638         if (inHduType == ASCII_TBL && outHduType == BINARY_TBL)
1639         {
1640             /* binary tables only have TNULLn keyword for integer columns */
1641             if (typecode == TLONG || typecode == TSHORT)
1642             {
1643                 /* check if null string is defined; replace with integer */
1644                 ffkeyn("TNULL", incol, keyname, &tstatus);
1645                 if (ffgkys(infptr, keyname, ttype, 0, &tstatus) <= 0)
1646                 {
1647                    ffkeyn("TNULL", colnum, keyname, &tstatus);
1648                    if (typecode == TLONG)
1649                       ffpkyj(outfptr, keyname, -9999999L, "Null value", status);
1650                    else
1651                       ffpkyj(outfptr, keyname, -32768L, "Null value", status);
1652                 }
1653             }
1654         }
1655         else
1656         {
1657             ffcpky(infptr, outfptr, incol, colnum, "TNULL", status);
1658         }
1659 
1660         /* rescan header to recognize the new keywords */
1661         if (ffrdef(outfptr, status) )
1662             return(*status);
1663     }
1664     else
1665     {
1666         colnum = outcol;
1667         /* get the datatype and vector repeat length of the output column */
1668         ffgtcl(outfptr, outcol, &otypecode, &orepeat, &owidth, status);
1669 
1670         if (orepeat != repeat) {
1671             ffpmsg("Input and output vector columns must have same length (ffcpcl)");
1672             return(*status = BAD_TFORM);
1673         }
1674     }
1675 
1676     ffgkyj(infptr,  "NAXIS2", &nrows,   0, status);  /* no. of input rows */
1677     ffgkyj(outfptr, "NAXIS2", &outrows, 0, status);  /* no. of output rows */
1678     nrows = minvalue(nrows, outrows);
1679 
1680     if (typecode == TBIT)
1681         repeat = (repeat + 7) / 8;  /* convert from bits to bytes */
1682     else if (typecode == TSTRING && inHduType == BINARY_TBL)
1683         repeat = repeat / width;  /* convert from chars to unit strings */
1684 
1685     /* get optimum number of rows to copy at one time */
1686     ffgrsz(infptr,  &inloop,  status);
1687     ffgrsz(outfptr, &outloop, status);
1688 
1689     /* adjust optimum number, since 2 tables are open at once */
1690     maxloop = minvalue(inloop, outloop); /* smallest of the 2 tables */
1691     maxloop = maxvalue(1, maxloop / 2);  /* at least 1 row */
1692     maxloop = minvalue(maxloop, nrows);  /* max = nrows to be copied */
1693     maxloop *= repeat;                   /* mult by no of elements in a row */
1694 
1695     /* allocate memory for arrays */
1696     if (typecode == TLOGICAL)
1697     {
1698        lvalues   = (char *) calloc(maxloop, sizeof(char) );
1699        if (!lvalues)
1700        {
1701          ffpmsg
1702          ("malloc failed to get memory for logicals (ffcpcl)");
1703          return(*status = ARRAY_TOO_BIG);
1704        }
1705     }
1706     else if (typecode == TSTRING)
1707     {
1708        /* allocate array of pointers */
1709        strarray = (char **) calloc(maxloop, sizeof(strarray));
1710 
1711        /* allocate space for each string */
1712        for (ii = 0; ii < maxloop; ii++)
1713           strarray[ii] = (char *) calloc(width+1, sizeof(char));
1714     }
1715     else if (typecode == TCOMPLEX)
1716     {
1717        fvalues = (float *) calloc(maxloop * 2, sizeof(float) );
1718        if (!fvalues)
1719        {
1720          ffpmsg
1721          ("malloc failed to get memory for complex (ffcpcl)");
1722          return(*status = ARRAY_TOO_BIG);
1723        }
1724        fnull = 0.;
1725     }
1726     else if (typecode == TDBLCOMPLEX)
1727     {
1728        dvalues = (double *) calloc(maxloop * 2, sizeof(double) );
1729        if (!dvalues)
1730        {
1731          ffpmsg
1732          ("malloc failed to get memory for dbl complex (ffcpcl)");
1733          return(*status = ARRAY_TOO_BIG);
1734        }
1735        dnull = 0.;
1736     }
1737     else    /* numerical datatype; read them all as doubles */
1738     {
1739        dvalues = (double *) calloc(maxloop, sizeof(double) );
1740        if (!dvalues)
1741        {
1742          ffpmsg
1743          ("malloc failed to get memory for doubles (ffcpcl)");
1744          return(*status = ARRAY_TOO_BIG);
1745        }
1746          dnull = -9.99991999E31;  /* use an unlikely value for nulls */
1747     }
1748 
1749     npixels = nrows * repeat;          /* total no. of pixels to copy */
1750     ntodo = minvalue(npixels, maxloop);   /* no. to copy per iteration */
1751     ndone = 0;             /* total no. of pixels that have been copied */
1752 
1753     while (ntodo)      /* iterate through the table */
1754     {
1755         firstrow = ndone / repeat + 1;
1756         firstelem = ndone - ((firstrow - 1) * repeat) + 1;
1757 
1758         /* read from input table */
1759         if (typecode == TLOGICAL)
1760             ffgcl(infptr, incol, firstrow, firstelem, ntodo,
1761                        lvalues, status);
1762         else if (typecode == TSTRING)
1763             ffgcvs(infptr, incol, firstrow, firstelem, ntodo,
1764                        nulstr, strarray, &anynull, status);
1765 
1766         else if (typecode == TCOMPLEX)
1767             ffgcvc(infptr, incol, firstrow, firstelem, ntodo, fnull,
1768                    fvalues, &anynull, status);
1769 
1770         else if (typecode == TDBLCOMPLEX)
1771             ffgcvm(infptr, incol, firstrow, firstelem, ntodo, dnull,
1772                    dvalues, &anynull, status);
1773 
1774         else       /* all numerical types */
1775             ffgcvd(infptr, incol, firstrow, firstelem, ntodo, dnull,
1776                    dvalues, &anynull, status);
1777 
1778         if (*status > 0)
1779         {
1780             ffpmsg("Error reading input copy of column (ffcpcl)");
1781             break;
1782         }
1783 
1784         /* write to output table */
1785         if (typecode == TLOGICAL)
1786         {
1787             nullflag = 2;
1788 
1789             ffpcnl(outfptr, colnum, firstrow, firstelem, ntodo,
1790                        lvalues, nullflag, status);
1791 
1792         }
1793 
1794         else if (typecode == TSTRING)
1795         {
1796             if (anynull)
1797                 ffpcns(outfptr, colnum, firstrow, firstelem, ntodo,
1798                        strarray, nulstr, status);
1799             else
1800                 ffpcls(outfptr, colnum, firstrow, firstelem, ntodo,
1801                        strarray, status);
1802         }
1803 
1804         else if (typecode == TCOMPLEX)
1805         {                      /* doesn't support writing nulls */
1806             ffpclc(outfptr, colnum, firstrow, firstelem, ntodo,
1807                        fvalues, status);
1808         }
1809 
1810         else if (typecode == TDBLCOMPLEX)
1811         {                      /* doesn't support writing nulls */
1812             ffpclm(outfptr, colnum, firstrow, firstelem, ntodo,
1813                        dvalues, status);
1814         }
1815 
1816         else  /* all other numerical types */
1817         {
1818             if (anynull)
1819                 ffpcnd(outfptr, colnum, firstrow, firstelem, ntodo,
1820                        dvalues, dnull, status);
1821             else
1822                 ffpcld(outfptr, colnum, firstrow, firstelem, ntodo,
1823                        dvalues, status);
1824         }
1825 
1826         if (*status > 0)
1827         {
1828             ffpmsg("Error writing output copy of column (ffcpcl)");
1829             break;
1830         }
1831 
1832         npixels -= ntodo;
1833         ndone += ntodo;
1834         ntodo = minvalue(npixels, maxloop);
1835     }
1836 
1837     /* free the previously allocated memory */
1838     if (typecode == TLOGICAL)
1839     {
1840         free(lvalues);
1841     }
1842     else if (typecode == TSTRING)
1843     {
1844          for (ii = 0; ii < maxloop; ii++)
1845              free(strarray[ii]);
1846 
1847          free(strarray);
1848     }
1849     else
1850     {
1851         free(dvalues);
1852     }
1853 
1854     return(*status);
1855 }
1856 /*--------------------------------------------------------------------------*/
ffccls(fitsfile * infptr,fitsfile * outfptr,int incol,int outcol,int ncols,int create_col,int * status)1857 int ffccls(fitsfile *infptr,    /* I - FITS file pointer to input file  */
1858            fitsfile *outfptr,   /* I - FITS file pointer to output file */
1859            int incol,           /* I - number of first input column   */
1860            int outcol,          /* I - number for first output column  */
1861 	   int ncols,           /* I - number of columns to copy from input to output */
1862            int create_col,      /* I - create new col if TRUE, else overwrite */
1863            int *status)         /* IO - error status     */
1864 /*
1865   copy multiple columns from infptr and insert them in the outfptr
1866   table.  Optimized for multiple-column case since it only expands the
1867   output file once using fits_insert_cols() instead of calling
1868   fits_insert_col() multiple times.
1869 */
1870 {
1871     int tstatus, colnum, typecode, otypecode, anynull;
1872     int inHduType, outHduType;
1873     long tfields, repeat, orepeat, width, owidth, nrows, outrows;
1874     long inloop, outloop, maxloop, ndone, ntodo, npixels;
1875     long firstrow, firstelem, ii;
1876     char keyname[FLEN_KEYWORD], ttype[FLEN_VALUE], tform[FLEN_VALUE];
1877     char ttype_comm[FLEN_COMMENT],tform_comm[FLEN_COMMENT];
1878     char *lvalues = 0, nullflag, **strarray = 0;
1879     char nulstr[] = {'\5', '\0'};  /* unique null string value */
1880     double dnull = 0.l, *dvalues = 0;
1881     float fnull = 0., *fvalues = 0;
1882     int typecodes[1000];
1883     char *ttypes[1000], *tforms[1000], keyarr[1001][FLEN_CARD];
1884     int ikey = 0;
1885     int icol, incol1, outcol1;
1886 
1887     if (*status > 0)
1888         return(*status);
1889 
1890     if (infptr->HDUposition != (infptr->Fptr)->curhdu)
1891     {
1892         ffmahd(infptr, (infptr->HDUposition) + 1, NULL, status);
1893     }
1894     else if ((infptr->Fptr)->datastart == DATA_UNDEFINED)
1895         ffrdef(infptr, status);                /* rescan header */
1896     inHduType = (infptr->Fptr)->hdutype;
1897 
1898     if (outfptr->HDUposition != (outfptr->Fptr)->curhdu)
1899     {
1900         ffmahd(outfptr, (outfptr->HDUposition) + 1, NULL, status);
1901     }
1902     else if ((outfptr->Fptr)->datastart == DATA_UNDEFINED)
1903         ffrdef(outfptr, status);               /* rescan header */
1904     outHduType = (outfptr->Fptr)->hdutype;
1905 
1906     if (*status > 0)
1907         return(*status);
1908 
1909     if (inHduType == IMAGE_HDU || outHduType == IMAGE_HDU)
1910     {
1911        ffpmsg
1912        ("Can not copy columns to or from IMAGE HDUs (ffccls)");
1913        return(*status = NOT_TABLE);
1914     }
1915 
1916     if ( (inHduType == BINARY_TBL &&  outHduType == ASCII_TBL) ||
1917 	 (inHduType == ASCII_TBL  &&  outHduType == BINARY_TBL) )
1918     {
1919        ffpmsg
1920        ("Copying between Binary and ASCII tables is not supported (ffccls)");
1921        return(*status = NOT_BTABLE);
1922     }
1923 
1924     /* Do not allow copying multiple columns in the same HDU because the
1925        permutations of possible overlapping copies is mind-bending */
1926     if ((infptr->Fptr == outfptr->Fptr)
1927 	&& (infptr->HDUposition == outfptr->HDUposition))
1928     {
1929        ffpmsg
1930        ("Copying multiple columns in same HDU is not supported (ffccls)");
1931        return(*status = NOT_BTABLE);
1932     }
1933 
1934     /* Retrieve the number of columns in output file */
1935     tstatus=0;
1936     if (ffgkyj(outfptr, "TFIELDS", &tfields, 0, &tstatus))
1937     {
1938       ffpmsg
1939 	("Could not read TFIELDS keyword in output table (ffccls)");
1940       return(*status = NO_TFIELDS);
1941     }
1942 
1943     colnum = minvalue((int) tfields + 1, outcol); /* output col. number */
1944 
1945     /* Collect data about input column (type, repeat, etc) */
1946     for (incol1 = incol, outcol1 = colnum, icol = 0;
1947 	 icol < ncols;
1948 	 icol++, incol1++, outcol1++)
1949     {
1950       ffgtcl(infptr, incol1, &typecode, &repeat, &width, status);
1951 
1952       if (typecode < 0)
1953 	{
1954 	  ffpmsg("Variable-length columns are not supported (ffccls)");
1955 	  return(*status = BAD_TFORM);
1956 	}
1957 
1958       typecodes[icol] = typecode;
1959 
1960       tstatus = 0;
1961       ffkeyn("TTYPE", incol1, keyname, &tstatus);
1962       ffgkys(infptr, keyname, ttype, ttype_comm, &tstatus);
1963 
1964       ffkeyn("TFORM", incol1, keyname, &tstatus);
1965 
1966       if (ffgkys(infptr, keyname, tform, tform_comm, &tstatus) )
1967         {
1968           ffpmsg
1969 	    ("Could not find TTYPE and TFORM keywords in input table (ffccls)");
1970           return(*status = NO_TFORM);
1971         }
1972 
1973       /* If creating columns, we need to save these values */
1974       if ( create_col ) {
1975 	tforms[icol] = keyarr[ikey++];
1976 	ttypes[icol] = keyarr[ikey++];
1977 
1978 	strcpy(tforms[icol], tform);
1979 	strcpy(ttypes[icol], ttype);
1980       } else {
1981 	/* If not creating columns, then check the datatype and vector
1982 	   repeat length of the output column */
1983         ffgtcl(outfptr, outcol1, &otypecode, &orepeat, &owidth, status);
1984 
1985         if (orepeat != repeat) {
1986             ffpmsg("Input and output vector columns must have same length (ffccls)");
1987             return(*status = BAD_TFORM);
1988         }
1989       }
1990     }
1991 
1992     /* Insert columns into output file and copy all meta-data
1993        keywords, if requested */
1994     if (create_col)
1995     {
1996         /* create the empty columns */
1997         if (fficls(outfptr, colnum, ncols, ttypes, tforms, status) > 0)
1998         {
1999            ffpmsg
2000            ("Could not append new columns to output file (ffccls)");
2001            return(*status);
2002         }
2003 
2004 	/* Copy meta-data strings from input column to output */
2005 	for (incol1 = incol, outcol1 = colnum, icol = 0;
2006 	     icol < ncols;
2007 	     icol++, incol1++, outcol1++)
2008 	{
2009 	  /* copy the comment strings from the input file for TTYPE and TFORM */
2010 	  ffkeyn("TTYPE", incol1, keyname, status);
2011 	  ffgkys(infptr, keyname, ttype, ttype_comm, status);
2012 	  ffkeyn("TTYPE", outcol1, keyname, status);
2013 	  ffmcom(outfptr, keyname, ttype_comm, status);
2014 
2015 	  ffkeyn("TFORM", incol1, keyname, status);
2016 	  ffgkys(infptr, keyname, tform, tform_comm, status);
2017 	  ffkeyn("TFORM", outcol1, keyname, status);
2018 	  ffmcom(outfptr, keyname, tform_comm, status);
2019 
2020 	  /* copy other column-related keywords if they exist */
2021 
2022 	  ffcpky(infptr, outfptr, incol1, outcol1, "TUNIT", status);
2023 	  ffcpky(infptr, outfptr, incol1, outcol1, "TSCAL", status);
2024 	  ffcpky(infptr, outfptr, incol1, outcol1, "TZERO", status);
2025 	  ffcpky(infptr, outfptr, incol1, outcol1, "TDISP", status);
2026 	  ffcpky(infptr, outfptr, incol1, outcol1, "TLMIN", status);
2027 	  ffcpky(infptr, outfptr, incol1, outcol1, "TLMAX", status);
2028 	  ffcpky(infptr, outfptr, incol1, outcol1, "TDIM", status);
2029 
2030 	  /*  WCS keywords */
2031 	  ffcpky(infptr, outfptr, incol1, outcol1, "TCTYP", status);
2032 	  ffcpky(infptr, outfptr, incol1, outcol1, "TCUNI", status);
2033 	  ffcpky(infptr, outfptr, incol1, outcol1, "TCRVL", status);
2034 	  ffcpky(infptr, outfptr, incol1, outcol1, "TCRPX", status);
2035 	  ffcpky(infptr, outfptr, incol1, outcol1, "TCDLT", status);
2036 	  ffcpky(infptr, outfptr, incol1, outcol1, "TCROT", status);
2037 
2038 	  ffcpky(infptr, outfptr, incol1, outcol1, "TNULL", status);
2039 
2040 	}
2041 
2042 	/* rescan header to recognize the new keywords */
2043 	if (ffrdef(outfptr, status) )
2044 	  return(*status);
2045     }
2046 
2047     /* Copy columns using standard ffcpcl(); do this in a loop because
2048        the I/O-intensive column expanding is done */
2049     for (incol1 = incol, outcol1 = colnum, icol = 0;
2050 	 icol < ncols;
2051 	 icol++, incol1++, outcol1++)
2052     {
2053       ffcpcl(infptr, outfptr, incol1, outcol1, 0, status);
2054     }
2055 
2056     return(*status);
2057 }
2058 /*--------------------------------------------------------------------------*/
ffcprw(fitsfile * infptr,fitsfile * outfptr,LONGLONG firstrow,LONGLONG nrows,int * status)2059 int ffcprw(fitsfile *infptr,    /* I - FITS file pointer to input file  */
2060            fitsfile *outfptr,   /* I - FITS file pointer to output file */
2061            LONGLONG firstrow,   /* I - number of first row to copy (1 based)  */
2062            LONGLONG nrows,      /* I - number of rows to copy  */
2063            int *status)         /* IO - error status     */
2064 /*
2065   copy consecutive set of rows from infptr and append it in the outfptr table.
2066 */
2067 {
2068     LONGLONG innaxis1, innaxis2, outnaxis1, outnaxis2, ii, jj, icol;
2069     LONGLONG iVarCol, inPos, outPos, nVarBytes, nVarAllocBytes = 0;
2070     unsigned char *buffer, *varColBuff=0;
2071     int nInVarCols=0, nOutVarCols=0, varColDiff=0;
2072     int *inVarCols=0, *outVarCols=0;
2073     long nNewBlocks;
2074     LONGLONG hrepeat=0, hoffset=0;
2075     tcolumn *colptr=0;
2076 
2077     if (*status > 0)
2078         return(*status);
2079 
2080     if (infptr->HDUposition != (infptr->Fptr)->curhdu)
2081     {
2082         ffmahd(infptr, (infptr->HDUposition) + 1, NULL, status);
2083     }
2084     else if ((infptr->Fptr)->datastart == DATA_UNDEFINED)
2085         ffrdef(infptr, status);                /* rescan header */
2086 
2087     if (outfptr->HDUposition != (outfptr->Fptr)->curhdu)
2088     {
2089         ffmahd(outfptr, (outfptr->HDUposition) + 1, NULL, status);
2090     }
2091     else if ((outfptr->Fptr)->datastart == DATA_UNDEFINED)
2092         ffrdef(outfptr, status);               /* rescan header */
2093 
2094     if (*status > 0)
2095         return(*status);
2096 
2097     if ((infptr->Fptr)->hdutype == IMAGE_HDU || (outfptr->Fptr)->hdutype == IMAGE_HDU)
2098     {
2099        ffpmsg
2100        ("Can not copy rows to or from IMAGE HDUs (ffcprw)");
2101        return(*status = NOT_TABLE);
2102     }
2103 
2104     if ( ((infptr->Fptr)->hdutype == BINARY_TBL &&  (outfptr->Fptr)->hdutype == ASCII_TBL) ||
2105          ((infptr->Fptr)->hdutype == ASCII_TBL &&  (outfptr->Fptr)->hdutype == BINARY_TBL) )
2106     {
2107        ffpmsg
2108        ("Copying rows between Binary and ASCII tables is not supported (ffcprw)");
2109        return(*status = NOT_BTABLE);
2110     }
2111 
2112     ffgkyjj(infptr,  "NAXIS1", &innaxis1,  0, status);  /* width of input rows */
2113     ffgkyjj(infptr,  "NAXIS2", &innaxis2,  0, status);  /* no. of input rows */
2114     ffgkyjj(outfptr, "NAXIS1", &outnaxis1, 0, status);  /* width of output rows */
2115     ffgkyjj(outfptr, "NAXIS2", &outnaxis2, 0, status);  /* no. of output rows */
2116 
2117     if (*status > 0)
2118         return(*status);
2119 
2120     if (outnaxis1 != innaxis1) {
2121        ffpmsg
2122        ("Input and output tables do not have same width (ffcprw)");
2123        return(*status = BAD_ROW_WIDTH);
2124     }
2125 
2126     if (firstrow + nrows - 1 > innaxis2) {
2127        ffpmsg
2128        ("Not enough rows in input table to copy (ffcprw)");
2129        return(*status = BAD_ROW_NUM);
2130     }
2131 
2132     if ((infptr->Fptr)->tfield != (outfptr->Fptr)->tfield)
2133     {
2134        ffpmsg
2135        ("Input and output tables do not have same number of columns (ffcprw)");
2136        return(*status = BAD_COL_NUM);
2137     }
2138 
2139     /* allocate buffer to hold 1 row of data */
2140     buffer = malloc( (size_t) innaxis1);
2141     if (!buffer) {
2142        ffpmsg
2143        ("Unable to allocate memory (ffcprw)");
2144        return(*status = MEMORY_ALLOCATION);
2145     }
2146 
2147     inVarCols = malloc(infptr->Fptr->tfield*sizeof(int));
2148     outVarCols = malloc(outfptr->Fptr->tfield*sizeof(int));
2149     fffvcl(infptr, &nInVarCols, inVarCols, status);
2150     fffvcl(outfptr, &nOutVarCols, outVarCols, status);
2151     if (nInVarCols != nOutVarCols)
2152        varColDiff=1;
2153     else
2154     {
2155        for (ii=0; ii<nInVarCols; ++ii)
2156        {
2157           if (inVarCols[ii] != outVarCols[ii])
2158           {
2159              varColDiff=1;
2160              break;
2161           }
2162        }
2163     }
2164 
2165     if (varColDiff)
2166     {
2167        ffpmsg("Input and output tables have different variable columns (ffcprw)");
2168        *status = BAD_COL_NUM;
2169        goto CLEANUP_RETURN;
2170     }
2171 
2172     jj = outnaxis2 + 1;
2173     if (nInVarCols)
2174     {
2175        ffirow(outfptr, outnaxis2, nrows, status);
2176        for (ii = firstrow; ii < firstrow + nrows; ii++)
2177        {
2178           fits_read_tblbytes (infptr, ii, 1, innaxis1, buffer, status);
2179           fits_write_tblbytes(outfptr, jj, 1, innaxis1, buffer, status);
2180           /* Now make corrections for variable length columns */
2181           iVarCol=0;
2182           colptr = (infptr->Fptr)->tableptr;
2183           for (icol=0; icol<(infptr->Fptr)->tfield; ++icol)
2184           {
2185              if (iVarCol < nInVarCols && inVarCols[iVarCol] == icol+1)
2186              {
2187                 /* Copy from a variable length column */
2188 
2189                 ffgdesll(infptr, icol+1, ii, &hrepeat, &hoffset, status);
2190                 /* If this is a bit column, hrepeat will be number of
2191                    bits, not bytes. If it is a string column, hrepeat
2192 		   is the number of bytes, twidth is the max col width
2193 		   and can be ignored.*/
2194                 if (colptr->tdatatype == -TBIT)
2195 		{
2196 		   nVarBytes = (hrepeat+7)/8;
2197 		}
2198 		else if (colptr->tdatatype == -TSTRING)
2199 		{
2200 		   nVarBytes = hrepeat;
2201 		}
2202 		else
2203 		{
2204 		   nVarBytes = hrepeat*colptr->twidth*sizeof(char);
2205 		}
2206                 inPos = (infptr->Fptr)->datastart + (infptr->Fptr)->heapstart
2207 				+ hoffset;
2208 		outPos = (outfptr->Fptr)->datastart + (outfptr->Fptr)->heapstart
2209 				+ (outfptr->Fptr)->heapsize;
2210                 ffmbyt(infptr, inPos, REPORT_EOF, status);
2211 		/* If this is not the last HDU in the file, then check if */
2212 		/* extending the heap would overwrite the following header. */
2213 		/* If so, then have to insert more blocks. */
2214                 if ( !((outfptr->Fptr)->lasthdu) )
2215                 {
2216 		   if (outPos+nVarBytes >
2217 		      (outfptr->Fptr)->headstart[(outfptr->Fptr)->curhdu+1])
2218 		   {
2219 		      nNewBlocks = (long)(((outPos+nVarBytes - 1 -
2220                         (outfptr->Fptr)->headstart[(outfptr->Fptr)->
2221                         curhdu+1]) / 2880) + 1);
2222                       if (ffiblk(outfptr, nNewBlocks, 1, status) > 0)
2223                       {
2224                          ffpmsg("Failed to extend the size of the variable length heap (ffcprw)");
2225 			 goto CLEANUP_RETURN;
2226                       }
2227 
2228 		   }
2229                 }
2230                 if (nVarBytes)
2231 		{
2232 		   if (nVarBytes > nVarAllocBytes)
2233 		   {
2234 		     /* Grow the copy buffer to accomodate the new maximum size.
2235 			Note it is safe to call realloc() with null input pointer,
2236 			which is equivalent to malloc(). */
2237 		     unsigned char *varColBuff1 = (unsigned char *) realloc(varColBuff, nVarBytes);
2238 		     if (! varColBuff1)
2239 		     {
2240 		       *status = MEMORY_ALLOCATION;
2241 		       ffpmsg("failed to allocate memory for variable column copy (ffcprw)");
2242 		       goto CLEANUP_RETURN;
2243 		     }
2244 		     /* Record the new state */
2245 		     varColBuff = varColBuff1;
2246 		     nVarAllocBytes = nVarBytes;
2247 		   }
2248 		   /* Copy date from input to output */
2249                    ffgbyt(infptr, nVarBytes, varColBuff, status);
2250 		   ffmbyt(outfptr, outPos, IGNORE_EOF, status);
2251                    ffpbyt(outfptr, nVarBytes, varColBuff, status);
2252 		}
2253 		ffpdes(outfptr, icol+1, jj, hrepeat, (outfptr->Fptr)->heapsize, status);
2254                 (outfptr->Fptr)->heapsize += nVarBytes;
2255                 ++iVarCol;
2256              }
2257              ++colptr;
2258           }
2259           ++jj;
2260        }
2261     }
2262     else
2263     {
2264        /* copy the rows, 1 at a time */
2265        for (ii = firstrow; ii < firstrow + nrows; ii++) {
2266            fits_read_tblbytes (infptr,  ii, 1, innaxis1, buffer, status);
2267            fits_write_tblbytes(outfptr, jj, 1, innaxis1, buffer, status);
2268            jj++;
2269        }
2270     }
2271     outnaxis2 += nrows;
2272     fits_update_key(outfptr, TLONGLONG, "NAXIS2", &outnaxis2, 0, status);
2273 
2274  CLEANUP_RETURN:
2275     free(buffer);
2276     free(inVarCols);
2277     free(outVarCols);
2278     if (varColBuff) free(varColBuff);
2279     return(*status);
2280 }
2281 /*--------------------------------------------------------------------------*/
ffcpky(fitsfile * infptr,fitsfile * outfptr,int incol,int outcol,char * rootname,int * status)2282 int ffcpky(fitsfile *infptr,    /* I - FITS file pointer to input file  */
2283            fitsfile *outfptr,   /* I - FITS file pointer to output file */
2284            int incol,           /* I - input index number   */
2285            int outcol,          /* I - output index number  */
2286            char *rootname,      /* I - root name of the keyword to be copied */
2287            int *status)         /* IO - error status     */
2288 /*
2289   copy an indexed keyword from infptr to outfptr.
2290 */
2291 {
2292     int tstatus = 0;
2293     char keyname[FLEN_KEYWORD];
2294     char value[FLEN_VALUE], comment[FLEN_COMMENT], card[FLEN_CARD];
2295 
2296     ffkeyn(rootname, incol, keyname, &tstatus);
2297     if (ffgkey(infptr, keyname, value, comment, &tstatus) <= 0)
2298     {
2299         ffkeyn(rootname, outcol, keyname, &tstatus);
2300         ffmkky(keyname, value, comment, card, status);
2301         ffprec(outfptr, card, status);
2302     }
2303     return(*status);
2304 }
2305 /*--------------------------------------------------------------------------*/
ffdcol(fitsfile * fptr,int colnum,int * status)2306 int ffdcol(fitsfile *fptr,  /* I - FITS file pointer                        */
2307            int colnum,      /* I - column to delete (1 = 1st)               */
2308            int *status)     /* IO - error status                            */
2309 /*
2310   Delete a column from a table.
2311 */
2312 {
2313     int ii, tstatus;
2314     LONGLONG firstbyte, size, ndelete, nbytes, naxis1, naxis2, firstcol, delbyte, freespace;
2315     LONGLONG tbcol;
2316     long nblock, nspace;
2317     char keyname[FLEN_KEYWORD], comm[FLEN_COMMENT];
2318     tcolumn *colptr, *nextcol;
2319 
2320     if (*status > 0)
2321         return(*status);
2322 
2323     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
2324     {
2325         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
2326     }
2327     /* rescan header if data structure is undefined */
2328     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
2329         if ( ffrdef(fptr, status) > 0)
2330             return(*status);
2331 
2332     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
2333     {
2334        ffpmsg
2335        ("Can only delete column from TABLE or BINTABLE extension (ffdcol)");
2336        return(*status = NOT_TABLE);
2337     }
2338 
2339     if (colnum < 1 || colnum > (fptr->Fptr)->tfield )
2340         return(*status = BAD_COL_NUM);
2341 
2342     colptr = (fptr->Fptr)->tableptr;
2343     colptr += (colnum - 1);
2344     firstcol = colptr->tbcol;  /* starting byte position of the column */
2345 
2346     /* use column width to determine how many bytes to delete in each row */
2347     if ((fptr->Fptr)->hdutype == ASCII_TBL)
2348     {
2349       delbyte = colptr->twidth;  /* width of ASCII column */
2350 
2351       if (colnum < (fptr->Fptr)->tfield) /* check for space between next column */
2352       {
2353         nextcol = colptr + 1;
2354         nspace = (long) ((nextcol->tbcol) - (colptr->tbcol) - delbyte);
2355         if (nspace > 0)
2356             delbyte++;
2357       }
2358       else if (colnum > 1)   /* check for space between last 2 columns */
2359       {
2360         nextcol = colptr - 1;
2361         nspace = (long) ((colptr->tbcol) - (nextcol->tbcol) - (nextcol->twidth));
2362         if (nspace > 0)
2363         {
2364            delbyte++;
2365            firstcol--;  /* delete the leading space */
2366         }
2367       }
2368     }
2369     else   /* a binary table */
2370     {
2371       if (colnum < (fptr->Fptr)->tfield)
2372       {
2373          nextcol = colptr + 1;
2374          delbyte = (nextcol->tbcol) - (colptr->tbcol);
2375       }
2376       else
2377       {
2378          delbyte = ((fptr->Fptr)->rowlength) - (colptr->tbcol);
2379       }
2380     }
2381 
2382     naxis1 = (fptr->Fptr)->rowlength;   /* current width of the table */
2383     naxis2 = (fptr->Fptr)->numrows;
2384 
2385     /* current size of table */
2386     size = (fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize;
2387     freespace = ((LONGLONG)delbyte * naxis2) + ((size + 2879) / 2880) * 2880 - size;
2388     nblock = (long) (freespace / 2880);   /* number of empty blocks to delete */
2389 
2390     ffcdel(fptr, naxis1, naxis2, delbyte, firstcol, status); /* delete col */
2391 
2392     /* absolute heap position */
2393     firstbyte = (fptr->Fptr)->datastart + (fptr->Fptr)->heapstart;
2394     ndelete = (LONGLONG)delbyte * naxis2; /* size of shift */
2395 
2396     /* shift heap up (if it exists) */
2397     if ((fptr->Fptr)->heapsize > 0)
2398     {
2399       nbytes = (fptr->Fptr)->heapsize;    /* no. of bytes to shift up */
2400 
2401       if (ffshft(fptr, firstbyte, nbytes, -ndelete, status) > 0) /* mv heap */
2402           return(*status);
2403     }
2404 
2405     /* delete the empty  blocks at the end of the HDU */
2406     if (nblock > 0)
2407         ffdblk(fptr, nblock, status);
2408 
2409     /* update the heap starting address */
2410     (fptr->Fptr)->heapstart -= ndelete;
2411 
2412     /* update the THEAP keyword if it exists */
2413     tstatus = 0;
2414     ffmkyj(fptr, "THEAP", (long)(fptr->Fptr)->heapstart, "&", &tstatus);
2415 
2416     if ((fptr->Fptr)->hdutype == ASCII_TBL)
2417     {
2418       /* adjust the TBCOL values of the remaining columns */
2419       for (ii = 1; ii <= (fptr->Fptr)->tfield; ii++)
2420       {
2421         ffkeyn("TBCOL", ii, keyname, status);
2422         ffgkyjj(fptr, keyname, &tbcol, comm, status);
2423         if (tbcol > firstcol)
2424         {
2425           tbcol = tbcol - delbyte;
2426           ffmkyj(fptr, keyname, tbcol, "&", status);
2427         }
2428       }
2429     }
2430 
2431     /* update the mandatory keywords */
2432     ffmkyj(fptr, "TFIELDS", ((fptr->Fptr)->tfield) - 1, "&", status);
2433     ffmkyj(fptr,  "NAXIS1",   naxis1 - delbyte, "&", status);
2434     /*
2435       delete the index keywords starting with 'T' associated with the
2436       deleted column and subtract 1 from index of all higher keywords
2437     */
2438     ffkshf(fptr, colnum, (fptr->Fptr)->tfield, -1, status);
2439 
2440     ffrdef(fptr, status);  /* initialize the new table structure */
2441     return(*status);
2442 }
2443 /*--------------------------------------------------------------------------*/
ffcins(fitsfile * fptr,LONGLONG naxis1,LONGLONG naxis2,LONGLONG ninsert,LONGLONG bytepos,int * status)2444 int ffcins(fitsfile *fptr,  /* I - FITS file pointer                        */
2445            LONGLONG naxis1,     /* I - width of the table, in bytes             */
2446            LONGLONG naxis2,     /* I - number of rows in the table              */
2447            LONGLONG ninsert,    /* I - number of bytes to insert in each row    */
2448            LONGLONG bytepos,    /* I - rel. position in row to insert bytes     */
2449            int *status)     /* IO - error status                            */
2450 /*
2451  Insert 'ninsert' bytes into each row of the table at position 'bytepos'.
2452 */
2453 {
2454     unsigned char buffer[10000], cfill;
2455     LONGLONG newlen, fbyte, nbytes, irow, nseg, ii;
2456 
2457     if (*status > 0)
2458         return(*status);
2459 
2460     if (naxis2 == 0)
2461         return(*status);  /* just return if there are 0 rows in the table */
2462 
2463     /* select appropriate fill value */
2464     if ((fptr->Fptr)->hdutype == ASCII_TBL)
2465         cfill = 32;                     /* ASCII tables use blank fill */
2466     else
2467         cfill = 0;    /* primary array and binary tables use zero fill */
2468 
2469     newlen = naxis1 + ninsert;
2470 
2471     if (newlen <= 10000)
2472     {
2473        /*******************************************************************
2474        CASE #1: optimal case where whole new row fits in the work buffer
2475        *******************************************************************/
2476 
2477         for (ii = 0; ii < ninsert; ii++)
2478             buffer[ii] = cfill;      /* initialize buffer with fill value */
2479 
2480         /* first move the trailing bytes (if any) in the last row */
2481         fbyte = bytepos + 1;
2482         nbytes = naxis1 - bytepos;
2483         /* If the last row hasn't yet been accessed in full, it's possible
2484            that logfilesize hasn't been updated to account for it (by way
2485            of an ffldrc call).  This could cause ffgtbb to return with an
2486            EOF error.  To prevent this, we must increase logfilesize here.
2487         */
2488         if ((fptr->Fptr)->logfilesize < (fptr->Fptr)->datastart +
2489                  (fptr->Fptr)->heapstart)
2490         {
2491             (fptr->Fptr)->logfilesize = (((fptr->Fptr)->datastart +
2492                  (fptr->Fptr)->heapstart + 2879)/2880)*2880;
2493         }
2494 
2495         ffgtbb(fptr, naxis2, fbyte, nbytes, &buffer[ninsert], status);
2496         (fptr->Fptr)->rowlength = newlen; /*  new row length */
2497 
2498         /* write the row (with leading fill bytes) in the new place */
2499         nbytes += ninsert;
2500         ffptbb(fptr, naxis2, fbyte, nbytes, buffer, status);
2501         (fptr->Fptr)->rowlength = naxis1;  /* reset to orig. value */
2502 
2503         /*  now move the rest of the rows */
2504         for (irow = naxis2 - 1; irow > 0; irow--)
2505         {
2506             /* read the row to be shifted (work backwards thru the table) */
2507             ffgtbb(fptr, irow, fbyte, naxis1, &buffer[ninsert], status);
2508             (fptr->Fptr)->rowlength = newlen; /* new row length */
2509 
2510             /* write the row (with the leading fill bytes) in the new place */
2511             ffptbb(fptr, irow, fbyte, newlen, buffer, status);
2512             (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
2513         }
2514     }
2515     else
2516     {
2517         /*****************************************************************
2518         CASE #2:  whole row doesn't fit in work buffer; move row in pieces
2519         ******************************************************************
2520         first copy the data, then go back and write fill into the new column
2521         start by copying the trailing bytes (if any) in the last row.     */
2522 
2523         nbytes = naxis1 - bytepos;
2524         nseg = (nbytes + 9999) / 10000;
2525         fbyte = (nseg - 1) * 10000 + bytepos + 1;
2526         nbytes = naxis1 - fbyte + 1;
2527 
2528         for (ii = 0; ii < nseg; ii++)
2529         {
2530             ffgtbb(fptr, naxis2, fbyte, nbytes, buffer, status);
2531             (fptr->Fptr)->rowlength =   newlen;  /* new row length */
2532 
2533             ffptbb(fptr, naxis2, fbyte + ninsert, nbytes, buffer, status);
2534             (fptr->Fptr)->rowlength =   naxis1; /* reset to orig value */
2535 
2536             fbyte -= 10000;
2537             nbytes = 10000;
2538         }
2539 
2540         /* now move the rest of the rows */
2541         nseg = (naxis1 + 9999) / 10000;
2542         for (irow = naxis2 - 1; irow > 0; irow--)
2543         {
2544           fbyte = (nseg - 1) * 10000 + bytepos + 1;
2545           nbytes = naxis1 - (nseg - 1) * 10000;
2546           for (ii = 0; ii < nseg; ii++)
2547           {
2548             /* read the row to be shifted (work backwards thru the table) */
2549             ffgtbb(fptr, irow, fbyte, nbytes, buffer, status);
2550             (fptr->Fptr)->rowlength =   newlen;  /* new row length */
2551 
2552             /* write the row in the new place */
2553             ffptbb(fptr, irow, fbyte + ninsert, nbytes, buffer, status);
2554             (fptr->Fptr)->rowlength =   naxis1; /* reset to orig value */
2555 
2556             fbyte -= 10000;
2557             nbytes = 10000;
2558           }
2559         }
2560 
2561         /* now write the fill values into the new column */
2562         nbytes = minvalue(ninsert, 10000);
2563         memset(buffer, cfill, (size_t) nbytes); /* initialize with fill value */
2564 
2565         nseg = (ninsert + 9999) / 10000;
2566         (fptr->Fptr)->rowlength =  newlen;  /* new row length */
2567 
2568         for (irow = 1; irow <= naxis2; irow++)
2569         {
2570           fbyte = bytepos + 1;
2571           nbytes = ninsert - ((nseg - 1) * 10000);
2572           for (ii = 0; ii < nseg; ii++)
2573           {
2574             ffptbb(fptr, irow, fbyte, nbytes, buffer, status);
2575             fbyte += nbytes;
2576             nbytes = 10000;
2577           }
2578         }
2579         (fptr->Fptr)->rowlength = naxis1;  /* reset to orig value */
2580     }
2581     return(*status);
2582 }
2583 /*--------------------------------------------------------------------------*/
ffcdel(fitsfile * fptr,LONGLONG naxis1,LONGLONG naxis2,LONGLONG ndelete,LONGLONG bytepos,int * status)2584 int ffcdel(fitsfile *fptr,  /* I - FITS file pointer                        */
2585            LONGLONG naxis1,     /* I - width of the table, in bytes             */
2586            LONGLONG naxis2,     /* I - number of rows in the table              */
2587            LONGLONG ndelete,    /* I - number of bytes to delete in each row    */
2588            LONGLONG bytepos,    /* I - rel. position in row to delete bytes     */
2589            int *status)     /* IO - error status                            */
2590 /*
2591  delete 'ndelete' bytes from each row of the table at position 'bytepos'.  */
2592 {
2593     unsigned char buffer[10000];
2594     LONGLONG i1, i2, ii, irow, nseg;
2595     LONGLONG newlen, remain, nbytes;
2596 
2597     if (*status > 0)
2598         return(*status);
2599 
2600     if (naxis2 == 0)
2601         return(*status);  /* just return if there are 0 rows in the table */
2602 
2603     newlen = naxis1 - ndelete;
2604 
2605     if (newlen <= 10000)
2606     {
2607       /*******************************************************************
2608       CASE #1: optimal case where whole new row fits in the work buffer
2609       *******************************************************************/
2610       i1 = bytepos + 1;
2611       i2 = i1 + ndelete;
2612       for (irow = 1; irow < naxis2; irow++)
2613       {
2614         ffgtbb(fptr, irow, i2, newlen, buffer, status); /* read row */
2615         (fptr->Fptr)->rowlength = newlen;  /* new row length */
2616 
2617         ffptbb(fptr, irow, i1, newlen, buffer, status); /* write row */
2618         (fptr->Fptr)->rowlength = naxis1;  /* reset to orig value */
2619       }
2620 
2621       /* now do the last row */
2622       remain = naxis1 - (bytepos + ndelete);
2623 
2624       if (remain > 0)
2625       {
2626         ffgtbb(fptr, naxis2, i2, remain, buffer, status); /* read row */
2627         (fptr->Fptr)->rowlength = newlen;  /* new row length */
2628 
2629         ffptbb(fptr, naxis2, i1, remain, buffer, status); /* write row */
2630         (fptr->Fptr)->rowlength = naxis1;  /* reset to orig value */
2631       }
2632     }
2633     else
2634     {
2635         /*****************************************************************
2636         CASE #2:  whole row doesn't fit in work buffer; move row in pieces
2637         ******************************************************************/
2638 
2639         nseg = (newlen + 9999) / 10000;
2640         for (irow = 1; irow < naxis2; irow++)
2641         {
2642           i1 = bytepos + 1;
2643           i2 = i1 + ndelete;
2644 
2645           nbytes = newlen - (nseg - 1) * 10000;
2646           for (ii = 0; ii < nseg; ii++)
2647           {
2648             ffgtbb(fptr, irow, i2, nbytes, buffer, status); /* read bytes */
2649             (fptr->Fptr)->rowlength = newlen;  /* new row length */
2650 
2651             ffptbb(fptr, irow, i1, nbytes, buffer, status); /* rewrite bytes */
2652             (fptr->Fptr)->rowlength = naxis1; /* reset to orig value */
2653 
2654             i1 += nbytes;
2655             i2 += nbytes;
2656             nbytes = 10000;
2657           }
2658         }
2659 
2660         /* now do the last row */
2661         remain = naxis1 - (bytepos + ndelete);
2662 
2663         if (remain > 0)
2664         {
2665           nseg = (remain + 9999) / 10000;
2666           i1 = bytepos + 1;
2667           i2 = i1 + ndelete;
2668           nbytes = remain - (nseg - 1) * 10000;
2669           for (ii = 0; ii < nseg; ii++)
2670           {
2671             ffgtbb(fptr, naxis2, i2, nbytes, buffer, status);
2672             (fptr->Fptr)->rowlength = newlen;  /* new row length */
2673 
2674             ffptbb(fptr, naxis2, i1, nbytes, buffer, status); /* write row */
2675             (fptr->Fptr)->rowlength = naxis1;  /* reset to orig value */
2676 
2677             i1 += nbytes;
2678             i2 += nbytes;
2679             nbytes = 10000;
2680           }
2681         }
2682     }
2683     return(*status);
2684 }
2685 /*--------------------------------------------------------------------------*/
ffkshf(fitsfile * fptr,int colmin,int colmax,int incre,int * status)2686 int ffkshf(fitsfile *fptr,  /* I - FITS file pointer                        */
2687            int colmin,      /* I - starting col. to be incremented; 1 = 1st */
2688            int colmax,      /* I - last column to be incremented            */
2689            int incre,       /* I - shift index number by this amount        */
2690            int *status)     /* IO - error status                            */
2691 /*
2692   shift the index value on any existing column keywords
2693   This routine will modify the name of any keyword that begins with 'T'
2694   and has an index number in the range COLMIN - COLMAX, inclusive.
2695 
2696   if incre is positive, then the index values will be incremented.
2697   if incre is negative, then the kewords with index = COLMIN
2698   will be deleted and the index of higher numbered keywords will
2699   be decremented.
2700 */
2701 {
2702     int nkeys, nmore, nrec, tstatus, i1;
2703     long ivalue;
2704     char rec[FLEN_CARD], q[FLEN_KEYWORD], newkey[FLEN_KEYWORD];
2705 
2706     ffghsp(fptr, &nkeys, &nmore, status);  /* get number of keywords */
2707 
2708     /* go thru header starting with the 9th keyword looking for 'TxxxxNNN' */
2709 
2710     for (nrec = 9; nrec <= nkeys; nrec++)
2711     {
2712         ffgrec(fptr, nrec, rec, status);
2713 
2714         if (rec[0] == 'T')
2715         {
2716             i1 = 0;
2717             strncpy(q, &rec[1], 4);
2718             if (!strncmp(q, "BCOL", 4) || !strncmp(q, "FORM", 4) ||
2719                 !strncmp(q, "TYPE", 4) || !strncmp(q, "SCAL", 4) ||
2720                 !strncmp(q, "UNIT", 4) || !strncmp(q, "NULL", 4) ||
2721                 !strncmp(q, "ZERO", 4) || !strncmp(q, "DISP", 4) ||
2722                 !strncmp(q, "LMIN", 4) || !strncmp(q, "LMAX", 4) ||
2723                 !strncmp(q, "DMIN", 4) || !strncmp(q, "DMAX", 4) ||
2724                 !strncmp(q, "CTYP", 4) || !strncmp(q, "CRPX", 4) ||
2725                 !strncmp(q, "CRVL", 4) || !strncmp(q, "CDLT", 4) ||
2726                 !strncmp(q, "CROT", 4) || !strncmp(q, "CUNI", 4) )
2727               i1 = 5;
2728             else if (!strncmp(rec, "TDIM", 4) )
2729               i1 = 4;
2730 
2731             if (i1)
2732             {
2733               /* try reading the index number suffix */
2734               q[0] = '\0';
2735               strncat(q, &rec[i1], 8 - i1);
2736 
2737               tstatus = 0;
2738               ffc2ii(q, &ivalue, &tstatus);
2739 
2740               if (tstatus == 0 && ivalue >= colmin && ivalue <= colmax)
2741               {
2742                 if (incre <= 0 && ivalue == colmin)
2743                 {
2744                   ffdrec(fptr, nrec, status); /* delete keyword */
2745                   nkeys = nkeys - 1;
2746                   nrec = nrec - 1;
2747                 }
2748                 else
2749                 {
2750                   ivalue = ivalue + incre;
2751                   q[0] = '\0';
2752                   strncat(q, rec, i1);
2753 
2754                   ffkeyn(q, ivalue, newkey, status);
2755 		  /* NOTE: because of null termination, it is not
2756 		     equivalent to use strcpy() for the same calls */
2757                   strncpy(rec, "        ", 8);    /* erase old keyword name */
2758                   i1 = strlen(newkey);
2759                   strncpy(rec, newkey, i1);   /* overwrite new keyword name */
2760                   ffmrec(fptr, nrec, rec, status);  /* modify the record */
2761                 }
2762               }
2763             }
2764         }
2765     }
2766     return(*status);
2767 }
2768 /*--------------------------------------------------------------------------*/
fffvcl(fitsfile * fptr,int * nvarcols,int * colnums,int * status)2769 int fffvcl(fitsfile *fptr,   /* I - FITS file pointer                       */
2770            int *nvarcols,    /* O - Number of variable length columns found */
2771            int *colnums,     /* O - 1-based variable column positions       */
2772            int *status)      /* IO - error status                           */
2773 {
2774 /*
2775    Internal function to identify which columns in a binary table are variable length.
2776    The colnums array will be filled with nvarcols elements - the 1-based numbers
2777    of all variable length columns in the table.  This ASSUMES calling function
2778    has passed in a colnums array large enough to hold these.
2779 */
2780    int tfields=0,icol;
2781    tcolumn *colptr=0;
2782 
2783    *nvarcols = 0;
2784    if (*status > 0)
2785        return(*status);
2786 
2787    if ((fptr->Fptr)->hdutype != BINARY_TBL)
2788    {
2789       ffpmsg("Var-length column search can only be performed on Binary tables (fffvcl)");
2790       return(*status = NOT_BTABLE);
2791    }
2792 
2793    if ((fptr->Fptr)->tableptr)
2794    {
2795       colptr = (fptr->Fptr)->tableptr;
2796       tfields = (fptr->Fptr)->tfield;
2797       for (icol=0; icol<tfields; ++icol, ++colptr)
2798       {
2799          /* Condition for variable length column: negative tdatatype */
2800          if (colptr->tdatatype < 0)
2801          {
2802             colnums[*nvarcols] = icol + 1;
2803             *nvarcols += 1;
2804          }
2805       }
2806    }
2807    return(*status);
2808 }
2809 
2810 /*--------------------------------------------------------------------------*/
ffshft(fitsfile * fptr,LONGLONG firstbyte,LONGLONG nbytes,LONGLONG nshift,int * status)2811 int ffshft(fitsfile *fptr,  /* I - FITS file pointer                        */
2812            LONGLONG firstbyte, /* I - position of first byte in block to shift */
2813            LONGLONG nbytes,    /* I - size of block of bytes to shift          */
2814            LONGLONG nshift,    /* I - size of shift in bytes (+ or -)          */
2815            int *status)     /* IO - error status                            */
2816 /*
2817     Shift block of bytes by nshift bytes (positive or negative).
2818     A positive nshift value moves the block down further in the file, while a
2819     negative value shifts the block towards the beginning of the file.
2820 */
2821 {
2822 #define shftbuffsize 100000
2823     long ntomov;
2824     LONGLONG ptr, ntodo;
2825     char buffer[shftbuffsize];
2826 
2827     if (*status > 0)
2828         return(*status);
2829 
2830     ntodo = nbytes;   /* total number of bytes to shift */
2831 
2832     if (nshift > 0)
2833             /* start at the end of the block and work backwards */
2834             ptr = firstbyte + nbytes;
2835     else
2836             /* start at the beginning of the block working forwards */
2837             ptr = firstbyte;
2838 
2839     while (ntodo)
2840     {
2841         /* number of bytes to move at one time */
2842         ntomov = (long) (minvalue(ntodo, shftbuffsize));
2843 
2844         if (nshift > 0)     /* if moving block down ... */
2845             ptr -= ntomov;
2846 
2847         /* move to position and read the bytes to be moved */
2848 
2849         ffmbyt(fptr, ptr, REPORT_EOF, status);
2850         ffgbyt(fptr, ntomov, buffer, status);
2851 
2852         /* move by shift amount and write the bytes */
2853         ffmbyt(fptr, ptr + nshift, IGNORE_EOF, status);
2854         if (ffpbyt(fptr, ntomov, buffer, status) > 0)
2855         {
2856            ffpmsg("Error while shifting block (ffshft)");
2857            return(*status);
2858         }
2859 
2860         ntodo -= ntomov;
2861         if (nshift < 0)     /* if moving block up ... */
2862             ptr += ntomov;
2863     }
2864 
2865     /* now overwrite the old data with fill */
2866     if ((fptr->Fptr)->hdutype == ASCII_TBL)
2867        memset(buffer, 32, shftbuffsize); /* fill ASCII tables with spaces */
2868     else
2869        memset(buffer,  0, shftbuffsize); /* fill other HDUs with zeros */
2870 
2871 
2872     if (nshift < 0)
2873     {
2874         ntodo = -nshift;
2875         /* point to the end of the shifted block */
2876         ptr = firstbyte + nbytes + nshift;
2877     }
2878     else
2879     {
2880         ntodo = nshift;
2881         /* point to original beginning of the block */
2882         ptr = firstbyte;
2883     }
2884 
2885     ffmbyt(fptr, ptr, REPORT_EOF, status);
2886 
2887     while (ntodo)
2888     {
2889         ntomov = (long) (minvalue(ntodo, shftbuffsize));
2890         ffpbyt(fptr, ntomov, buffer, status);
2891         ntodo -= ntomov;
2892     }
2893     return(*status);
2894 }
2895