From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001 From: Joe Hunkeler Date: Tue, 11 Aug 2015 16:51:37 -0400 Subject: Repatch (from linux) of OSX IRAF --- pkg/tbtables/cfitsio/edithdu.c | 793 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 793 insertions(+) create mode 100644 pkg/tbtables/cfitsio/edithdu.c (limited to 'pkg/tbtables/cfitsio/edithdu.c') diff --git a/pkg/tbtables/cfitsio/edithdu.c b/pkg/tbtables/cfitsio/edithdu.c new file mode 100644 index 00000000..5baac075 --- /dev/null +++ b/pkg/tbtables/cfitsio/edithdu.c @@ -0,0 +1,793 @@ +/* This file, edithdu.c, contains the FITSIO routines related to */ +/* copying, inserting, or deleting HDUs in a FITS file */ + +/* The FITSIO software was written by William Pence at the High Energy */ +/* Astrophysic Science Archive Research Center (HEASARC) at the NASA */ +/* Goddard Space Flight Center. */ + +#include +#include +#include "fitsio2.h" +/*--------------------------------------------------------------------------*/ +int ffcopy(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int morekeys, /* I - reserve space in output header */ + int *status) /* IO - error status */ +/* + copy the CHDU from infptr to the CHDU of outfptr. + This will also allocate space in the output header for MOREKY keywords +*/ +{ + if (*status > 0) + return(*status); + + if (infptr == outfptr) + return(*status = SAME_FILE); + + if (ffcphd(infptr, outfptr, status) ) /* copy the header keywords */ + return(*status); + + if (morekeys > 0) + ffhdef(outfptr, morekeys, status); /* reserve space for more keywords */ + + ffcpdt(infptr, outfptr, status); /* now copy the data unit */ + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcpfl(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int previous, /* I - copy any previous HDUs? */ + int current, /* I - copy the current HDU? */ + int following, /* I - copy any following HDUs? */ + int *status) /* IO - error status */ +/* + copy all or part of the input file to the output file. +*/ +{ + int hdunum, ii; + + if (*status > 0) + return(*status); + + if (infptr == outfptr) + return(*status = SAME_FILE); + + ffghdn(infptr, &hdunum); + + if (previous) { /* copy any previous HDUs */ + for (ii=1; ii < hdunum; ii++) { + ffmahd(infptr, ii, NULL, status); + ffcopy(infptr, outfptr, 0, status); + } + } + + if (current && (*status <= 0) ) { /* copy current HDU */ + ffmahd(infptr, hdunum, NULL, status); + ffcopy(infptr, outfptr, 0, status); + } + + if (following && (*status <= 0) ) { /* copy any remaining HDUs */ + ii = hdunum + 1; + while (1) + { + if (ffmahd(infptr, ii, NULL, status) ) { + /* reset expected end of file status */ + if (*status == END_OF_FILE) + *status = 0; + break; + } + + if (ffcopy(infptr, outfptr, 0, status)) + break; /* quit on unexpected error */ + + ii++; + } + } + + ffmahd(infptr, hdunum, NULL, status); /* restore initial position */ + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcphd(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int *status) /* IO - error status */ +/* + copy the header keywords from infptr to outfptr. +*/ +{ + int nkeys, ii, inPrim = 0, outPrim = 0; + long naxis, naxes[1]; + char *card, comm[FLEN_COMMENT]; + char *tmpbuff = NULL; + + if (*status > 0) + return(*status); + + if (infptr == outfptr) + return(*status = SAME_FILE); + + /* set the input pointer to the correct HDU */ + if (infptr->HDUposition != (infptr->Fptr)->curhdu) + ffmahd(infptr, (infptr->HDUposition) + 1, NULL, status); + + if (ffghsp(infptr, &nkeys, NULL, status) > 0) /* get no. of keywords */ + return(*status); + + /* create a memory buffer to hold the header records */ + tmpbuff = (char*) malloc(nkeys*FLEN_CARD*sizeof(char)); + if (!tmpbuff) + return(*status = MEMORY_ALLOCATION); + + /* read all of the header records in the input HDU */ + for (ii = 0; ii < nkeys; ii++) + ffgrec(infptr, ii+1, tmpbuff + (ii * FLEN_CARD), status); + + if (infptr->HDUposition == 0) /* set flag if this is the Primary HDU */ + inPrim = 1; + + /* if input is an image hdu, get the number of axes */ + naxis = -1; /* negative if HDU is a table */ + if ((infptr->Fptr)->hdutype == IMAGE_HDU) + ffgkyj(infptr, "NAXIS", &naxis, NULL, status); + + /* set the output pointer to the correct HDU */ + if (outfptr->HDUposition != (outfptr->Fptr)->curhdu) + ffmahd(outfptr, (outfptr->HDUposition) + 1, NULL, status); + + /* check if output header is empty; if not create new empty HDU */ + if ((outfptr->Fptr)->headend != + (outfptr->Fptr)->headstart[(outfptr->Fptr)->curhdu] ) + ffcrhd(outfptr, status); + + if (outfptr->HDUposition == 0) + { + if (naxis < 0) + { + /* the input HDU is a table, so we have to create */ + /* a dummy Primary array before copying it to the output */ + ffcrim(outfptr, 8, 0, naxes, status); + ffcrhd(outfptr, status); /* create new empty HDU */ + } + else + { + /* set flag that this is the Primary HDU */ + outPrim = 1; + } + } + + if (*status > 0) /* check for errors before proceeding */ + { + free(tmpbuff); + return(*status); + } + if ( inPrim == 1 && outPrim == 0 ) + { + /* copying from primary array to image extension */ + strcpy(comm, "IMAGE extension"); + ffpkys(outfptr, "XTENSION", "IMAGE", comm, status); + + /* copy BITPIX through NAXISn keywords */ + for (ii = 1; ii < 3 + naxis; ii++) + { + card = tmpbuff + (ii * FLEN_CARD); + ffprec(outfptr, card, status); + } + + strcpy(comm, "number of random group parameters"); + ffpkyj(outfptr, "PCOUNT", 0, comm, status); + + strcpy(comm, "number of random groups"); + ffpkyj(outfptr, "GCOUNT", 1, comm, status); + + + /* copy remaining keywords, excluding EXTEND, and reference COMMENT keywords */ + for (ii = 3 + naxis ; ii < nkeys; ii++) + { + card = tmpbuff+(ii * FLEN_CARD); + if (FSTRNCMP(card, "EXTEND ", 8) && + FSTRNCMP(card, "COMMENT FITS (Flexible Image Transport System) format is", 58) && + FSTRNCMP(card, "COMMENT and Astrophysics', volume 376, page 3", 47) ) + { + ffprec(outfptr, card, status); + } + } + } + else if ( inPrim == 0 && outPrim == 1 ) + { + /* copying between image extension and primary array */ + strcpy(comm, "file does conform to FITS standard"); + ffpkyl(outfptr, "SIMPLE", TRUE, comm, status); + + /* copy BITPIX through NAXISn keywords */ + for (ii = 1; ii < 3 + naxis; ii++) + { + card = tmpbuff + (ii * FLEN_CARD); + ffprec(outfptr, card, status); + } + + /* add the EXTEND keyword */ + strcpy(comm, "FITS dataset may contain extensions"); + ffpkyl(outfptr, "EXTEND", TRUE, comm, status); + + /* write standard block of self-documentating comments */ + ffprec(outfptr, + "COMMENT FITS (Flexible Image Transport System) format is defined in 'Astronomy", + status); + ffprec(outfptr, + "COMMENT and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H", + status); + + /* copy remaining keywords, excluding pcount, gcount */ + for (ii = 3 + naxis; ii < nkeys; ii++) + { + card = tmpbuff+(ii * FLEN_CARD); + if (FSTRNCMP(card, "PCOUNT ", 8) && FSTRNCMP(card, "GCOUNT ", 8)) + { + ffprec(outfptr, card, status); + } + } + } + else + { + /* input and output HDUs are same type; simply copy all keywords */ + for (ii = 0; ii < nkeys; ii++) + { + card = tmpbuff+(ii * FLEN_CARD); + ffprec(outfptr, card, status); + } + } + + free(tmpbuff); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffcpdt(fitsfile *infptr, /* I - FITS file pointer to input file */ + fitsfile *outfptr, /* I - FITS file pointer to output file */ + int *status) /* IO - error status */ +{ +/* + copy the data unit from the CHDU of infptr to the CHDU of outfptr. + This will overwrite any data already in the outfptr CHDU. +*/ + long nb, ii; + OFF_T indatastart, indataend, outdatastart; + char buffer[2880]; + + if (*status > 0) + return(*status); + + if (infptr == outfptr) + return(*status = SAME_FILE); + + ffghof(infptr, NULL, &indatastart, &indataend, status); + ffghof(outfptr, NULL, &outdatastart, NULL, status); + + /* Calculate the number of blocks to be copied */ + nb = (indataend - indatastart) / 2880; + + if (nb > 0) + { + if (infptr->Fptr == outfptr->Fptr) + { + /* copying between 2 HDUs in the SAME file */ + for (ii = 0; ii < nb; ii++) + { + ffmbyt(infptr, indatastart, REPORT_EOF, status); + ffgbyt(infptr, 2880L, buffer, status); /* read input block */ + + ffmbyt(outfptr, outdatastart, IGNORE_EOF, status); + ffpbyt(outfptr, 2880L, buffer, status); /* write output block */ + + indatastart += 2880; /* move address */ + outdatastart += 2880; /* move address */ + } + } + else + { + /* copying between HDUs in separate files */ + /* move to the initial copy position in each of the files */ + ffmbyt(infptr, indatastart, REPORT_EOF, status); + ffmbyt(outfptr, outdatastart, IGNORE_EOF, status); + + for (ii = 0; ii < nb; ii++) + { + ffgbyt(infptr, 2880L, buffer, status); /* read input block */ + ffpbyt(outfptr, 2880L, buffer, status); /* write output block */ + } + } + } + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffiimg(fitsfile *fptr, /* I - FITS file pointer */ + int bitpix, /* I - bits per pixel */ + int naxis, /* I - number of axes in the array */ + long *naxes, /* I - size of each axis */ + int *status) /* IO - error status */ +/* + insert an IMAGE extension following the current HDU +*/ +{ + int bytlen, nexthdu, maxhdu, ii, onaxis; + long nblocks; + OFF_T npixels, newstart, datasize; + char errmsg[FLEN_ERRMSG], card[FLEN_CARD], naxiskey[FLEN_KEYWORD]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + maxhdu = (fptr->Fptr)->maxhdu; + + if (*status != PREPEND_PRIMARY) + { + /* if the current header is completely empty ... */ + if (( (fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu]) + /* or, if we are at the end of the file, ... */ + || ( (((fptr->Fptr)->curhdu) == maxhdu ) && + ((fptr->Fptr)->headstart[maxhdu + 1] >= (fptr->Fptr)->logfilesize ) ) ) + { + /* then simply append new image extension */ + ffcrim(fptr, bitpix, naxis, naxes, status); + return(*status); + } + } + + if (bitpix == 8) + bytlen = 1; + else if (bitpix == 16) + bytlen = 2; + else if (bitpix == 32 || bitpix == -32) + bytlen = 4; + else if (bitpix == -64) + bytlen = 8; + else + { + sprintf(errmsg, + "Illegal value for BITPIX keyword: %d", bitpix); + ffpmsg(errmsg); + return(*status = BAD_BITPIX); /* illegal bitpix value */ + } + if (naxis < 0 || naxis > 999) + { + sprintf(errmsg, + "Illegal value for NAXIS keyword: %d", naxis); + ffpmsg(errmsg); + return(*status = BAD_NAXIS); + } + + for (ii = 0; ii < naxis; ii++) + { + if (naxes[ii] < 0) + { + sprintf(errmsg, + "Illegal value for NAXIS%d keyword: %ld", ii + 1, naxes[ii]); + ffpmsg(errmsg); + return(*status = BAD_NAXES); + } + } + + /* calculate number of pixels in the image */ + if (naxis == 0) + npixels = 0; + else + npixels = naxes[0]; + + for (ii = 1; ii < naxis; ii++) + npixels = npixels * naxes[ii]; + + datasize = npixels * bytlen; /* size of image in bytes */ + nblocks = ((datasize + 2879) / 2880) + 1; /* +1 for the header */ + + if ((fptr->Fptr)->writemode == READWRITE) /* must have write access */ + { /* close the CHDU */ + ffrdef(fptr, status); /* scan header to redefine structure */ + ffpdfl(fptr, status); /* insure correct data file values */ + } + else + return(*status = READONLY_FILE); + + if (*status == PREPEND_PRIMARY) + { + /* inserting a new primary array; the current primary */ + /* array must be transformed into an image extension. */ + + *status = 0; + ffmahd(fptr, 1, NULL, status); /* move to the primary array */ + + ffgidm(fptr, &onaxis, status); + if (onaxis > 0) + ffkeyn("NAXIS",onaxis, naxiskey, status); + else + strcpy(naxiskey, "NAXIS"); + + ffgcrd(fptr, naxiskey, card, status); /* read last NAXIS keyword */ + + ffikyj(fptr, "PCOUNT", 0L, "required keyword", status); /* add PCOUNT and */ + ffikyj(fptr, "GCOUNT", 1L, "required keyword", status); /* GCOUNT keywords */ + + if (*status > 0) + return(*status); + + if (ffdkey(fptr, "EXTEND", status) ) /* delete the EXTEND keyword */ + *status = 0; + + /* redefine internal structure for this HDU */ + ffrdef(fptr, status); + + + /* insert space for the primary array */ + if (ffiblk(fptr, nblocks, -1, status) > 0) /* insert the blocks */ + return(*status); + + nexthdu = 0; /* number of the new hdu */ + newstart = 0; /* starting addr of HDU */ + } + else + { + nexthdu = ((fptr->Fptr)->curhdu) + 1; /* number of the next (new) hdu */ + newstart = (fptr->Fptr)->headstart[nexthdu]; /* save starting addr of HDU */ + + (fptr->Fptr)->hdutype = IMAGE_HDU; /* so that correct fill value is used */ + /* ffiblk also increments headstart for all following HDUs */ + if (ffiblk(fptr, nblocks, 1, status) > 0) /* insert the blocks */ + return(*status); + } + + ((fptr->Fptr)->maxhdu)++; /* increment known number of HDUs in the file */ + for (ii = (fptr->Fptr)->maxhdu; ii > (fptr->Fptr)->curhdu; ii--) + (fptr->Fptr)->headstart[ii + 1] = (fptr->Fptr)->headstart[ii]; /* incre start addr */ + + if (nexthdu == 0) + (fptr->Fptr)->headstart[1] = nblocks * 2880; /* start of the old Primary array */ + + (fptr->Fptr)->headstart[nexthdu] = newstart; /* set starting addr of HDU */ + + /* set default parameters for this new empty HDU */ + (fptr->Fptr)->curhdu = nexthdu; /* we are now located at the next HDU */ + fptr->HDUposition = nexthdu; /* we are now located at the next HDU */ + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->headend = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->datastart = ((fptr->Fptr)->headstart[nexthdu]) + 2880; + (fptr->Fptr)->hdutype = IMAGE_HDU; /* might need to be reset... */ + + /* write the required header keywords */ + ffphpr(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status); + + /* redefine internal structure for this HDU */ + ffrdef(fptr, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffitab(fitsfile *fptr, /* I - FITS file pointer */ + long naxis1, /* I - width of row in the table */ + long naxis2, /* I - number of rows in the table */ + int tfields, /* I - number of columns in the table */ + char **ttype, /* I - name of each column */ + long *tbcol, /* I - byte offset in row to each column */ + char **tform, /* I - value of TFORMn keyword for each column */ + char **tunit, /* I - value of TUNITn keyword for each column */ + char *extnm, /* I - value of EXTNAME keyword, if any */ + int *status) /* IO - error status */ +/* + insert an ASCII table extension following the current HDU +*/ +{ + int nexthdu, maxhdu, ii, nunit, nhead, ncols, gotmem = 0; + long nblocks, rowlen; + OFF_T datasize, newstart; + char errmsg[81]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + maxhdu = (fptr->Fptr)->maxhdu; + /* if the current header is completely empty ... */ + if (( (fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + /* or, if we are at the end of the file, ... */ + || ( (((fptr->Fptr)->curhdu) == maxhdu ) && + ((fptr->Fptr)->headstart[maxhdu + 1] >= (fptr->Fptr)->logfilesize ) ) ) + { + /* then simply append new image extension */ + ffcrtb(fptr, ASCII_TBL, naxis2, tfields, ttype, tform, tunit, + extnm, status); + return(*status); + } + + if (naxis1 < 0) + return(*status = NEG_WIDTH); + else if (naxis2 < 0) + return(*status = NEG_ROWS); + else if (tfields < 0 || tfields > 999) + { + sprintf(errmsg, + "Illegal value for TFIELDS keyword: %d", tfields); + ffpmsg(errmsg); + return(*status = BAD_TFIELDS); + } + + /* count number of optional TUNIT keywords to be written */ + nunit = 0; + for (ii = 0; ii < tfields; ii++) + { + if (tunit && *tunit && *tunit[ii]) + nunit++; + } + + if (extnm && *extnm) + nunit++; /* add one for the EXTNAME keyword */ + + rowlen = naxis1; + + if (!tbcol || !tbcol[0] || (!naxis1 && tfields)) /* spacing not defined? */ + { + /* allocate mem for tbcol; malloc may have problems allocating small */ + /* arrays, so allocate at least 20 bytes */ + + ncols = maxvalue(5, tfields); + tbcol = (long *) calloc(ncols, sizeof(long)); + + if (tbcol) + { + gotmem = 1; + + /* calculate width of a row and starting position of each column. */ + /* Each column will be separated by 1 blank space */ + ffgabc(tfields, tform, 1, &rowlen, tbcol, status); + } + } + + nhead = (9 + (3 * tfields) + nunit + 35) / 36; /* no. of header blocks */ + datasize = (OFF_T)rowlen * naxis2; /* size of table in bytes */ + nblocks = ((datasize + 2879) / 2880) + nhead; /* size of HDU */ + + if ((fptr->Fptr)->writemode == READWRITE) /* must have write access */ + { /* close the CHDU */ + ffrdef(fptr, status); /* scan header to redefine structure */ + ffpdfl(fptr, status); /* insure correct data file values */ + } + else + return(*status = READONLY_FILE); + + nexthdu = ((fptr->Fptr)->curhdu) + 1; /* number of the next (new) hdu */ + newstart = (fptr->Fptr)->headstart[nexthdu]; /* save starting addr of HDU */ + + (fptr->Fptr)->hdutype = ASCII_TBL; /* so that correct fill value is used */ + /* ffiblk also increments headstart for all following HDUs */ + if (ffiblk(fptr, nblocks, 1, status) > 0) /* insert the blocks */ + { + if (gotmem) + free(tbcol); + return(*status); + } + + ((fptr->Fptr)->maxhdu)++; /* increment known number of HDUs in the file */ + for (ii = (fptr->Fptr)->maxhdu; ii > (fptr->Fptr)->curhdu; ii--) + (fptr->Fptr)->headstart[ii + 1] = (fptr->Fptr)->headstart[ii]; /* incre start addr */ + + (fptr->Fptr)->headstart[nexthdu] = newstart; /* set starting addr of HDU */ + + /* set default parameters for this new empty HDU */ + (fptr->Fptr)->curhdu = nexthdu; /* we are now located at the next HDU */ + fptr->HDUposition = nexthdu; /* we are now located at the next HDU */ + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->headend = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->datastart = ((fptr->Fptr)->headstart[nexthdu]) + (nhead * 2880); + (fptr->Fptr)->hdutype = ASCII_TBL; /* might need to be reset... */ + + /* write the required header keywords */ + + ffphtb(fptr, rowlen, naxis2, tfields, ttype, tbcol, tform, tunit, + extnm, status); + + if (gotmem) + free(tbcol); + + /* redefine internal structure for this HDU */ + + ffrdef(fptr, status); + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffibin(fitsfile *fptr, /* I - FITS file pointer */ + long naxis2, /* I - number of rows in the table */ + int tfields, /* I - number of columns in the table */ + char **ttype, /* I - name of each column */ + char **tform, /* I - value of TFORMn keyword for each column */ + char **tunit, /* I - value of TUNITn keyword for each column */ + char *extnm, /* I - value of EXTNAME keyword, if any */ + long pcount, /* I - size of special data area (heap) */ + int *status) /* IO - error status */ +/* + insert a Binary table extension following the current HDU +*/ +{ + int nexthdu, maxhdu, ii, nunit, nhead, datacode; + long naxis1, nblocks, repeat, width; + OFF_T datasize, newstart; + char errmsg[81]; + + if (*status > 0) + return(*status); + + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + maxhdu = (fptr->Fptr)->maxhdu; + /* if the current header is completely empty ... */ + if (( (fptr->Fptr)->headend == (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) + /* or, if we are at the end of the file, ... */ + || ( (((fptr->Fptr)->curhdu) == maxhdu ) && + ((fptr->Fptr)->headstart[maxhdu + 1] >= (fptr->Fptr)->logfilesize ) ) ) + { + /* then simply append new image extension */ + ffcrtb(fptr, BINARY_TBL, naxis2, tfields, ttype, tform, tunit, + extnm, status); + return(*status); + } + + if (naxis2 < 0) + return(*status = NEG_ROWS); + else if (tfields < 0 || tfields > 999) + { + sprintf(errmsg, + "Illegal value for TFIELDS keyword: %d", tfields); + ffpmsg(errmsg); + return(*status = BAD_TFIELDS); + } + + /* count number of optional TUNIT keywords to be written */ + nunit = 0; + for (ii = 0; ii < tfields; ii++) + { + if (tunit && *tunit && *tunit[ii]) + nunit++; + } + + if (extnm && *extnm) + nunit++; /* add one for the EXTNAME keyword */ + + nhead = (9 + (2 * tfields) + nunit + 35) / 36; /* no. of header blocks */ + + /* calculate total width of the table */ + naxis1 = 0; + for (ii = 0; ii < tfields; ii++) + { + ffbnfm(tform[ii], &datacode, &repeat, &width, status); + + if (datacode == TBIT) + naxis1 = naxis1 + ((repeat + 7) / 8); + else if (datacode == TSTRING) + naxis1 += repeat; + else + naxis1 = naxis1 + (repeat * width); + } + + datasize = ((OFF_T)naxis1 * naxis2) + pcount; /* size of table in bytes */ + nblocks = ((datasize + 2879) / 2880) + nhead; /* size of HDU */ + + if ((fptr->Fptr)->writemode == READWRITE) /* must have write access */ + { /* close the CHDU */ + ffrdef(fptr, status); /* scan header to redefine structure */ + ffpdfl(fptr, status); /* insure correct data file values */ + } + else + return(*status = READONLY_FILE); + + nexthdu = ((fptr->Fptr)->curhdu) + 1; /* number of the next (new) hdu */ + newstart = (fptr->Fptr)->headstart[nexthdu]; /* save starting addr of HDU */ + + (fptr->Fptr)->hdutype = BINARY_TBL; /* so that correct fill value is used */ + + /* ffiblk also increments headstart for all following HDUs */ + if (ffiblk(fptr, nblocks, 1, status) > 0) /* insert the blocks */ + return(*status); + + ((fptr->Fptr)->maxhdu)++; /* increment known number of HDUs in the file */ + for (ii = (fptr->Fptr)->maxhdu; ii > (fptr->Fptr)->curhdu; ii--) + (fptr->Fptr)->headstart[ii + 1] = (fptr->Fptr)->headstart[ii]; /* incre start addr */ + + (fptr->Fptr)->headstart[nexthdu] = newstart; /* set starting addr of HDU */ + + /* set default parameters for this new empty HDU */ + (fptr->Fptr)->curhdu = nexthdu; /* we are now located at the next HDU */ + fptr->HDUposition = nexthdu; /* we are now located at the next HDU */ + (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->headend = (fptr->Fptr)->headstart[nexthdu]; + (fptr->Fptr)->datastart = ((fptr->Fptr)->headstart[nexthdu]) + (nhead * 2880); + (fptr->Fptr)->hdutype = BINARY_TBL; /* might need to be reset... */ + + /* write the required header keywords. This will write PCOUNT = 0 */ + /* so that the variable length data will be written at the right place */ + ffphbn(fptr, naxis2, tfields, ttype, tform, tunit, extnm, pcount, + status); + + /* redefine internal structure for this HDU (with PCOUNT = 0) */ + ffrdef(fptr, status); + + return(*status); +} +/*--------------------------------------------------------------------------*/ +int ffdhdu(fitsfile *fptr, /* I - FITS file pointer */ + int *hdutype, /* O - type of the new CHDU after deletion */ + int *status) /* IO - error status */ +/* + Delete the CHDU. If the CHDU is the primary array, then replace the HDU + with an empty primary array with no data. Return the + type of the new CHDU after the old CHDU is deleted. +*/ +{ + int tmptype = 0; + long nblocks, ii, naxes[1]; + + if (*status > 0) + return(*status); + + if (fptr->HDUposition != (fptr->Fptr)->curhdu) + ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status); + + if ((fptr->Fptr)->curhdu == 0) /* replace primary array with null image */ + { + /* ignore any existing keywords */ + (fptr->Fptr)->headend = 0; + (fptr->Fptr)->nextkey = 0; + + /* write default primary array header */ + ffphpr(fptr,1,8,0,naxes,0,1,1,status); + + /* calc number of blocks to delete (leave just 1 block) */ + nblocks = ( (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu + 1] - + 2880 ) / 2880; + + /* ffdblk also updates the starting address of all following HDUs */ + if (nblocks > 0) + { + if (ffdblk(fptr, nblocks, status) > 0) /* delete the HDU */ + return(*status); + } + + /* this might not be necessary, but is doesn't hurt */ + (fptr->Fptr)->datastart = DATA_UNDEFINED; + + ffrdef(fptr, status); /* reinitialize the primary array */ + } + else + { + + /* calc number of blocks to delete */ + nblocks = ( (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu + 1] - + (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] ) / 2880; + + /* ffdblk also updates the starting address of all following HDUs */ + if (ffdblk(fptr, nblocks, status) > 0) /* delete the HDU */ + return(*status); + + /* delete the CHDU from the list of HDUs */ + for (ii = (fptr->Fptr)->curhdu + 1; ii <= (fptr->Fptr)->maxhdu; ii++) + (fptr->Fptr)->headstart[ii] = (fptr->Fptr)->headstart[ii + 1]; + + (fptr->Fptr)->headstart[(fptr->Fptr)->maxhdu + 1] = 0; + ((fptr->Fptr)->maxhdu)--; /* decrement the known number of HDUs */ + + if (ffrhdu(fptr, &tmptype, status) > 0) /* initialize next HDU */ + { + /* failed (end of file?), so move back one HDU */ + *status = 0; + ffcmsg(); /* clear extraneous error messages */ + ffgext(fptr, ((fptr->Fptr)->curhdu) - 1, &tmptype, status); + } + } + + if (hdutype) + *hdutype = tmptype; + + return(*status); +} + -- cgit