"Fossies" - the Fresh Open Source Software Archive

Member "cfitsio-4.0.0/putkey.c" (20 May 2021, 115360 Bytes) of package /linux/misc/cfitsio-4.0.0.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "putkey.c" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 3.49_vs_4.0.0.

    1 /*  This file, putkey.c, contains routines that write keywords to          */
    2 /*  a FITS header.                                                         */
    3 
    4 /*  The FITSIO software was written by William Pence at the High Energy    */
    5 /*  Astrophysic Science Archive Research Center (HEASARC) at the NASA      */
    6 /*  Goddard Space Flight Center.                                           */
    7 
    8 #include <string.h>
    9 #include <stdlib.h>
   10 #include <ctype.h>
   11 #include <time.h>
   12 /* stddef.h is apparently needed to define size_t */
   13 #include <stddef.h>
   14 #include "fitsio2.h"
   15 
   16 /*--------------------------------------------------------------------------*/
   17 int ffcrim(fitsfile *fptr,      /* I - FITS file pointer           */
   18            int bitpix,          /* I - bits per pixel              */
   19            int naxis,           /* I - number of axes in the array */
   20            long *naxes,         /* I - size of each axis           */
   21            int *status)         /* IO - error status               */
   22 /*
   23   create an IMAGE extension following the current HDU. If the
   24   current HDU is empty (contains no header keywords), then simply
   25   write the required image (or primary array) keywords to the current
   26   HDU. 
   27 */
   28 {
   29     if (*status > 0)
   30         return(*status);
   31 
   32     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
   33         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
   34 
   35     /* create new extension if current header is not empty */
   36     if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
   37         ffcrhd(fptr, status);
   38 
   39     /* write the required header keywords */
   40     ffphpr(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status);
   41 
   42     return(*status);
   43 }
   44 /*--------------------------------------------------------------------------*/
   45 int ffcrimll(fitsfile *fptr,    /* I - FITS file pointer           */
   46            int bitpix,          /* I - bits per pixel              */
   47            int naxis,           /* I - number of axes in the array */
   48            LONGLONG *naxes,     /* I - size of each axis           */
   49            int *status)         /* IO - error status               */
   50 /*
   51   create an IMAGE extension following the current HDU. If the
   52   current HDU is empty (contains no header keywords), then simply
   53   write the required image (or primary array) keywords to the current
   54   HDU. 
   55 */
   56 {
   57     if (*status > 0)
   58         return(*status);
   59 
   60     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
   61         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
   62 
   63     /* create new extension if current header is not empty */
   64     if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
   65         ffcrhd(fptr, status);
   66 
   67     /* write the required header keywords */
   68     ffphprll(fptr, TRUE, bitpix, naxis, naxes, 0, 1, TRUE, status);
   69 
   70     return(*status);
   71 }
   72 /*--------------------------------------------------------------------------*/
   73 int ffcrtb(fitsfile *fptr,  /* I - FITS file pointer                        */
   74            int tbltype,     /* I - type of table to create                  */
   75            LONGLONG naxis2, /* I - number of rows in the table              */
   76            int tfields,     /* I - number of columns in the table           */
   77            char **ttype,    /* I - name of each column                      */
   78            char **tform,    /* I - value of TFORMn keyword for each column  */
   79            char **tunit,    /* I - value of TUNITn keyword for each column  */
   80            const char *extnm, /* I - value of EXTNAME keyword, if any         */
   81            int *status)     /* IO - error status                            */
   82 /*
   83   Create a table extension in a FITS file. 
   84 */
   85 {
   86     LONGLONG naxis1 = 0;
   87     long *tbcol = 0;
   88 
   89     if (*status > 0)
   90         return(*status);
   91 
   92     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
   93         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
   94 
   95     /* create new extension if current header is not empty */
   96     if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
   97         ffcrhd(fptr, status);
   98 
   99     if ((fptr->Fptr)->curhdu == 0)  /* have to create dummy primary array */
  100     {
  101        ffcrim(fptr, 16, 0, tbcol, status);
  102        ffcrhd(fptr, status);
  103     }
  104     
  105     if (tbltype == BINARY_TBL)
  106     {
  107       /* write the required header keywords. This will write PCOUNT = 0 */
  108       ffphbn(fptr, naxis2, tfields, ttype, tform, tunit, extnm, 0, status);
  109     }
  110     else if (tbltype == ASCII_TBL)
  111     {
  112       /* write the required header keywords */
  113       /* default values for naxis1 and tbcol will be calculated */
  114       ffphtb(fptr, naxis1, naxis2, tfields, ttype, tbcol, tform, tunit,
  115              extnm, status);
  116     }
  117     else
  118       *status = NOT_TABLE;
  119 
  120     return(*status);
  121 }
  122 /*-------------------------------------------------------------------------*/
  123 int ffpktp(fitsfile *fptr,       /* I - FITS file pointer       */
  124            const char *filename, /* I - name of template file   */
  125            int *status)          /* IO - error status           */
  126 /*
  127   read keywords from template file and append to the FITS file
  128 */
  129 {
  130     FILE *diskfile;
  131     char card[FLEN_CARD], template[161];
  132     char keyname[FLEN_KEYWORD], newname[FLEN_KEYWORD];
  133     int keytype;
  134     size_t slen;
  135 
  136     if (*status > 0)           /* inherit input status value if > 0 */
  137         return(*status);
  138 
  139     diskfile = fopen(filename,"r"); 
  140     if (!diskfile)          /* couldn't open file */
  141     {
  142             ffpmsg("ffpktp could not open the following template file:");
  143             ffpmsg(filename);
  144             return(*status = FILE_NOT_OPENED); 
  145     }
  146 
  147     while (fgets(template, 160, diskfile) )  /* get next template line */
  148     {
  149       template[160] = '\0';      /* make sure string is terminated */
  150       slen = strlen(template);   /* get string length */
  151       template[slen - 1] = '\0';  /* over write the 'newline' char */
  152 
  153       if (ffgthd(template, card, &keytype, status) > 0) /* parse template */
  154          break;
  155 
  156       strncpy(keyname, card, 8);
  157       keyname[8] = '\0';
  158 
  159       if (keytype == -2)            /* rename the card */
  160       {
  161          strncpy(newname, &card[40], 8);
  162          newname[8] = '\0';
  163 
  164          ffmnam(fptr, keyname, newname, status); 
  165       }
  166       else if (keytype == -1)      /* delete the card */
  167       {
  168          ffdkey(fptr, keyname, status);
  169       }
  170       else if (keytype == 0)       /* update the card */
  171       {
  172          ffucrd(fptr, keyname, card, status);
  173       }
  174       else if (keytype == 1)      /* append the card */
  175       {
  176          ffprec(fptr, card, status);
  177       }
  178       else    /* END card; stop here */
  179       {
  180          break; 
  181       }
  182     }
  183 
  184     fclose(diskfile);   /* close the template file */
  185     return(*status);
  186 }
  187 /*--------------------------------------------------------------------------*/
  188 int ffpky( fitsfile *fptr,     /* I - FITS file pointer        */
  189            int  datatype,      /* I - datatype of the value    */
  190            const char *keyname,/* I - name of keyword to write */
  191            void *value,        /* I - keyword value            */
  192            const char *comm,   /* I - keyword comment          */
  193            int  *status)       /* IO - error status            */
  194 /*
  195   Write (put) the keyword, value and comment into the FITS header.
  196   Writes a keyword value with the datatype specified by the 2nd argument.
  197 */
  198 {
  199     char errmsg[FLEN_ERRMSG];
  200 
  201     if (*status > 0)           /* inherit input status value if > 0 */
  202         return(*status);
  203 
  204     if (datatype == TSTRING)
  205     {
  206         ffpkys(fptr, keyname, (char *) value, comm, status);
  207     }
  208     else if (datatype == TBYTE)
  209     {
  210         ffpkyj(fptr, keyname, (LONGLONG) *(unsigned char *) value, comm, status);
  211     }
  212     else if (datatype == TSBYTE)
  213     {
  214         ffpkyj(fptr, keyname, (LONGLONG) *(signed char *) value, comm, status);
  215     }
  216     else if (datatype == TUSHORT)
  217     {
  218         ffpkyj(fptr, keyname, (LONGLONG) *(unsigned short *) value, comm, status);
  219     }
  220     else if (datatype == TSHORT)
  221     {
  222         ffpkyj(fptr, keyname, (LONGLONG) *(short *) value, comm, status);
  223     }
  224     else if (datatype == TUINT)
  225     {
  226         ffpkyg(fptr, keyname, (double) *(unsigned int *) value, 0,
  227                comm, status);
  228     }
  229     else if (datatype == TINT)
  230     {
  231         ffpkyj(fptr, keyname, (LONGLONG) *(int *) value, comm, status);
  232     }
  233     else if (datatype == TLOGICAL)
  234     {
  235         ffpkyl(fptr, keyname, *(int *) value, comm, status);
  236     }
  237     else if (datatype == TULONG)
  238     {
  239         ffpkyuj(fptr, keyname, (ULONGLONG) *(unsigned long *) value,
  240                comm, status);
  241     }
  242     else if (datatype == TULONGLONG)
  243     {
  244         ffpkyuj(fptr, keyname, (ULONGLONG) *(ULONGLONG *) value,
  245                comm, status);
  246     }
  247     else if (datatype == TLONG)
  248     {
  249         ffpkyj(fptr, keyname, (LONGLONG) *(long *) value, comm, status);
  250     }
  251     else if (datatype == TLONGLONG)
  252     {
  253         ffpkyj(fptr, keyname, *(LONGLONG *) value, comm, status);
  254     }
  255     else if (datatype == TFLOAT)
  256     {
  257         ffpkye(fptr, keyname, *(float *) value, -7, comm, status);
  258     }
  259     else if (datatype == TDOUBLE)
  260     {
  261         ffpkyd(fptr, keyname, *(double *) value, -15, comm, status);
  262     }
  263     else if (datatype == TCOMPLEX)
  264     {
  265         ffpkyc(fptr, keyname, (float *) value, -7, comm, status);
  266     }
  267     else if (datatype == TDBLCOMPLEX)
  268     {
  269         ffpkym(fptr, keyname, (double *) value, -15, comm, status);
  270     }
  271     else
  272     {
  273         snprintf(errmsg, FLEN_ERRMSG,"Bad keyword datatype code: %d (ffpky)", datatype);
  274         ffpmsg(errmsg);
  275         *status = BAD_DATATYPE;
  276     }
  277 
  278     return(*status);
  279 } 
  280 /*-------------------------------------------------------------------------*/
  281 int ffprec(fitsfile *fptr,     /* I - FITS file pointer        */
  282            const char *card,   /* I - string to be written     */
  283            int *status)        /* IO - error status            */
  284 /*
  285   write a keyword record (80 bytes long) to the end of the header
  286 */
  287 {
  288     char tcard[FLEN_CARD];
  289     size_t len, ii;
  290     long nblocks;
  291     int keylength;
  292 
  293     if (*status > 0)           /* inherit input status value if > 0 */
  294         return(*status);
  295 
  296     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
  297         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
  298 
  299     if ( ((fptr->Fptr)->datastart - (fptr->Fptr)->headend) == 80) /* no room */
  300     {
  301         nblocks = 1;
  302         if (ffiblk(fptr, nblocks, 0, status) > 0) /* insert 2880-byte block */
  303             return(*status);  
  304     }
  305 
  306     strncpy(tcard,card,80);
  307     tcard[80] = '\0';
  308 
  309     len = strlen(tcard);
  310 
  311     /* silently replace any illegal characters with a space */
  312     for (ii=0; ii < len; ii++)   
  313         if (tcard[ii] < ' ' || tcard[ii] > 126) tcard[ii] = ' ';
  314 
  315     for (ii=len; ii < 80; ii++)    /* fill card with spaces if necessary */
  316         tcard[ii] = ' ';
  317 
  318     keylength = strcspn(tcard, "=");   /* support for free-format keywords */
  319     if (keylength == 80) keylength = 8;
  320     
  321     /* test for the common commentary keywords which by definition have 8-char names */
  322     if ( !fits_strncasecmp( "COMMENT ", tcard, 8) || !fits_strncasecmp( "HISTORY ", tcard, 8) ||
  323          !fits_strncasecmp( "        ", tcard, 8) || !fits_strncasecmp( "CONTINUE", tcard, 8) )
  324      keylength = 8;
  325 
  326     for (ii=0; ii < keylength; ii++)       /* make sure keyword name is uppercase */
  327         tcard[ii] = toupper(tcard[ii]);
  328 
  329     fftkey(tcard, status);        /* test keyword name contains legal chars */
  330 
  331 /*  no need to do this any more, since any illegal characters have been removed
  332     fftrec(tcard, status);  */        /* test rest of keyword for legal chars */
  333 
  334     ffmbyt(fptr, (fptr->Fptr)->headend, IGNORE_EOF, status); /* move to end */
  335 
  336     ffpbyt(fptr, 80, tcard, status);   /* write the 80 byte card */
  337 
  338     if (*status <= 0)
  339        (fptr->Fptr)->headend += 80;    /* update end-of-header position */
  340 
  341     return(*status);
  342 }
  343 /*--------------------------------------------------------------------------*/
  344 int ffpkyu( fitsfile *fptr,     /* I - FITS file pointer        */
  345             const char *keyname,/* I - name of keyword to write */
  346             const char *comm,   /* I - keyword comment          */
  347             int  *status)       /* IO - error status            */
  348 /*
  349   Write (put) a null-valued keyword and comment into the FITS header.  
  350 */
  351 {
  352     char valstring[FLEN_VALUE];
  353     char card[FLEN_CARD];
  354 
  355     if (*status > 0)           /* inherit input status value if > 0 */
  356         return(*status);
  357 
  358     strcpy(valstring," ");  /* create a dummy value string */
  359     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword */
  360     ffprec(fptr, card, status);
  361 
  362     return(*status);
  363 }
  364 /*--------------------------------------------------------------------------*/
  365 int ffpkys( fitsfile *fptr,     /* I - FITS file pointer        */
  366             const char *keyname,/* I - name of keyword to write */
  367             const char *value,  /* I - keyword value            */
  368             const char *comm,   /* I - keyword comment          */
  369             int  *status)       /* IO - error status            */
  370 /*
  371   Write (put) the keyword, value and comment into the FITS header.
  372   The value string will be truncated at 68 characters which is the
  373   maximum length that will fit on a single FITS keyword.
  374 */
  375 {
  376     char valstring[FLEN_VALUE];
  377     char card[FLEN_CARD];
  378 
  379     if (*status > 0)           /* inherit input status value if > 0 */
  380         return(*status);
  381 
  382     ffs2c(value, valstring, status);   /* put quotes around the string */
  383 
  384     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword */
  385     ffprec(fptr, card, status);
  386 
  387     return(*status);
  388 }
  389 /*--------------------------------------------------------------------------*/
  390 int ffpkls( fitsfile *fptr,     /* I - FITS file pointer        */
  391             const char *keyname,/* I - name of keyword to write */
  392             const char *value,  /* I - keyword value            */
  393             const char *comm,   /* I - keyword comment          */
  394             int  *status)       /* IO - error status            */
  395 /*
  396   Write (put) the keyword, value and comment into the FITS header.
  397   This routine is a modified version of ffpkys which supports the
  398   HEASARC long string convention and can write arbitrarily long string
  399   keyword values.  The value is continued over multiple keywords that
  400   have the name COMTINUE without an equal sign in column 9 of the card.
  401   This routine also supports simple string keywords which are less than
  402   69 characters in length.
  403 */
  404 {
  405     char valstring[FLEN_CARD];
  406     char card[FLEN_CARD], tmpkeyname[FLEN_CARD];
  407     char tstring[FLEN_CARD], *cptr;
  408     int next, remain, vlen, nquote, nchar, namelen, contin, tstatus = -1;
  409     int commlen=0, nocomment = 0;
  410 
  411     if (*status > 0)           /* inherit input status value if > 0 */
  412         return(*status);
  413 
  414     remain = maxvalue(strlen(value), 1); /* no. of chars to write (at least 1) */  
  415     if (comm) { 
  416        commlen = strlen(comm);
  417        if (commlen > 47) commlen = 47;  /* only guarantee preserving the first 47 characters */
  418     }
  419 
  420     /* count the number of single quote characters are in the string */
  421     tstring[0] = '\0';
  422     strncat(tstring, value, 68); /* copy 1st part of string to temp buff */
  423     nquote = 0;
  424     cptr = strchr(tstring, '\'');   /* search for quote character */
  425     while (cptr)  /* search for quote character */
  426     {
  427         nquote++;            /*  increment no. of quote characters  */
  428         cptr++;              /*  increment pointer to next character */
  429         cptr = strchr(cptr, '\'');  /* search for another quote char */
  430     }
  431 
  432     strncpy(tmpkeyname, keyname, 80);
  433     tmpkeyname[80] = '\0';
  434     
  435     cptr = tmpkeyname;
  436     while(*cptr == ' ')   /* skip over leading spaces in name */
  437         cptr++;
  438 
  439     /* determine the number of characters that will fit on the line */
  440     /* Note: each quote character is expanded to 2 quotes */
  441 
  442     namelen = strlen(cptr);
  443     if (namelen <= 8 && (fftkey(cptr, &tstatus) <= 0) )
  444     {
  445         /* This a normal 8-character FITS keyword */
  446         nchar = 68 - nquote; /*  max of 68 chars fit in a FITS string value */
  447     }
  448     else
  449     {
  450        nchar = 80 - nquote - namelen - 5;
  451     }
  452 
  453     contin = 0;
  454     next = 0;                  /* pointer to next character to write */
  455 
  456     while (remain > 0)
  457     {
  458         tstring[0] = '\0';
  459         strncat(tstring, &value[next], nchar); /* copy string to temp buff */
  460         ffs2c(tstring, valstring, status);  /* expand quotes, and put quotes around the string */
  461 
  462         if (remain > nchar)   /* if string is continued, put & as last char */
  463         {
  464             vlen = strlen(valstring);
  465             nchar -= 1;        /* outputting one less character now */
  466 
  467             if (valstring[vlen-2] != '\'')
  468                 valstring[vlen-2] = '&';  /*  over write last char with &  */
  469             else
  470             { /* last char was a pair of single quotes, so over write both */
  471                 valstring[vlen-3] = '&';
  472                 valstring[vlen-1] = '\0';
  473             }
  474         }
  475 
  476         if (contin)           /* This is a CONTINUEd keyword */
  477         {
  478            if (nocomment) {
  479                ffmkky("CONTINUE", valstring, NULL, card, status); /* make keyword w/o comment */
  480            } else {
  481                ffmkky("CONTINUE", valstring, comm, card, status); /* make keyword */
  482        }
  483            strncpy(&card[8], "   ",  2);  /* overwrite the '=' */
  484         }
  485         else
  486         {
  487            ffmkky(keyname, valstring, comm, card, status);  /* make keyword */
  488         }
  489 
  490         ffprec(fptr, card, status);  /* write the keyword */
  491 
  492         contin = 1;
  493         remain -= nchar;
  494         next  += nchar;
  495         nocomment = 0;
  496 
  497         if (remain > 0) 
  498         {
  499            /* count the number of single quote characters in next section */
  500            tstring[0] = '\0';
  501            strncat(tstring, &value[next], 68); /* copy next part of string */
  502            nquote = 0;
  503            cptr = strchr(tstring, '\'');   /* search for quote character */
  504            while (cptr)  /* search for quote character */
  505            {
  506                nquote++;            /*  increment no. of quote characters  */
  507                cptr++;              /*  increment pointer to next character */
  508                cptr = strchr(cptr, '\'');  /* search for another quote char */
  509            }
  510            nchar = 68 - nquote;  /* max number of chars to write this time */
  511         }
  512 
  513         /* make adjustment if necessary to allow reasonable room for a comment on last CONTINUE card 
  514        only need to do this if 
  515          a) there is a comment string, and
  516          b) the remaining value string characters could all fit on the next CONTINUE card, and
  517          c) there is not enough room on the next CONTINUE card for both the remaining value
  518             characters, and at least 47 characters of the comment string.
  519     */
  520     
  521         if (commlen > 0 && remain + nquote < 69 && remain + nquote + commlen > 65) 
  522     {
  523             if (nchar > 18) { /* only false if there are a rediculous number of quotes in the string */
  524             nchar = remain - 15;  /* force continuation onto another card, so that */
  525                               /* there is room for a comment up to 47 chara long */
  526                 nocomment = 1;  /* don't write the comment string this time */
  527             }
  528     }
  529     }
  530     return(*status);
  531 }
  532 /*--------------------------------------------------------------------------*/
  533 int ffplsw( fitsfile *fptr,     /* I - FITS file pointer  */
  534             int  *status)       /* IO - error status       */
  535 /*
  536   Write the LONGSTRN keyword and a series of related COMMENT keywords
  537   which document that this FITS header may contain long string keyword
  538   values which are continued over multiple keywords using the HEASARC
  539   long string keyword convention.  If the LONGSTRN keyword already exists
  540   then this routine simple returns without doing anything.
  541 */
  542 {
  543     char valstring[FLEN_VALUE], comm[FLEN_COMMENT];
  544     int tstatus;
  545 
  546     if (*status > 0)           /* inherit input status value if > 0 */
  547         return(*status);
  548 
  549     tstatus = 0;
  550     if (ffgkys(fptr, "LONGSTRN", valstring, comm, &tstatus) == 0)
  551         return(*status);     /* keyword already exists, so just return */
  552 
  553     ffpkys(fptr, "LONGSTRN", "OGIP 1.0", 
  554        "The HEASARC Long String Convention may be used.", status);
  555 
  556     ffpcom(fptr,
  557     "  This FITS file may contain long string keyword values that are", status);
  558 
  559     ffpcom(fptr,
  560     "  continued over multiple keywords.  The HEASARC convention uses the &",
  561     status);
  562 
  563     ffpcom(fptr,
  564     "  character at the end of each substring which is then continued", status);
  565 
  566     ffpcom(fptr,
  567     "  on the next keyword which has the name CONTINUE.", status);
  568 
  569     return(*status);
  570 }
  571 /*--------------------------------------------------------------------------*/
  572 int ffpkyl( fitsfile *fptr,     /* I - FITS file pointer        */
  573             const char *keyname,/* I - name of keyword to write */
  574             int  value,         /* I - keyword value            */
  575             const char *comm,   /* I - keyword comment          */
  576             int  *status)       /* IO - error status            */
  577 /*
  578   Write (put) the keyword, value and comment into the FITS header.
  579   Values equal to 0 will result in a False FITS keyword; any other
  580   non-zero value will result in a True FITS keyword.
  581 */
  582 {
  583     char valstring[FLEN_VALUE];
  584     char card[FLEN_CARD];
  585 
  586     if (*status > 0)           /* inherit input status value if > 0 */
  587         return(*status);
  588 
  589     ffl2c(value, valstring, status);   /* convert to formatted string */
  590     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  591     ffprec(fptr, card, status);  /* write the keyword*/
  592 
  593     return(*status);
  594 }
  595 /*--------------------------------------------------------------------------*/
  596 int ffpkyj( fitsfile *fptr,     /* I - FITS file pointer        */
  597             const char *keyname,/* I - name of keyword to write */
  598             LONGLONG value,     /* I - keyword value            */
  599             const char *comm,   /* I - keyword comment          */
  600             int  *status)       /* IO - error status            */
  601 /*
  602   Write (put) the keyword, value and comment into the FITS header.
  603   Writes an integer keyword value.
  604 */
  605 {
  606     char valstring[FLEN_VALUE];
  607     char card[FLEN_CARD];
  608 
  609     if (*status > 0)           /* inherit input status value if > 0 */
  610         return(*status);
  611 
  612     ffi2c(value, valstring, status);   /* convert to formatted string */
  613     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  614     ffprec(fptr, card, status);  /* write the keyword*/
  615 
  616     return(*status);
  617 }
  618 /*--------------------------------------------------------------------------*/
  619 int ffpkyuj( fitsfile *fptr,     /* I - FITS file pointer        */
  620             const char *keyname,/* I - name of keyword to write */
  621             ULONGLONG value,     /* I - keyword value            */
  622             const char *comm,   /* I - keyword comment          */
  623             int  *status)       /* IO - error status            */
  624 /*
  625   Write (put) the keyword, value and comment into the FITS header.
  626   Writes an integer keyword value.
  627 */
  628 {
  629     char valstring[FLEN_VALUE];
  630     char card[FLEN_CARD];
  631 
  632     if (*status > 0)           /* inherit input status value if > 0 */
  633         return(*status);
  634 
  635     ffu2c(value, valstring, status);   /* convert to formatted string */
  636     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  637     ffprec(fptr, card, status);  /* write the keyword*/
  638 
  639     return(*status);
  640 }
  641 /*--------------------------------------------------------------------------*/
  642 int ffpkyf( fitsfile *fptr,      /* I - FITS file pointer                   */
  643             const char  *keyname,/* I - name of keyword to write            */
  644             float value,         /* I - keyword value                       */
  645             int   decim,         /* I - number of decimal places to display */
  646             const char  *comm,   /* I - keyword comment                     */
  647             int   *status)       /* IO - error status                       */
  648 /*
  649   Write (put) the keyword, value and comment into the FITS header.
  650   Writes a fixed float keyword value.
  651 */
  652 {
  653     char valstring[FLEN_VALUE];
  654     char card[FLEN_CARD];
  655 
  656     if (*status > 0)           /* inherit input status value if > 0 */
  657         return(*status);
  658 
  659     ffr2f(value, decim, valstring, status);   /* convert to formatted string */
  660     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  661     ffprec(fptr, card, status);  /* write the keyword*/
  662 
  663     return(*status);
  664 }
  665 /*--------------------------------------------------------------------------*/
  666 int ffpkye( fitsfile *fptr,      /* I - FITS file pointer                   */
  667             const char  *keyname,/* I - name of keyword to write            */
  668             float value,         /* I - keyword value                       */
  669             int   decim,         /* I - number of decimal places to display */
  670             const char  *comm,   /* I - keyword comment                     */
  671             int   *status)       /* IO - error status                       */
  672 /*
  673   Write (put) the keyword, value and comment into the FITS header.
  674   Writes an exponential float keyword value.
  675 */
  676 {
  677     char valstring[FLEN_VALUE];
  678     char card[FLEN_CARD];
  679 
  680     if (*status > 0)           /* inherit input status value if > 0 */
  681         return(*status);
  682 
  683     ffr2e(value, decim, valstring, status);   /* convert to formatted string */
  684     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  685     ffprec(fptr, card, status);  /* write the keyword*/
  686 
  687     return(*status);
  688 }
  689 /*--------------------------------------------------------------------------*/
  690 int ffpkyg( fitsfile *fptr,      /* I - FITS file pointer                   */
  691             const char  *keyname,/* I - name of keyword to write            */
  692             double value,        /* I - keyword value                       */
  693             int   decim,         /* I - number of decimal places to display */
  694             const char  *comm,   /* I - keyword comment                     */
  695             int   *status)       /* IO - error status                       */
  696 /*
  697   Write (put) the keyword, value and comment into the FITS header.
  698   Writes a fixed double keyword value.*/
  699 {
  700     char valstring[FLEN_VALUE];
  701     char card[FLEN_CARD];
  702 
  703     if (*status > 0)           /* inherit input status value if > 0 */
  704         return(*status);
  705 
  706     ffd2f(value, decim, valstring, status);  /* convert to formatted string */
  707     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  708     ffprec(fptr, card, status);  /* write the keyword*/
  709 
  710     return(*status);
  711 }
  712 /*--------------------------------------------------------------------------*/
  713 int ffpkyd( fitsfile *fptr,      /* I - FITS file pointer                   */
  714             const char  *keyname,/* I - name of keyword to write            */
  715             double value,        /* I - keyword value                       */
  716             int   decim,         /* I - number of decimal places to display */
  717             const char  *comm,   /* I - keyword comment                     */
  718             int   *status)       /* IO - error status                       */
  719 /*
  720   Write (put) the keyword, value and comment into the FITS header.
  721   Writes an exponential double keyword value.*/
  722 {
  723     char valstring[FLEN_VALUE];
  724     char card[FLEN_CARD];
  725 
  726     if (*status > 0)           /* inherit input status value if > 0 */
  727         return(*status);
  728 
  729     ffd2e(value, decim, valstring, status);  /* convert to formatted string */
  730     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  731     ffprec(fptr, card, status);  /* write the keyword*/
  732 
  733     return(*status);
  734 }
  735 /*--------------------------------------------------------------------------*/
  736 int ffpkyc( fitsfile *fptr,      /* I - FITS file pointer                   */
  737             const char  *keyname,/* I - name of keyword to write            */
  738             float *value,        /* I - keyword value (real, imaginary)     */
  739             int   decim,         /* I - number of decimal places to display */
  740             const char  *comm,   /* I - keyword comment                     */
  741             int   *status)       /* IO - error status                       */
  742 /*
  743   Write (put) the keyword, value and comment into the FITS header.
  744   Writes an complex float keyword value. Format = (realvalue, imagvalue)
  745 */
  746 {
  747     char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
  748     char card[FLEN_CARD];
  749 
  750     if (*status > 0)           /* inherit input status value if > 0 */
  751         return(*status);
  752 
  753     strcpy(valstring, "(" );
  754     ffr2e(value[0], decim, tmpstring, status); /* convert to string */
  755     if (strlen(valstring)+strlen(tmpstring)+2 > FLEN_VALUE-1)
  756     {
  757        ffpmsg("Error converting complex to string (ffpkyc)");
  758        return(*status=BAD_F2C);
  759     }
  760     strcat(valstring, tmpstring);
  761     strcat(valstring, ", ");
  762     ffr2e(value[1], decim, tmpstring, status); /* convert to string */
  763     if (strlen(valstring)+strlen(tmpstring)+1 > FLEN_VALUE-1)
  764     {
  765        ffpmsg("Error converting complex to string (ffpkyc)");
  766        return(*status=BAD_F2C);
  767     }
  768     strcat(valstring, tmpstring);
  769     strcat(valstring, ")");
  770 
  771     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  772     ffprec(fptr, card, status);  /* write the keyword*/
  773 
  774     return(*status);
  775 }
  776 /*--------------------------------------------------------------------------*/
  777 int ffpkym( fitsfile *fptr,      /* I - FITS file pointer                   */
  778             const char  *keyname,/* I - name of keyword to write            */
  779             double *value,       /* I - keyword value (real, imaginary)     */
  780             int   decim,         /* I - number of decimal places to display */
  781             const char  *comm,   /* I - keyword comment                     */
  782             int   *status)       /* IO - error status                       */
  783 /*
  784   Write (put) the keyword, value and comment into the FITS header.
  785   Writes an complex double keyword value. Format = (realvalue, imagvalue)
  786 */
  787 {
  788     char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
  789     char card[FLEN_CARD];
  790 
  791     if (*status > 0)           /* inherit input status value if > 0 */
  792         return(*status);
  793 
  794     strcpy(valstring, "(" );
  795     ffd2e(value[0], decim, tmpstring, status); /* convert to string */
  796     if (strlen(valstring)+strlen(tmpstring)+2 > FLEN_VALUE-1)
  797     {
  798        ffpmsg("Error converting complex to string (ffpkym)");
  799        return(*status=BAD_F2C);
  800     }
  801     strcat(valstring, tmpstring);
  802     strcat(valstring, ", ");
  803     ffd2e(value[1], decim, tmpstring, status); /* convert to string */
  804     if (strlen(valstring)+strlen(tmpstring)+1 > FLEN_VALUE-1)
  805     {
  806        ffpmsg("Error converting complex to string (ffpkym)");
  807        return(*status=BAD_F2C);
  808     }
  809     strcat(valstring, tmpstring);
  810     strcat(valstring, ")");
  811 
  812     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  813     ffprec(fptr, card, status);  /* write the keyword*/
  814 
  815     return(*status);
  816 }
  817 /*--------------------------------------------------------------------------*/
  818 int ffpkfc( fitsfile *fptr,      /* I - FITS file pointer                   */
  819             const char  *keyname,/* I - name of keyword to write            */
  820             float *value,        /* I - keyword value (real, imaginary)     */
  821             int   decim,         /* I - number of decimal places to display */
  822             const char  *comm,   /* I - keyword comment                     */
  823             int   *status)       /* IO - error status                       */
  824 /*
  825   Write (put) the keyword, value and comment into the FITS header.
  826   Writes an complex float keyword value. Format = (realvalue, imagvalue)
  827 */
  828 {
  829     char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
  830     char card[FLEN_CARD];
  831 
  832     if (*status > 0)           /* inherit input status value if > 0 */
  833         return(*status);
  834 
  835     strcpy(valstring, "(" );
  836     ffr2f(value[0], decim, tmpstring, status); /* convert to string */
  837     if (strlen(valstring)+strlen(tmpstring)+2 > FLEN_VALUE-1)
  838     {
  839        ffpmsg("Error converting complex to string (ffpkfc)");
  840        return(*status=BAD_F2C);
  841     }
  842     strcat(valstring, tmpstring);
  843     strcat(valstring, ", ");
  844     ffr2f(value[1], decim, tmpstring, status); /* convert to string */
  845     if (strlen(valstring)+strlen(tmpstring)+1 > FLEN_VALUE-1)
  846     {
  847        ffpmsg("Error converting complex to string (ffpkfc)");
  848        return(*status=BAD_F2C);
  849     }
  850     strcat(valstring, tmpstring);
  851     strcat(valstring, ")");
  852 
  853     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  854     ffprec(fptr, card, status);  /* write the keyword*/
  855 
  856     return(*status);
  857 }
  858 /*--------------------------------------------------------------------------*/
  859 int ffpkfm( fitsfile *fptr,      /* I - FITS file pointer                   */
  860             const char  *keyname,/* I - name of keyword to write            */
  861             double *value,       /* I - keyword value (real, imaginary)     */
  862             int   decim,         /* I - number of decimal places to display */
  863             const char  *comm,   /* I - keyword comment                     */
  864             int   *status)       /* IO - error status                       */
  865 /*
  866   Write (put) the keyword, value and comment into the FITS header.
  867   Writes an complex double keyword value. Format = (realvalue, imagvalue)
  868 */
  869 {
  870     char valstring[FLEN_VALUE], tmpstring[FLEN_VALUE];
  871     char card[FLEN_CARD];
  872 
  873     if (*status > 0)           /* inherit input status value if > 0 */
  874         return(*status);
  875 
  876     strcpy(valstring, "(" );
  877     ffd2f(value[0], decim, tmpstring, status); /* convert to string */
  878     if (strlen(valstring)+strlen(tmpstring)+2 > FLEN_VALUE-1)
  879     {
  880        ffpmsg("Error converting complex to string (ffpkfm)");
  881        return(*status=BAD_F2C);
  882     }
  883     strcat(valstring, tmpstring);
  884     strcat(valstring, ", ");
  885     ffd2f(value[1], decim, tmpstring, status); /* convert to string */
  886     if (strlen(valstring)+strlen(tmpstring)+1 > FLEN_VALUE-1)
  887     {
  888        ffpmsg("Error converting complex to string (ffpkfm)");
  889        return(*status=BAD_F2C);
  890     }
  891     strcat(valstring, tmpstring);
  892     strcat(valstring, ")");
  893 
  894     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  895     ffprec(fptr, card, status);  /* write the keyword*/
  896 
  897     return(*status);
  898 }
  899 /*--------------------------------------------------------------------------*/
  900 int ffpkyt( fitsfile *fptr,      /* I - FITS file pointer        */
  901             const char  *keyname,/* I - name of keyword to write */
  902             long  intval,        /* I - integer part of value    */
  903             double fraction,     /* I - fractional part of value */
  904             const char  *comm,   /* I - keyword comment          */
  905             int   *status)       /* IO - error status            */
  906 /*
  907   Write (put) a 'triple' precision keyword where the integer and
  908   fractional parts of the value are passed in separate parameters to
  909   increase the total amount of numerical precision.
  910 */
  911 {
  912     char valstring[FLEN_VALUE];
  913     char card[FLEN_CARD];
  914     char fstring[20], *cptr;
  915 
  916     if (*status > 0)           /* inherit input status value if > 0 */
  917         return(*status);
  918 
  919     if (fraction > 1. || fraction < 0.)
  920     {
  921         ffpmsg("fraction must be between 0. and 1. (ffpkyt)");
  922         return(*status = BAD_F2C);
  923     }
  924 
  925     ffi2c(intval, valstring, status);  /* convert integer to string */
  926     ffd2f(fraction, 16, fstring, status);  /* convert to 16 decimal string */
  927 
  928     cptr = strchr(fstring, '.');    /* find the decimal point */
  929     if (strlen(valstring)+strlen(cptr) > FLEN_VALUE-1)
  930     {
  931        ffpmsg("converted numerical string too long");
  932        return(*status=BAD_F2C);
  933     }
  934     strcat(valstring, cptr);    /* append the fraction to the integer */
  935 
  936     ffmkky(keyname, valstring, comm, card, status);  /* construct the keyword*/
  937     ffprec(fptr, card, status);  /* write the keyword*/
  938 
  939     return(*status);
  940 }
  941 /*-----------------------------------------------------------------*/
  942 int ffpcom( fitsfile *fptr,      /* I - FITS file pointer   */
  943             const char  *comm,   /* I - comment string      */
  944             int   *status)       /* IO - error status       */
  945 /*
  946   Write 1 or more COMMENT keywords.  If the comment string is too
  947   long to fit on a single keyword (72 chars) then it will automatically
  948   be continued on multiple CONTINUE keywords.
  949 */
  950 {
  951     char card[FLEN_CARD];
  952     int len, ii;
  953 
  954     if (*status > 0)           /* inherit input status value if > 0 */
  955         return(*status);
  956 
  957     len = strlen(comm);
  958     ii = 0;
  959 
  960     for (; len > 0; len -= 72)
  961     {
  962         strcpy(card, "COMMENT ");
  963         strncat(card, &comm[ii], 72);
  964         ffprec(fptr, card, status);
  965         ii += 72;
  966     }
  967 
  968     return(*status);
  969 }
  970 /*-----------------------------------------------------------------*/
  971 int ffphis( fitsfile *fptr,      /* I - FITS file pointer  */
  972             const char *history, /* I - history string     */
  973             int   *status)       /* IO - error status      */
  974 /*
  975   Write 1 or more HISTORY keywords.  If the history string is too
  976   long to fit on a single keyword (72 chars) then it will automatically
  977   be continued on multiple HISTORY keywords.
  978 */
  979 {
  980     char card[FLEN_CARD];
  981     int len, ii;
  982 
  983     if (*status > 0)           /* inherit input status value if > 0 */
  984         return(*status);
  985 
  986     len = strlen(history);
  987     ii = 0;
  988 
  989     for (; len > 0; len -= 72)
  990     {
  991         strcpy(card, "HISTORY ");
  992         strncat(card, &history[ii], 72);
  993         ffprec(fptr, card, status);
  994         ii += 72;
  995     }
  996 
  997     return(*status);
  998 }
  999 /*-----------------------------------------------------------------*/
 1000 int ffpdat( fitsfile *fptr,      /* I - FITS file pointer  */
 1001             int   *status)       /* IO - error status      */
 1002 /*
 1003   Write the DATE keyword into the FITS header.  If the keyword already
 1004   exists then the date will simply be updated in the existing keyword.
 1005 */
 1006 {
 1007     int timeref;
 1008     char date[30], tmzone[10], card[FLEN_CARD];
 1009 
 1010     if (*status > 0)           /* inherit input status value if > 0 */
 1011         return(*status);
 1012 
 1013     ffgstm(date, &timeref, status);
 1014 
 1015     if (timeref)           /* GMT not available on this machine */
 1016         strcpy(tmzone, " Local");    
 1017     else
 1018         strcpy(tmzone, " UT");    
 1019 
 1020     strcpy(card, "DATE    = '");
 1021     strcat(card, date);
 1022     strcat(card, "' / file creation date (YYYY-MM-DDThh:mm:ss");
 1023     strcat(card, tmzone);
 1024     strcat(card, ")");
 1025 
 1026     ffucrd(fptr, "DATE", card, status);
 1027 
 1028     return(*status);
 1029 }
 1030 /*-------------------------------------------------------------------*/
 1031 int ffverifydate(int year,          /* I - year (0 - 9999)           */
 1032                  int month,         /* I - month (1 - 12)            */
 1033                  int day,           /* I - day (1 - 31)              */
 1034                  int   *status)     /* IO - error status             */
 1035 /*
 1036   Verify that the date is valid
 1037 */
 1038 {
 1039     int ndays[] = {0,31,28,31,30,31,30,31,31,30,31,30,31};
 1040     char errmsg[FLEN_ERRMSG];
 1041     
 1042 
 1043     if (year < 0 || year > 9999)
 1044     {
 1045        snprintf(errmsg, FLEN_ERRMSG,
 1046        "input year value = %d is out of range 0 - 9999", year);
 1047        ffpmsg(errmsg);
 1048        return(*status = BAD_DATE);
 1049     }
 1050     else if (month < 1 || month > 12)
 1051     {
 1052        snprintf(errmsg, FLEN_ERRMSG,
 1053        "input month value = %d is out of range 1 - 12", month);
 1054        ffpmsg(errmsg);
 1055        return(*status = BAD_DATE);
 1056     }
 1057     
 1058     if (ndays[month] == 31) {
 1059         if (day < 1 || day > 31)
 1060         {
 1061            snprintf(errmsg, FLEN_ERRMSG,
 1062            "input day value = %d is out of range 1 - 31 for month %d", day, month);
 1063            ffpmsg(errmsg);
 1064            return(*status = BAD_DATE);
 1065         }
 1066     } else if (ndays[month] == 30) {
 1067         if (day < 1 || day > 30)
 1068         {
 1069            snprintf(errmsg, FLEN_ERRMSG,
 1070            "input day value = %d is out of range 1 - 30 for month %d", day, month);
 1071            ffpmsg(errmsg);
 1072            return(*status = BAD_DATE);
 1073         }
 1074     } else {
 1075         if (day < 1 || day > 28)
 1076         {
 1077             if (day == 29)
 1078             {
 1079           /* year is a leap year if it is divisible by 4 but not by 100,
 1080              except years divisible by 400 are leap years
 1081           */
 1082             if ((year % 4 == 0 && year % 100 != 0 ) || year % 400 == 0)
 1083            return (*status);
 1084            
 1085             snprintf(errmsg, FLEN_ERRMSG,
 1086            "input day value = %d is out of range 1 - 28 for February %d (not leap year)", day, year);
 1087                 ffpmsg(errmsg);
 1088         } else {
 1089                 snprintf(errmsg, FLEN_ERRMSG,
 1090                 "input day value = %d is out of range 1 - 28 (or 29) for February", day);
 1091                 ffpmsg(errmsg);
 1092         }
 1093         
 1094             return(*status = BAD_DATE);
 1095         }
 1096     }
 1097     return(*status);
 1098 }
 1099 /*-----------------------------------------------------------------*/
 1100 int ffgstm( char *timestr,   /* O  - returned system date and time string  */
 1101             int  *timeref,   /* O - GMT = 0, Local time = 1  */
 1102             int   *status)   /* IO - error status      */
 1103 /*
 1104   Returns the current date and time in format 'yyyy-mm-ddThh:mm:ss'.
 1105 */
 1106 {
 1107     time_t tp;
 1108     struct tm *ptr;
 1109 
 1110     if (*status > 0)           /* inherit input status value if > 0 */
 1111         return(*status);
 1112 
 1113     time(&tp);
 1114     ptr = gmtime(&tp);         /* get GMT (= UTC) time */
 1115 
 1116     if (timeref)
 1117     {
 1118         if (ptr)
 1119             *timeref = 0;   /* returning GMT */
 1120         else
 1121             *timeref = 1;   /* returning local time */
 1122     }
 1123 
 1124     if (!ptr)                  /* GMT not available on this machine */
 1125         ptr = localtime(&tp); 
 1126 
 1127     strftime(timestr, 25, "%Y-%m-%dT%H:%M:%S", ptr);
 1128 
 1129     return(*status);
 1130 }
 1131 /*-----------------------------------------------------------------*/
 1132 int ffdt2s(int year,          /* I - year (0 - 9999)           */
 1133            int month,         /* I - month (1 - 12)            */
 1134            int day,           /* I - day (1 - 31)              */
 1135            char *datestr,     /* O - date string: "YYYY-MM-DD" */
 1136            int   *status)     /* IO - error status             */
 1137 /*
 1138   Construct a date character string
 1139 */
 1140 {
 1141     if (*status > 0)           /* inherit input status value if > 0 */
 1142         return(*status);
 1143 
 1144     *datestr = '\0';
 1145     
 1146     if (ffverifydate(year, month, day, status) > 0)
 1147     {
 1148         ffpmsg("invalid date (ffdt2s)");
 1149         return(*status);
 1150     }
 1151 
 1152     if (year >= 1900 && year <= 1998)  /* use old 'dd/mm/yy' format */
 1153         sprintf(datestr, "%.2d/%.2d/%.2d", day, month, year - 1900);
 1154 
 1155     else  /* use the new 'YYYY-MM-DD' format */
 1156         sprintf(datestr, "%.4d-%.2d-%.2d", year, month, day);
 1157 
 1158     return(*status);
 1159 }
 1160 /*-----------------------------------------------------------------*/
 1161 int ffs2dt(char *datestr,   /* I - date string: "YYYY-MM-DD" or "dd/mm/yy" */
 1162            int *year,       /* O - year (0 - 9999)                         */
 1163            int *month,      /* O - month (1 - 12)                          */
 1164            int *day,        /* O - day (1 - 31)                            */
 1165            int   *status)   /* IO - error status                           */
 1166 /*
 1167   Parse a date character string into year, month, and day values
 1168 */
 1169 {
 1170     int slen, lyear, lmonth, lday;
 1171 
 1172     if (*status > 0)           /* inherit input status value if > 0 */
 1173         return(*status);
 1174 
 1175     if (year)
 1176         *year = 0;
 1177     if (month)
 1178         *month = 0;
 1179     if (day)
 1180         *day   = 0;
 1181 
 1182     if (!datestr)
 1183     {
 1184         ffpmsg("error: null input date string (ffs2dt)");
 1185         return(*status = BAD_DATE);   /* Null datestr pointer ??? */
 1186     }
 1187 
 1188     slen = strlen(datestr);
 1189 
 1190     if (slen == 8 && datestr[2] == '/' && datestr[5] == '/')
 1191     {
 1192         if (isdigit((int) datestr[0]) && isdigit((int) datestr[1])
 1193          && isdigit((int) datestr[3]) && isdigit((int) datestr[4])
 1194          && isdigit((int) datestr[6]) && isdigit((int) datestr[7]) )
 1195         {
 1196             /* this is an old format string: "dd/mm/yy" */
 1197             lyear  = atoi(&datestr[6]) + 1900;
 1198             lmonth = atoi(&datestr[3]);
 1199         lday   = atoi(datestr);
 1200         
 1201             if (year)
 1202                 *year = lyear;
 1203             if (month)
 1204                 *month = lmonth;
 1205             if (day)
 1206                 *day   = lday;
 1207         }
 1208         else
 1209         {
 1210             ffpmsg("input date string has illegal format (ffs2dt):");
 1211             ffpmsg(datestr);
 1212             return(*status = BAD_DATE);
 1213         }
 1214     }
 1215     else if (slen >= 10 && datestr[4] == '-' && datestr[7] == '-')
 1216         {
 1217         if (isdigit((int) datestr[0]) && isdigit((int) datestr[1])
 1218          && isdigit((int) datestr[2]) && isdigit((int) datestr[3])
 1219          && isdigit((int) datestr[5]) && isdigit((int) datestr[6])
 1220          && isdigit((int) datestr[8]) && isdigit((int) datestr[9]) )
 1221         {
 1222             if (slen > 10 && datestr[10] != 'T')
 1223             {
 1224                 ffpmsg("input date string has illegal format (ffs2dt):");
 1225                 ffpmsg(datestr);
 1226                 return(*status = BAD_DATE);
 1227             }
 1228 
 1229             /* this is a new format string: "yyyy-mm-dd" */
 1230             lyear  = atoi(datestr);
 1231             lmonth = atoi(&datestr[5]);
 1232             lday   = atoi(&datestr[8]);
 1233 
 1234             if (year)
 1235                *year  = lyear;
 1236             if (month)
 1237                *month = lmonth;
 1238             if (day)
 1239                *day   = lday;
 1240         }
 1241         else
 1242         {
 1243                 ffpmsg("input date string has illegal format (ffs2dt):");
 1244                 ffpmsg(datestr);
 1245                 return(*status = BAD_DATE);
 1246         }
 1247     }
 1248     else
 1249     {
 1250                 ffpmsg("input date string has illegal format (ffs2dt):");
 1251                 ffpmsg(datestr);
 1252                 return(*status = BAD_DATE);
 1253     }
 1254 
 1255 
 1256     if (ffverifydate(lyear, lmonth, lday, status) > 0)
 1257     {
 1258         ffpmsg("invalid date (ffs2dt)");
 1259     }
 1260 
 1261     return(*status);
 1262 }
 1263 /*-----------------------------------------------------------------*/
 1264 int fftm2s(int year,          /* I - year (0 - 9999)           */
 1265            int month,         /* I - month (1 - 12)            */
 1266            int day,           /* I - day (1 - 31)              */
 1267            int hour,          /* I - hour (0 - 23)             */
 1268            int minute,        /* I - minute (0 - 59)           */
 1269            double second,     /* I - second (0. - 60.9999999)  */
 1270            int decimals,      /* I - number of decimal points to write      */
 1271            char *datestr,     /* O - date string: "YYYY-MM-DDThh:mm:ss.ddd" */
 1272                               /*   or "hh:mm:ss.ddd" if year, month day = 0 */
 1273            int   *status)     /* IO - error status             */
 1274 /*
 1275   Construct a date and time character string
 1276 */
 1277 {
 1278     int width;
 1279     char errmsg[FLEN_ERRMSG];
 1280 
 1281     if (*status > 0)           /* inherit input status value if > 0 */
 1282         return(*status);
 1283 
 1284     *datestr='\0';
 1285 
 1286     if (year != 0 || month != 0 || day !=0)
 1287     { 
 1288         if (ffverifydate(year, month, day, status) > 0)
 1289     {
 1290             ffpmsg("invalid date (fftm2s)");
 1291             return(*status);
 1292         }
 1293     }
 1294 
 1295     if (hour < 0 || hour > 23)
 1296     {
 1297        snprintf(errmsg, FLEN_ERRMSG,
 1298        "input hour value is out of range 0 - 23: %d (fftm2s)", hour);
 1299        ffpmsg(errmsg);
 1300        return(*status = BAD_DATE);
 1301     }
 1302     else if (minute < 0 || minute > 59)
 1303     {
 1304        snprintf(errmsg, FLEN_ERRMSG,
 1305        "input minute value is out of range 0 - 59: %d (fftm2s)", minute);
 1306        ffpmsg(errmsg);
 1307        return(*status = BAD_DATE);
 1308     }
 1309     else if (second < 0. || second >= 61)
 1310     {
 1311        snprintf(errmsg, FLEN_ERRMSG,
 1312        "input second value is out of range 0 - 60.999: %f (fftm2s)", second);
 1313        ffpmsg(errmsg);
 1314        return(*status = BAD_DATE);
 1315     }
 1316     else if (decimals > 25)
 1317     {
 1318        snprintf(errmsg, FLEN_ERRMSG,
 1319        "input decimals value is out of range 0 - 25: %d (fftm2s)", decimals);
 1320        ffpmsg(errmsg);
 1321        return(*status = BAD_DATE);
 1322     }
 1323 
 1324     if (decimals == 0)
 1325        width = 2;
 1326     else
 1327        width = decimals + 3;
 1328 
 1329     if (decimals < 0)
 1330     {
 1331         /* a negative decimals value means return only the date, not time */
 1332         sprintf(datestr, "%.4d-%.2d-%.2d", year, month, day);
 1333     }
 1334     else if (year == 0 && month == 0 && day == 0)
 1335     {
 1336         /* return only the time, not the date */
 1337         sprintf(datestr, "%.2d:%.2d:%0*.*f",
 1338             hour, minute, width, decimals, second);
 1339     }
 1340     else
 1341     {
 1342         /* return both the time and date */
 1343         sprintf(datestr, "%.4d-%.2d-%.2dT%.2d:%.2d:%0*.*f",
 1344             year, month, day, hour, minute, width, decimals, second);
 1345     }
 1346     return(*status);
 1347 }
 1348 /*-----------------------------------------------------------------*/
 1349 int ffs2tm(char *datestr,     /* I - date string: "YYYY-MM-DD"    */
 1350                               /*     or "YYYY-MM-DDThh:mm:ss.ddd" */
 1351                               /*     or "dd/mm/yy"                */
 1352            int *year,         /* O - year (0 - 9999)              */
 1353            int *month,        /* O - month (1 - 12)               */
 1354            int *day,          /* O - day (1 - 31)                 */
 1355            int *hour,          /* I - hour (0 - 23)                */
 1356            int *minute,        /* I - minute (0 - 59)              */
 1357            double *second,     /* I - second (0. - 60.9999999)     */
 1358            int   *status)     /* IO - error status                */
 1359 /*
 1360   Parse a date character string into date and time values
 1361 */
 1362 {
 1363     int slen;
 1364     char errmsg[FLEN_ERRMSG];
 1365 
 1366     if (*status > 0)           /* inherit input status value if > 0 */
 1367         return(*status);
 1368 
 1369     if (year)
 1370        *year   = 0;
 1371     if (month)
 1372        *month  = 0;
 1373     if (day)
 1374        *day    = 0;
 1375     if (hour)
 1376        *hour   = 0;
 1377     if (minute)
 1378        *minute = 0;
 1379     if (second)
 1380        *second = 0.;
 1381 
 1382     if (!datestr)
 1383     {
 1384         ffpmsg("error: null input date string (ffs2tm)");
 1385         return(*status = BAD_DATE);   /* Null datestr pointer ??? */
 1386     }
 1387 
 1388     if (datestr[2] == '/' || datestr[4] == '-')
 1389     {
 1390         /*  Parse the year, month, and date */
 1391         if (ffs2dt(datestr, year, month, day, status) > 0)
 1392             return(*status);
 1393 
 1394         slen = strlen(datestr);
 1395         if (slen == 8 || slen == 10)
 1396             return(*status);               /* OK, no time fields */
 1397         else if (slen < 19) 
 1398         {
 1399             ffpmsg("input date string has illegal format:");
 1400             ffpmsg(datestr);
 1401             return(*status = BAD_DATE);
 1402         }
 1403 
 1404         else if (datestr[10] == 'T')
 1405         {
 1406           if (datestr[13] == ':' && datestr[16] == ':') {
 1407             if (isdigit((int) datestr[11]) && isdigit((int) datestr[12])
 1408              && isdigit((int) datestr[14]) && isdigit((int) datestr[15])
 1409              && isdigit((int) datestr[17]) && isdigit((int) datestr[18]) )
 1410              {
 1411                 if (slen > 19 && datestr[19] != '.')
 1412                 {
 1413                   ffpmsg("input date string has illegal format:");
 1414                   ffpmsg(datestr);
 1415                   return(*status = BAD_DATE);
 1416                 }
 1417 
 1418                 /* this is a new format string: "yyyy-mm-ddThh:mm:ss.dddd" */
 1419                 if (hour)
 1420                     *hour   = atoi(&datestr[11]);
 1421 
 1422                 if (minute)
 1423                     *minute = atoi(&datestr[14]);
 1424 
 1425                 if (second)
 1426                     *second = atof(&datestr[17]);
 1427              }
 1428              else
 1429              {
 1430                   ffpmsg("input date string has illegal format:");
 1431                   ffpmsg(datestr);
 1432                   return(*status = BAD_DATE);
 1433              }
 1434 
 1435           }
 1436           else
 1437           {
 1438                ffpmsg("input date string has illegal format:");
 1439                ffpmsg(datestr);
 1440                return(*status = BAD_DATE);
 1441           }
 1442         }
 1443     }
 1444     else   /* no date fields */
 1445     {
 1446         if (datestr[2] == ':' && datestr[5] == ':')   /* time string */
 1447         {
 1448             if (isdigit((int) datestr[0]) && isdigit((int) datestr[1])
 1449              && isdigit((int) datestr[3]) && isdigit((int) datestr[4])
 1450              && isdigit((int) datestr[6]) && isdigit((int) datestr[7]) )
 1451             {
 1452                  /* this is a time string: "hh:mm:ss.dddd" */
 1453                  if (hour)
 1454                     *hour   = atoi(&datestr[0]);
 1455 
 1456                  if (minute)
 1457                     *minute = atoi(&datestr[3]);
 1458 
 1459                 if (second)
 1460                     *second = atof(&datestr[6]);
 1461             }
 1462             else
 1463             {
 1464                   ffpmsg("input date string has illegal format:");
 1465                   ffpmsg(datestr);
 1466                   return(*status = BAD_DATE);
 1467             }
 1468 
 1469         }
 1470         else
 1471         {
 1472                   ffpmsg("input date string has illegal format:");
 1473                   ffpmsg(datestr);
 1474                   return(*status = BAD_DATE);
 1475         }
 1476 
 1477     }
 1478 
 1479     if (hour)
 1480        if (*hour < 0 || *hour > 23)
 1481        {
 1482           snprintf(errmsg,FLEN_ERRMSG, 
 1483           "hour value is out of range 0 - 23: %d (ffs2tm)", *hour);
 1484           ffpmsg(errmsg);
 1485           return(*status = BAD_DATE);
 1486        }
 1487 
 1488     if (minute)
 1489        if (*minute < 0 || *minute > 59)
 1490        {
 1491           snprintf(errmsg, FLEN_ERRMSG,
 1492           "minute value is out of range 0 - 59: %d (ffs2tm)", *minute);
 1493           ffpmsg(errmsg);
 1494           return(*status = BAD_DATE);
 1495        }
 1496 
 1497     if (second)
 1498        if (*second < 0 || *second >= 61.)
 1499        {
 1500           snprintf(errmsg, FLEN_ERRMSG,
 1501           "second value is out of range 0 - 60.9999: %f (ffs2tm)", *second);
 1502           ffpmsg(errmsg);
 1503           return(*status = BAD_DATE);
 1504        }
 1505 
 1506     return(*status);
 1507 }
 1508 /*--------------------------------------------------------------------------*/
 1509 int ffgsdt( int *day, int *month, int *year, int *status )
 1510 {  
 1511 /*
 1512       This routine is included for backward compatibility
 1513             with the Fortran FITSIO library.
 1514 
 1515    ffgsdt : Get current System DaTe (GMT if available)
 1516 
 1517       Return integer values of the day, month, and year
 1518 
 1519          Function parameters:
 1520             day      Day of the month
 1521             month    Numerical month (1=Jan, etc.)
 1522             year     Year (1999, 2000, etc.)
 1523             status   output error status
 1524 
 1525 */
 1526    time_t now;
 1527    struct tm *date;
 1528 
 1529    now = time( NULL );
 1530    date = gmtime(&now);         /* get GMT (= UTC) time */
 1531 
 1532    if (!date)                  /* GMT not available on this machine */
 1533    {
 1534        date = localtime(&now); 
 1535    }
 1536 
 1537    *day = date->tm_mday;
 1538    *month = date->tm_mon + 1;
 1539    *year = date->tm_year + 1900;  /* tm_year is defined as years since 1900 */
 1540    return( *status );
 1541 }
 1542 /*--------------------------------------------------------------------------*/
 1543 int ffpkns( fitsfile *fptr,     /* I - FITS file pointer                    */
 1544             const char *keyroot,      /* I - root name of keywords to write       */
 1545             int  nstart,        /* I - starting index number                */
 1546             int  nkey,          /* I - number of keywords to write          */
 1547             char *value[],      /* I - array of pointers to keyword values  */
 1548             char *comm[],       /* I - array of pointers to keyword comment */
 1549             int  *status)       /* IO - error status                        */
 1550 /*
 1551   Write (put) an indexed array of keywords with index numbers between
 1552   NSTART and (NSTART + NKEY -1) inclusive.  Writes string keywords.
 1553   The value strings will be truncated at 68 characters, and the HEASARC
 1554   long string keyword convention is not supported by this routine.
 1555 */
 1556 {
 1557     char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
 1558     int ii, jj, repeat, len;
 1559 
 1560     if (*status > 0)           /* inherit input status value if > 0 */
 1561         return(*status);
 1562 
 1563     /* check if first comment string is to be repeated for all the keywords */
 1564     /* by looking to see if the last non-blank character is a '&' char      */
 1565 
 1566     repeat = 0;
 1567 
 1568     if (comm)
 1569     {
 1570       len = strlen(comm[0]);
 1571 
 1572       while (len > 0  && comm[0][len - 1] == ' ')
 1573         len--;                               /* ignore trailing blanks */
 1574 
 1575       if (len > 0 && comm[0][len - 1] == '&')
 1576       {
 1577         len = minvalue(len, FLEN_COMMENT);
 1578         tcomment[0] = '\0';
 1579         strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
 1580         repeat = 1;
 1581       }
 1582     }
 1583     else
 1584     {
 1585       repeat = 1;
 1586       tcomment[0] = '\0';
 1587     }
 1588 
 1589     for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
 1590     {
 1591         ffkeyn(keyroot, jj, keyname, status);
 1592         if (repeat)
 1593             ffpkys(fptr, keyname, value[ii], tcomment, status);
 1594         else
 1595             ffpkys(fptr, keyname, value[ii], comm[ii], status);
 1596 
 1597         if (*status > 0)
 1598             return(*status);
 1599     }
 1600     return(*status);
 1601 }
 1602 /*--------------------------------------------------------------------------*/
 1603 int ffpknl( fitsfile *fptr,     /* I - FITS file pointer                    */
 1604             const char *keyroot,      /* I - root name of keywords to write       */
 1605             int  nstart,        /* I - starting index number                */
 1606             int  nkey,          /* I - number of keywords to write          */
 1607             int  *value,        /* I - array of keyword values              */
 1608             char *comm[],       /* I - array of pointers to keyword comment */
 1609             int  *status)       /* IO - error status                        */
 1610 /*
 1611   Write (put) an indexed array of keywords with index numbers between
 1612   NSTART and (NSTART + NKEY -1) inclusive.  Writes logical keywords
 1613   Values equal to zero will be written as a False FITS keyword value; any
 1614   other non-zero value will result in a True FITS keyword.
 1615 */
 1616 {
 1617     char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
 1618     int ii, jj, repeat, len;
 1619 
 1620     if (*status > 0)           /* inherit input status value if > 0 */
 1621         return(*status);
 1622 
 1623     /* check if first comment string is to be repeated for all the keywords */
 1624     /* by looking to see if the last non-blank character is a '&' char      */
 1625 
 1626     repeat = 0;
 1627     if (comm)
 1628     {
 1629       len = strlen(comm[0]);
 1630 
 1631       while (len > 0  && comm[0][len - 1] == ' ')
 1632         len--;                               /* ignore trailing blanks */
 1633 
 1634       if (len > 0 && comm[0][len - 1] == '&')
 1635       {
 1636         len = minvalue(len, FLEN_COMMENT);
 1637         tcomment[0] = '\0';
 1638         strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
 1639         repeat = 1;
 1640       }
 1641     }
 1642     else
 1643     {
 1644       repeat = 1;
 1645       tcomment[0] = '\0';
 1646     }
 1647 
 1648 
 1649     for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
 1650     {
 1651         ffkeyn(keyroot, jj, keyname, status);
 1652 
 1653         if (repeat)
 1654             ffpkyl(fptr, keyname, value[ii], tcomment, status);
 1655         else
 1656             ffpkyl(fptr, keyname, value[ii], comm[ii], status);
 1657 
 1658         if (*status > 0)
 1659             return(*status);
 1660     }
 1661     return(*status);
 1662 }
 1663 /*--------------------------------------------------------------------------*/
 1664 int ffpknj( fitsfile *fptr,     /* I - FITS file pointer                    */
 1665             const char *keyroot,      /* I - root name of keywords to write       */
 1666             int  nstart,        /* I - starting index number                */
 1667             int  nkey,          /* I - number of keywords to write          */
 1668             long *value,        /* I - array of keyword values              */
 1669             char *comm[],       /* I - array of pointers to keyword comment */
 1670             int  *status)       /* IO - error status                        */
 1671 /*
 1672   Write (put) an indexed array of keywords with index numbers between
 1673   NSTART and (NSTART + NKEY -1) inclusive.  Write integer keywords
 1674 */
 1675 {
 1676     char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
 1677     int ii, jj, repeat, len;
 1678 
 1679     if (*status > 0)           /* inherit input status value if > 0 */
 1680         return(*status);
 1681 
 1682     /* check if first comment string is to be repeated for all the keywords */
 1683     /* by looking to see if the last non-blank character is a '&' char      */
 1684 
 1685     repeat = 0;
 1686 
 1687     if (comm)
 1688     {
 1689       len = strlen(comm[0]);
 1690 
 1691       while (len > 0  && comm[0][len - 1] == ' ')
 1692         len--;                               /* ignore trailing blanks */
 1693 
 1694       if (len > 0 && comm[0][len - 1] == '&')
 1695       {
 1696         len = minvalue(len, FLEN_COMMENT);
 1697         tcomment[0] = '\0';
 1698         strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
 1699         repeat = 1;
 1700       }
 1701     }
 1702     else
 1703     {
 1704       repeat = 1;
 1705       tcomment[0] = '\0';
 1706     }
 1707 
 1708     for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
 1709     {
 1710         ffkeyn(keyroot, jj, keyname, status);
 1711         if (repeat)
 1712             ffpkyj(fptr, keyname, value[ii], tcomment, status);
 1713         else
 1714             ffpkyj(fptr, keyname, value[ii], comm[ii], status);
 1715 
 1716         if (*status > 0)
 1717             return(*status);
 1718     }
 1719     return(*status);
 1720 }
 1721 /*--------------------------------------------------------------------------*/
 1722 int ffpknjj( fitsfile *fptr,    /* I - FITS file pointer                    */
 1723             const char *keyroot,      /* I - root name of keywords to write       */
 1724             int  nstart,        /* I - starting index number                */
 1725             int  nkey,          /* I - number of keywords to write          */
 1726             LONGLONG *value,    /* I - array of keyword values              */
 1727             char *comm[],       /* I - array of pointers to keyword comment */
 1728             int  *status)       /* IO - error status                        */
 1729 /*
 1730   Write (put) an indexed array of keywords with index numbers between
 1731   NSTART and (NSTART + NKEY -1) inclusive.  Write integer keywords
 1732 */
 1733 {
 1734     char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
 1735     int ii, jj, repeat, len;
 1736 
 1737     if (*status > 0)           /* inherit input status value if > 0 */
 1738         return(*status);
 1739 
 1740     /* check if first comment string is to be repeated for all the keywords */
 1741     /* by looking to see if the last non-blank character is a '&' char      */
 1742 
 1743     repeat = 0;
 1744 
 1745     if (comm)
 1746     {
 1747       len = strlen(comm[0]);
 1748 
 1749       while (len > 0  && comm[0][len - 1] == ' ')
 1750         len--;                               /* ignore trailing blanks */
 1751 
 1752       if (len > 0 && comm[0][len - 1] == '&')
 1753       {
 1754         len = minvalue(len, FLEN_COMMENT);
 1755         tcomment[0] = '\0';
 1756         strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
 1757         repeat = 1;
 1758       }
 1759     }
 1760     else
 1761     {
 1762       repeat = 1;
 1763       tcomment[0] = '\0';
 1764     }
 1765 
 1766     for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
 1767     {
 1768         ffkeyn(keyroot, jj, keyname, status);
 1769         if (repeat)
 1770             ffpkyj(fptr, keyname, value[ii], tcomment, status);
 1771         else
 1772             ffpkyj(fptr, keyname, value[ii], comm[ii], status);
 1773 
 1774         if (*status > 0)
 1775             return(*status);
 1776     }
 1777     return(*status);
 1778 }
 1779 /*--------------------------------------------------------------------------*/
 1780 int ffpknf( fitsfile *fptr,     /* I - FITS file pointer                    */
 1781             const char *keyroot,      /* I - root name of keywords to write       */
 1782             int  nstart,        /* I - starting index number                */
 1783             int  nkey,          /* I - number of keywords to write          */
 1784             float *value,       /* I - array of keyword values              */
 1785             int decim,          /* I - number of decimals to display        */
 1786             char *comm[],       /* I - array of pointers to keyword comment */
 1787             int  *status)       /* IO - error status                        */
 1788 /*
 1789   Write (put) an indexed array of keywords with index numbers between
 1790   NSTART and (NSTART + NKEY -1) inclusive.  Writes fixed float values.
 1791 */
 1792 {
 1793     char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
 1794     int ii, jj, repeat, len;
 1795 
 1796     if (*status > 0)           /* inherit input status value if > 0 */
 1797         return(*status);
 1798 
 1799     /* check if first comment string is to be repeated for all the keywords */
 1800     /* by looking to see if the last non-blank character is a '&' char      */
 1801 
 1802     repeat = 0;
 1803 
 1804     if (comm)
 1805     {
 1806       len = strlen(comm[0]);
 1807 
 1808       while (len > 0  && comm[0][len - 1] == ' ')
 1809         len--;                               /* ignore trailing blanks */
 1810 
 1811       if (len > 0 && comm[0][len - 1] == '&')
 1812       {
 1813         len = minvalue(len, FLEN_COMMENT);
 1814         tcomment[0] = '\0';
 1815         strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
 1816         repeat = 1;
 1817       }
 1818     }
 1819     else
 1820     {
 1821       repeat = 1;
 1822       tcomment[0] = '\0';
 1823     }
 1824 
 1825     for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
 1826     {
 1827         ffkeyn(keyroot, jj, keyname, status);
 1828         if (repeat)
 1829             ffpkyf(fptr, keyname, value[ii], decim, tcomment, status);
 1830         else
 1831             ffpkyf(fptr, keyname, value[ii], decim, comm[ii], status);
 1832 
 1833         if (*status > 0)
 1834             return(*status);
 1835     }
 1836     return(*status);
 1837 }
 1838 /*--------------------------------------------------------------------------*/
 1839 int ffpkne( fitsfile *fptr,     /* I - FITS file pointer                    */
 1840             const char *keyroot,      /* I - root name of keywords to write       */
 1841             int  nstart,        /* I - starting index number                */
 1842             int  nkey,          /* I - number of keywords to write          */
 1843             float *value,       /* I - array of keyword values              */
 1844             int decim,          /* I - number of decimals to display        */
 1845             char *comm[],       /* I - array of pointers to keyword comment */
 1846             int  *status)       /* IO - error status                        */
 1847 /*
 1848   Write (put) an indexed array of keywords with index numbers between
 1849   NSTART and (NSTART + NKEY -1) inclusive.  Writes exponential float values.
 1850 */
 1851 {
 1852     char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
 1853     int ii, jj, repeat, len;
 1854 
 1855     if (*status > 0)           /* inherit input status value if > 0 */
 1856         return(*status);
 1857 
 1858     /* check if first comment string is to be repeated for all the keywords */
 1859     /* by looking to see if the last non-blank character is a '&' char      */
 1860 
 1861     repeat = 0;
 1862 
 1863     if (comm)
 1864     {
 1865       len = strlen(comm[0]);
 1866 
 1867       while (len > 0  && comm[0][len - 1] == ' ')
 1868         len--;                               /* ignore trailing blanks */
 1869 
 1870       if (len > 0 && comm[0][len - 1] == '&')
 1871       {
 1872         len = minvalue(len, FLEN_COMMENT);
 1873         tcomment[0] = '\0';
 1874         strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
 1875         repeat = 1;
 1876       }
 1877     }
 1878     else
 1879     {
 1880       repeat = 1;
 1881       tcomment[0] = '\0';
 1882     }
 1883 
 1884     for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
 1885     {
 1886         ffkeyn(keyroot, jj, keyname, status);
 1887         if (repeat)
 1888             ffpkye(fptr, keyname, value[ii], decim, tcomment, status);
 1889         else
 1890             ffpkye(fptr, keyname, value[ii], decim, comm[ii], status);
 1891 
 1892         if (*status > 0)
 1893             return(*status);
 1894     }
 1895     return(*status);
 1896 }
 1897 /*--------------------------------------------------------------------------*/
 1898 int ffpkng( fitsfile *fptr,     /* I - FITS file pointer                    */
 1899             const char *keyroot,      /* I - root name of keywords to write       */
 1900             int  nstart,        /* I - starting index number                */
 1901             int  nkey,          /* I - number of keywords to write          */
 1902             double *value,      /* I - array of keyword values              */
 1903             int decim,          /* I - number of decimals to display        */
 1904             char *comm[],       /* I - array of pointers to keyword comment */
 1905             int  *status)       /* IO - error status                        */
 1906 /*
 1907   Write (put) an indexed array of keywords with index numbers between
 1908   NSTART and (NSTART + NKEY -1) inclusive.  Writes fixed double values.
 1909 */
 1910 {
 1911     char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
 1912     int ii, jj, repeat, len;
 1913 
 1914     if (*status > 0)           /* inherit input status value if > 0 */
 1915         return(*status);
 1916 
 1917     /* check if first comment string is to be repeated for all the keywords */
 1918     /* by looking to see if the last non-blank character is a '&' char      */
 1919 
 1920     repeat = 0;
 1921 
 1922     if (comm)
 1923     {
 1924       len = strlen(comm[0]);
 1925 
 1926       while (len > 0  && comm[0][len - 1] == ' ')
 1927         len--;                               /* ignore trailing blanks */
 1928 
 1929       if (len > 0 && comm[0][len - 1] == '&')
 1930       {
 1931         len = minvalue(len, FLEN_COMMENT);
 1932         tcomment[0] = '\0';
 1933         strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
 1934         repeat = 1;
 1935       }
 1936     }
 1937     else
 1938     {
 1939       repeat = 1;
 1940       tcomment[0] = '\0';
 1941     }
 1942 
 1943     for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
 1944     {
 1945         ffkeyn(keyroot, jj, keyname, status);
 1946         if (repeat)
 1947             ffpkyg(fptr, keyname, value[ii], decim, tcomment, status);
 1948         else
 1949             ffpkyg(fptr, keyname, value[ii], decim, comm[ii], status);
 1950 
 1951         if (*status > 0)
 1952             return(*status);
 1953     }
 1954     return(*status);
 1955 }
 1956 /*--------------------------------------------------------------------------*/
 1957 int ffpknd( fitsfile *fptr,     /* I - FITS file pointer                    */
 1958             const char *keyroot,      /* I - root name of keywords to write       */
 1959             int  nstart,        /* I - starting index number                */
 1960             int  nkey,          /* I - number of keywords to write          */
 1961             double *value,      /* I - array of keyword values              */
 1962             int decim,          /* I - number of decimals to display        */
 1963             char *comm[],       /* I - array of pointers to keyword comment */
 1964             int  *status)       /* IO - error status                        */
 1965 /*
 1966   Write (put) an indexed array of keywords with index numbers between
 1967   NSTART and (NSTART + NKEY -1) inclusive.  Writes exponential double values.
 1968 */
 1969 {
 1970     char keyname[FLEN_KEYWORD], tcomment[FLEN_COMMENT];
 1971     int ii, jj, repeat, len;
 1972 
 1973     if (*status > 0)           /* inherit input status value if > 0 */
 1974         return(*status);
 1975 
 1976     /* check if first comment string is to be repeated for all the keywords */
 1977     /* by looking to see if the last non-blank character is a '&' char      */
 1978 
 1979     repeat = 0;
 1980 
 1981     if (comm)
 1982     {
 1983       len = strlen(comm[0]);
 1984 
 1985       while (len > 0  && comm[0][len - 1] == ' ')
 1986         len--;                               /* ignore trailing blanks */
 1987 
 1988       if (len > 0 && comm[0][len - 1] == '&')
 1989       {
 1990         len = minvalue(len, FLEN_COMMENT);
 1991         tcomment[0] = '\0';
 1992         strncat(tcomment, comm[0], len-1); /* don't copy the final '&' char */
 1993         repeat = 1;
 1994       }
 1995     }
 1996     else
 1997     {
 1998       repeat = 1;
 1999       tcomment[0] = '\0';
 2000     }
 2001 
 2002     for (ii=0, jj=nstart; ii < nkey; ii++, jj++)
 2003     {
 2004         ffkeyn(keyroot, jj, keyname, status);
 2005         if (repeat)
 2006             ffpkyd(fptr, keyname, value[ii], decim, tcomment, status);
 2007         else
 2008             ffpkyd(fptr, keyname, value[ii], decim, comm[ii], status);
 2009 
 2010         if (*status > 0)
 2011             return(*status);
 2012     }
 2013     return(*status);
 2014 }
 2015 /*--------------------------------------------------------------------------*/
 2016 int ffptdm( fitsfile *fptr, /* I - FITS file pointer                        */
 2017             int colnum,     /* I - column number                            */
 2018             int naxis,      /* I - number of axes in the data array         */
 2019             long naxes[],   /* I - length of each data axis                 */
 2020             int *status)    /* IO - error status                            */
 2021 /*
 2022   write the TDIMnnn keyword describing the dimensionality of a column
 2023 */
 2024 {
 2025     char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE], comm[FLEN_COMMENT];
 2026     char value[80], message[FLEN_ERRMSG];
 2027     int ii;
 2028     long totalpix = 1, repeat;
 2029     tcolumn *colptr;
 2030 
 2031     if (*status > 0)
 2032         return(*status);
 2033 
 2034     if (colnum < 1 || colnum > 999)
 2035     {
 2036         ffpmsg("column number is out of range 1 - 999 (ffptdm)");
 2037         return(*status = BAD_COL_NUM);
 2038     }
 2039 
 2040     if (naxis < 1)
 2041     {
 2042         ffpmsg("naxis is less than 1 (ffptdm)");
 2043         return(*status = BAD_DIMEN);
 2044     }
 2045 
 2046     /* reset position to the correct HDU if necessary */
 2047     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 2048         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 2049     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 2050         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 2051             return(*status);
 2052 
 2053     if ( (fptr->Fptr)->hdutype != BINARY_TBL)
 2054     {
 2055        ffpmsg(
 2056     "Error: The TDIMn keyword is only allowed in BINTABLE extensions (ffptdm)");
 2057        return(*status = NOT_BTABLE);
 2058     }
 2059 
 2060     strcpy(tdimstr, "(");            /* start constructing the TDIM value */   
 2061 
 2062     for (ii = 0; ii < naxis; ii++)
 2063     {
 2064         if (ii > 0)
 2065             strcat(tdimstr, ",");   /* append the comma separator */
 2066 
 2067         if (naxes[ii] < 0)
 2068         {
 2069             ffpmsg("one or more TDIM values are less than 0 (ffptdm)");
 2070             return(*status = BAD_TDIM);
 2071         }
 2072 
 2073         snprintf(value, 80,"%ld", naxes[ii]);
 2074         /* This will either be followed by a ',' or ')'. */
 2075         if (strlen(tdimstr)+strlen(value)+1 > FLEN_VALUE-1)
 2076         {
 2077             ffpmsg("TDIM string too long (ffptdm)");
 2078             return(*status = BAD_TDIM);
 2079         }
 2080         strcat(tdimstr, value);     /* append the axis size */
 2081 
 2082         totalpix *= naxes[ii];
 2083     }
 2084 
 2085     colptr = (fptr->Fptr)->tableptr;  /* point to first column structure */
 2086     colptr += (colnum - 1);      /* point to the specified column number */
 2087 
 2088     if ((long) colptr->trepeat != totalpix)
 2089     {
 2090       /* There is an apparent inconsistency between TDIMn and TFORMn. */
 2091       /* The colptr->trepeat value may be out of date, so re-read     */
 2092       /* the TFORMn keyword to be sure.                               */
 2093 
 2094       ffkeyn("TFORM", colnum, keyname, status);   /* construct TFORMn name  */
 2095       ffgkys(fptr, keyname, value, NULL, status); /* read TFORMn keyword    */
 2096       ffbnfm(value, NULL, &repeat, NULL, status); /* parse the repeat count */
 2097 
 2098       if (*status > 0 || repeat != totalpix)
 2099       {
 2100         snprintf(message,FLEN_ERRMSG,
 2101         "column vector length, %ld, does not equal TDIMn array size, %ld",
 2102         (long) colptr->trepeat, totalpix);
 2103         ffpmsg(message);
 2104         return(*status = BAD_TDIM);
 2105       }
 2106     }
 2107 
 2108     strcat(tdimstr, ")" );            /* append the closing parenthesis */
 2109 
 2110     strcpy(comm, "size of the multidimensional array");
 2111     ffkeyn("TDIM", colnum, keyname, status);      /* construct TDIMn name */
 2112     ffpkys(fptr, keyname, tdimstr, comm, status);  /* write the keyword */
 2113     return(*status);
 2114 }
 2115 /*--------------------------------------------------------------------------*/
 2116 int ffptdmll( fitsfile *fptr, /* I - FITS file pointer                      */
 2117             int colnum,     /* I - column number                            */
 2118             int naxis,      /* I - number of axes in the data array         */
 2119             LONGLONG naxes[], /* I - length of each data axis               */
 2120             int *status)    /* IO - error status                            */
 2121 /*
 2122   write the TDIMnnn keyword describing the dimensionality of a column
 2123 */
 2124 {
 2125     char keyname[FLEN_KEYWORD], tdimstr[FLEN_VALUE], comm[FLEN_COMMENT];
 2126     char value[80], message[81];
 2127     int ii;
 2128     LONGLONG totalpix = 1, repeat;
 2129     tcolumn *colptr;
 2130 
 2131     if (*status > 0)
 2132         return(*status);
 2133 
 2134     if (colnum < 1 || colnum > 999)
 2135     {
 2136         ffpmsg("column number is out of range 1 - 999 (ffptdm)");
 2137         return(*status = BAD_COL_NUM);
 2138     }
 2139 
 2140     if (naxis < 1)
 2141     {
 2142         ffpmsg("naxis is less than 1 (ffptdm)");
 2143         return(*status = BAD_DIMEN);
 2144     }
 2145 
 2146     /* reset position to the correct HDU if necessary */
 2147     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 2148         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 2149     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 2150         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 2151             return(*status);
 2152 
 2153     if ( (fptr->Fptr)->hdutype != BINARY_TBL)
 2154     {
 2155        ffpmsg(
 2156     "Error: The TDIMn keyword is only allowed in BINTABLE extensions (ffptdm)");
 2157        return(*status = NOT_BTABLE);
 2158     }
 2159 
 2160     strcpy(tdimstr, "(");            /* start constructing the TDIM value */   
 2161 
 2162     for (ii = 0; ii < naxis; ii++)
 2163     {
 2164         if (ii > 0)
 2165             strcat(tdimstr, ",");   /* append the comma separator */
 2166 
 2167         if (naxes[ii] < 0)
 2168         {
 2169             ffpmsg("one or more TDIM values are less than 0 (ffptdm)");
 2170             return(*status = BAD_TDIM);
 2171         }
 2172 
 2173         /* cast to double because the 64-bit int conversion character in */
 2174         /* sprintf is platform dependent ( %lld, %ld, %I64d )            */
 2175 
 2176         snprintf(value, 80, "%.0f", (double) naxes[ii]);
 2177         
 2178         if (strlen(tdimstr)+strlen(value)+1 > FLEN_VALUE-1)
 2179         {
 2180             ffpmsg("TDIM string too long (ffptdmll)");
 2181             return(*status = BAD_TDIM);
 2182         }
 2183         strcat(tdimstr, value);     /* append the axis size */
 2184 
 2185         totalpix *= naxes[ii];
 2186     }
 2187 
 2188     colptr = (fptr->Fptr)->tableptr;  /* point to first column structure */
 2189     colptr += (colnum - 1);      /* point to the specified column number */
 2190 
 2191     if ( colptr->trepeat != totalpix)
 2192     {
 2193       /* There is an apparent inconsistency between TDIMn and TFORMn. */
 2194       /* The colptr->trepeat value may be out of date, so re-read     */
 2195       /* the TFORMn keyword to be sure.                               */
 2196 
 2197       ffkeyn("TFORM", colnum, keyname, status);   /* construct TFORMn name  */
 2198       ffgkys(fptr, keyname, value, NULL, status); /* read TFORMn keyword    */
 2199       ffbnfmll(value, NULL, &repeat, NULL, status); /* parse the repeat count */
 2200 
 2201       if (*status > 0 || repeat != totalpix)
 2202       {
 2203         snprintf(message,FLEN_ERRMSG,
 2204         "column vector length, %.0f, does not equal TDIMn array size, %.0f",
 2205         (double) (colptr->trepeat), (double) totalpix);
 2206         ffpmsg(message);
 2207         return(*status = BAD_TDIM);
 2208       }
 2209     }
 2210 
 2211     strcat(tdimstr, ")" );            /* append the closing parenthesis */
 2212 
 2213     strcpy(comm, "size of the multidimensional array");
 2214     ffkeyn("TDIM", colnum, keyname, status);      /* construct TDIMn name */
 2215     ffpkys(fptr, keyname, tdimstr, comm, status);  /* write the keyword */
 2216     return(*status);
 2217 }
 2218 /*--------------------------------------------------------------------------*/
 2219 int ffphps( fitsfile *fptr, /* I - FITS file pointer                        */
 2220             int bitpix,     /* I - number of bits per data value pixel      */
 2221             int naxis,      /* I - number of axes in the data array         */
 2222             long naxes[],   /* I - length of each data axis                 */
 2223             int *status)    /* IO - error status                            */
 2224 /*
 2225   write STANDARD set of required primary header keywords
 2226 */
 2227 {
 2228     int simple = 1;     /* does file conform to FITS standard? 1/0  */
 2229     long pcount = 0;    /* number of group parameters (usually 0)   */
 2230     long gcount = 1;    /* number of random groups (usually 1 or 0) */
 2231     int extend = 1;     /* may FITS file have extensions?           */
 2232 
 2233     ffphpr(fptr, simple, bitpix, naxis, naxes, pcount, gcount, extend, status);
 2234     return(*status);
 2235 }
 2236 /*--------------------------------------------------------------------------*/
 2237 int ffphpsll( fitsfile *fptr, /* I - FITS file pointer                        */
 2238             int bitpix,     /* I - number of bits per data value pixel      */
 2239             int naxis,      /* I - number of axes in the data array         */
 2240             LONGLONG naxes[],   /* I - length of each data axis                 */
 2241             int *status)    /* IO - error status                            */
 2242 /*
 2243   write STANDARD set of required primary header keywords
 2244 */
 2245 {
 2246     int simple = 1;     /* does file conform to FITS standard? 1/0  */
 2247     LONGLONG pcount = 0;    /* number of group parameters (usually 0)   */
 2248     LONGLONG gcount = 1;    /* number of random groups (usually 1 or 0) */
 2249     int extend = 1;     /* may FITS file have extensions?           */
 2250 
 2251     ffphprll(fptr, simple, bitpix, naxis, naxes, pcount, gcount, extend, status);
 2252     return(*status);
 2253 }
 2254 /*--------------------------------------------------------------------------*/
 2255 int ffphpr( fitsfile *fptr, /* I - FITS file pointer                        */
 2256             int simple,     /* I - does file conform to FITS standard? 1/0  */
 2257             int bitpix,     /* I - number of bits per data value pixel      */
 2258             int naxis,      /* I - number of axes in the data array         */
 2259             long naxes[],   /* I - length of each data axis                 */
 2260             LONGLONG pcount, /* I - number of group parameters (usually 0)   */
 2261             LONGLONG gcount, /* I - number of random groups (usually 1 or 0) */
 2262             int extend,     /* I - may FITS file have extensions?           */
 2263             int *status)    /* IO - error status                            */
 2264 /*
 2265   write required primary header keywords
 2266 */
 2267 {
 2268     int ii;
 2269     LONGLONG naxesll[20];
 2270    
 2271     for (ii = 0; (ii < naxis) && (ii < 20); ii++)
 2272        naxesll[ii] = naxes[ii];
 2273 
 2274     ffphprll(fptr, simple, bitpix, naxis, naxesll, pcount, gcount,
 2275              extend, status);
 2276 
 2277     return(*status);
 2278 }
 2279 /*--------------------------------------------------------------------------*/
 2280 int ffphprll( fitsfile *fptr, /* I - FITS file pointer                        */
 2281             int simple,     /* I - does file conform to FITS standard? 1/0  */
 2282             int bitpix,     /* I - number of bits per data value pixel      */
 2283             int naxis,      /* I - number of axes in the data array         */
 2284             LONGLONG naxes[], /* I - length of each data axis                 */
 2285             LONGLONG pcount,  /* I - number of group parameters (usually 0)   */
 2286             LONGLONG gcount,  /* I - number of random groups (usually 1 or 0) */
 2287             int extend,     /* I - may FITS file have extensions?           */
 2288             int *status)    /* IO - error status                            */
 2289 /*
 2290   write required primary header keywords
 2291 */
 2292 {
 2293     int ii;
 2294     long longbitpix, tnaxes[20];
 2295     char name[FLEN_KEYWORD], comm[FLEN_COMMENT], message[FLEN_ERRMSG];
 2296     char card[FLEN_CARD];
 2297 
 2298     if (*status > 0)
 2299         return(*status);
 2300 
 2301     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 2302         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 2303 
 2304     if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
 2305         return(*status = HEADER_NOT_EMPTY);
 2306 
 2307     if (naxis != 0)   /* never try to compress a null image */
 2308     {
 2309       if ( (fptr->Fptr)->request_compress_type )
 2310       {
 2311       
 2312        for (ii = 0; ii < naxis; ii++)
 2313            tnaxes[ii] = (long) naxes[ii];
 2314        
 2315         /* write header for a compressed image */
 2316         imcomp_init_table(fptr, bitpix, naxis, tnaxes, 1, status);
 2317         return(*status);
 2318       }
 2319     }  
 2320 
 2321     if ((fptr->Fptr)->curhdu == 0)
 2322     {                /* write primary array header */
 2323         if (simple)
 2324             strcpy(comm, "file does conform to FITS standard");
 2325         else
 2326             strcpy(comm, "file does not conform to FITS standard");
 2327 
 2328         ffpkyl(fptr, "SIMPLE", simple, comm, status);
 2329     }
 2330     else
 2331     {               /* write IMAGE extension header */
 2332         strcpy(comm, "IMAGE extension");
 2333         ffpkys(fptr, "XTENSION", "IMAGE", comm, status);
 2334     }
 2335 
 2336     longbitpix = bitpix;
 2337 
 2338     /* test for the 3 special cases that represent unsigned integers */
 2339     if (longbitpix == USHORT_IMG)
 2340         longbitpix = SHORT_IMG;
 2341     else if (longbitpix == ULONG_IMG)
 2342         longbitpix = LONG_IMG;
 2343     else if (longbitpix == ULONGLONG_IMG)
 2344         longbitpix = LONGLONG_IMG;
 2345     else if (longbitpix == SBYTE_IMG)
 2346         longbitpix = BYTE_IMG;
 2347 
 2348     if (longbitpix != BYTE_IMG && longbitpix != SHORT_IMG && 
 2349         longbitpix != LONG_IMG && longbitpix != LONGLONG_IMG &&
 2350         longbitpix != FLOAT_IMG && longbitpix != DOUBLE_IMG)
 2351     {
 2352         snprintf(message,FLEN_ERRMSG,
 2353         "Illegal value for BITPIX keyword: %d", bitpix);
 2354         ffpmsg(message);
 2355         return(*status = BAD_BITPIX);
 2356     }
 2357 
 2358     strcpy(comm, "number of bits per data pixel");
 2359     if (ffpkyj(fptr, "BITPIX", longbitpix, comm, status) > 0)
 2360         return(*status);
 2361 
 2362     if (naxis < 0 || naxis > 999)
 2363     {
 2364         snprintf(message,FLEN_ERRMSG,
 2365         "Illegal value for NAXIS keyword: %d", naxis);
 2366         ffpmsg(message);
 2367         return(*status = BAD_NAXIS);
 2368     }
 2369 
 2370     strcpy(comm, "number of data axes");
 2371     ffpkyj(fptr, "NAXIS", naxis, comm, status);
 2372 
 2373     strcpy(comm, "length of data axis ");
 2374     for (ii = 0; ii < naxis; ii++)
 2375     {
 2376         if (naxes[ii] < 0)
 2377         {
 2378             snprintf(message,FLEN_ERRMSG,
 2379             "Illegal negative value for NAXIS%d keyword: %.0f", ii + 1, (double) (naxes[ii]));
 2380             ffpmsg(message);
 2381             return(*status = BAD_NAXES);
 2382         }
 2383 
 2384         snprintf(&comm[20], FLEN_COMMENT-20,"%d", ii + 1);
 2385         ffkeyn("NAXIS", ii + 1, name, status);
 2386         ffpkyj(fptr, name, naxes[ii], comm, status);
 2387     }
 2388 
 2389     if ((fptr->Fptr)->curhdu == 0)  /* the primary array */
 2390     {
 2391         if (extend)
 2392         {
 2393             /* only write EXTEND keyword if value = true */
 2394             strcpy(comm, "FITS dataset may contain extensions");
 2395             ffpkyl(fptr, "EXTEND", extend, comm, status);
 2396         }
 2397 
 2398         if (pcount < 0)
 2399         {
 2400             ffpmsg("pcount value is less than 0");
 2401             return(*status = BAD_PCOUNT);
 2402         }
 2403 
 2404         else if (gcount < 1)
 2405         {
 2406             ffpmsg("gcount value is less than 1");
 2407             return(*status = BAD_GCOUNT);
 2408         }
 2409 
 2410         else if (pcount > 0 || gcount > 1)
 2411         {
 2412             /* only write these keyword if non-standard values */
 2413             strcpy(comm, "random group records are present");
 2414             ffpkyl(fptr, "GROUPS", 1, comm, status);
 2415 
 2416             strcpy(comm, "number of random group parameters");
 2417             ffpkyj(fptr, "PCOUNT", pcount, comm, status);
 2418   
 2419             strcpy(comm, "number of random groups");
 2420             ffpkyj(fptr, "GCOUNT", gcount, comm, status);
 2421         }
 2422 
 2423       /* write standard block of self-documentating comments */
 2424       ffprec(fptr,
 2425       "COMMENT   FITS (Flexible Image Transport System) format is defined in 'Astronomy",
 2426       status);
 2427       ffprec(fptr,
 2428       "COMMENT   and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H",
 2429       status);
 2430     }
 2431 
 2432     else  /* an IMAGE extension */
 2433 
 2434     {   /* image extension; cannot have random groups */
 2435         if (pcount != 0)
 2436         {
 2437             ffpmsg("image extensions must have pcount = 0");
 2438             *status = BAD_PCOUNT;
 2439         }
 2440 
 2441         else if (gcount != 1)
 2442         {
 2443             ffpmsg("image extensions must have gcount = 1");
 2444             *status = BAD_GCOUNT;
 2445         }
 2446 
 2447         else
 2448         {
 2449             strcpy(comm, "required keyword; must = 0");
 2450             ffpkyj(fptr, "PCOUNT", 0, comm, status);
 2451   
 2452             strcpy(comm, "required keyword; must = 1");
 2453             ffpkyj(fptr, "GCOUNT", 1, comm, status);
 2454         }
 2455     }
 2456 
 2457     /* Write the BSCALE and BZERO keywords, if an unsigned integer image */
 2458     if (bitpix == USHORT_IMG)
 2459     {
 2460         strcpy(comm, "offset data range to that of unsigned short");
 2461         ffpkyg(fptr, "BZERO", 32768., 0, comm, status);
 2462         strcpy(comm, "default scaling factor");
 2463         ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
 2464     }
 2465     else if (bitpix == ULONG_IMG)
 2466     {
 2467         strcpy(comm, "offset data range to that of unsigned long");
 2468         ffpkyg(fptr, "BZERO", 2147483648., 0, comm, status);
 2469         strcpy(comm, "default scaling factor");
 2470         ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
 2471     }
 2472     else if (bitpix == ULONGLONG_IMG)
 2473     {
 2474         strcpy(card,"BZERO   =  9223372036854775808 / offset data range to that of unsigned long long");
 2475         ffprec(fptr, card, status);
 2476         strcpy(comm, "default scaling factor");
 2477         ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
 2478     }
 2479     else if (bitpix == SBYTE_IMG)
 2480     {
 2481         strcpy(comm, "offset data range to that of signed byte");
 2482         ffpkyg(fptr, "BZERO", -128., 0, comm, status);
 2483         strcpy(comm, "default scaling factor");
 2484         ffpkyg(fptr, "BSCALE", 1.0, 0, comm, status);
 2485     }
 2486     return(*status);
 2487 }
 2488 /*--------------------------------------------------------------------------*/
 2489 int ffphtb(fitsfile *fptr,  /* I - FITS file pointer                        */
 2490            LONGLONG naxis1,     /* I - width of row in the table                */
 2491            LONGLONG naxis2,     /* I - number of rows in the table              */
 2492            int tfields,     /* I - number of columns in the table           */
 2493            char **ttype,    /* I - name of each column                      */
 2494            long *tbcol,     /* I - byte offset in row to each column        */
 2495            char **tform,    /* I - value of TFORMn keyword for each column  */
 2496            char **tunit,    /* I - value of TUNITn keyword for each column  */
 2497            const char *extnmx,   /* I - value of EXTNAME keyword, if any         */
 2498            int *status)     /* IO - error status                            */
 2499 /*
 2500   Put required Header keywords into the ASCII TaBle:
 2501 */
 2502 {
 2503     int ii, ncols, gotmem = 0;
 2504     long rowlen; /* must be 'long' because it is passed to ffgabc */
 2505     char tfmt[30], name[FLEN_KEYWORD], comm[FLEN_COMMENT], extnm[FLEN_VALUE];
 2506 
 2507     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 2508         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 2509 
 2510     if (*status > 0)
 2511         return(*status);
 2512     else if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
 2513         return(*status = HEADER_NOT_EMPTY);
 2514     else if (naxis1 < 0)
 2515         return(*status = NEG_WIDTH);
 2516     else if (naxis2 < 0)
 2517         return(*status = NEG_ROWS);
 2518     else if (tfields < 0 || tfields > 999)
 2519         return(*status = BAD_TFIELDS);
 2520     
 2521     extnm[0] = '\0';
 2522     if (extnmx)
 2523         strncat(extnm, extnmx, FLEN_VALUE-1);
 2524 
 2525     rowlen = (long) naxis1;
 2526 
 2527     if (!tbcol || !tbcol[0] || (!naxis1 && tfields)) /* spacing not defined? */
 2528     {
 2529       /* allocate mem for tbcol; malloc can have problems allocating small */
 2530       /* arrays, so allocate at least 20 bytes */
 2531 
 2532       ncols = maxvalue(5, tfields);
 2533       tbcol = (long *) calloc(ncols, sizeof(long));
 2534 
 2535       if (tbcol)
 2536       {
 2537         gotmem = 1;
 2538 
 2539         /* calculate width of a row and starting position of each column. */
 2540         /* Each column will be separated by 1 blank space */
 2541         ffgabc(tfields, tform, 1, &rowlen, tbcol, status);
 2542       }
 2543     }
 2544     ffpkys(fptr, "XTENSION", "TABLE", "ASCII table extension", status);
 2545     ffpkyj(fptr, "BITPIX", 8, "8-bit ASCII characters", status);
 2546     ffpkyj(fptr, "NAXIS", 2, "2-dimensional ASCII table", status);
 2547     ffpkyj(fptr, "NAXIS1", rowlen, "width of table in characters", status);
 2548     ffpkyj(fptr, "NAXIS2", naxis2, "number of rows in table", status);
 2549     ffpkyj(fptr, "PCOUNT", 0, "no group parameters (required keyword)", status);
 2550     ffpkyj(fptr, "GCOUNT", 1, "one data group (required keyword)", status);
 2551     ffpkyj(fptr, "TFIELDS", tfields, "number of fields in each row", status);
 2552 
 2553     for (ii = 0; ii < tfields; ii++) /* loop over every column */
 2554     {
 2555         if ( *(ttype[ii]) )  /* optional TTYPEn keyword */
 2556         {
 2557           snprintf(comm, FLEN_COMMENT,"label for field %3d", ii + 1);
 2558           ffkeyn("TTYPE", ii + 1, name, status);
 2559           ffpkys(fptr, name, ttype[ii], comm, status);
 2560         }
 2561 
 2562         if (tbcol[ii] < 1 || tbcol[ii] > rowlen)
 2563            *status = BAD_TBCOL;
 2564 
 2565         snprintf(comm, FLEN_COMMENT,"beginning column of field %3d", ii + 1);
 2566         ffkeyn("TBCOL", ii + 1, name, status);
 2567         ffpkyj(fptr, name, tbcol[ii], comm, status);
 2568 
 2569         if (strlen(tform[ii]) > 29)
 2570         {
 2571           ffpmsg("Error: ASCII table TFORM code is too long (ffphtb)");
 2572           *status = BAD_TFORM;
 2573           break;
 2574         }
 2575         strcpy(tfmt, tform[ii]);  /* required TFORMn keyword */
 2576         ffupch(tfmt);
 2577         ffkeyn("TFORM", ii + 1, name, status);
 2578         ffpkys(fptr, name, tfmt, "Fortran-77 format of field", status);
 2579 
 2580         if (tunit)
 2581         {
 2582          if (tunit[ii] && *(tunit[ii]) )  /* optional TUNITn keyword */
 2583          {
 2584           ffkeyn("TUNIT", ii + 1, name, status);
 2585           ffpkys(fptr, name, tunit[ii], "physical unit of field", status) ;
 2586          }
 2587         }
 2588 
 2589         if (*status > 0)
 2590             break;       /* abort loop on error */
 2591     }
 2592 
 2593     if (extnm[0])       /* optional EXTNAME keyword */
 2594         ffpkys(fptr, "EXTNAME", extnm,
 2595                "name of this ASCII table extension", status);
 2596 
 2597     if (*status > 0)
 2598         ffpmsg("Failed to write ASCII table header keywords (ffphtb)");
 2599 
 2600     if (gotmem)
 2601         free(tbcol); 
 2602 
 2603     return(*status);
 2604 }
 2605 /*--------------------------------------------------------------------------*/
 2606 int ffphbn(fitsfile *fptr,  /* I - FITS file pointer                        */
 2607            LONGLONG naxis2,     /* I - number of rows in the table              */
 2608            int tfields,     /* I - number of columns in the table           */
 2609            char **ttype,    /* I - name of each column                      */
 2610            char **tform,    /* I - value of TFORMn keyword for each column  */
 2611            char **tunit,    /* I - value of TUNITn keyword for each column  */
 2612            const char *extnmx,   /* I - value of EXTNAME keyword, if any         */
 2613            LONGLONG pcount,     /* I - size of the variable length heap area    */
 2614            int *status)     /* IO - error status                            */
 2615 /*
 2616   Put required Header keywords into the Binary Table:
 2617 */
 2618 {
 2619     int ii, datatype, iread = 0;
 2620     long repeat, width;
 2621     LONGLONG naxis1;
 2622 
 2623     char tfmt[30], name[FLEN_KEYWORD], comm[FLEN_COMMENT], extnm[FLEN_VALUE];
 2624     char *cptr, card[FLEN_CARD];
 2625     tcolumn *colptr;
 2626 
 2627     if (*status > 0)
 2628         return(*status);
 2629 
 2630     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 2631         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 2632 
 2633     if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
 2634         return(*status = HEADER_NOT_EMPTY);
 2635     else if (naxis2 < 0)
 2636         return(*status = NEG_ROWS);
 2637     else if (pcount < 0)
 2638         return(*status = BAD_PCOUNT);
 2639     else if (tfields < 0 || tfields > 999)
 2640         return(*status = BAD_TFIELDS);
 2641 
 2642     extnm[0] = '\0';
 2643     if (extnmx)
 2644         strncat(extnm, extnmx, FLEN_VALUE-1);
 2645 
 2646     ffpkys(fptr, "XTENSION", "BINTABLE", "binary table extension", status);
 2647     ffpkyj(fptr, "BITPIX", 8, "8-bit bytes", status);
 2648     ffpkyj(fptr, "NAXIS", 2, "2-dimensional binary table", status);
 2649 
 2650     naxis1 = 0;
 2651     for (ii = 0; ii < tfields; ii++)  /* sum the width of each field */
 2652     {
 2653         ffbnfm(tform[ii], &datatype, &repeat, &width, status);
 2654 
 2655         if (datatype == TSTRING)
 2656             naxis1 += repeat;   /* one byte per char */
 2657         else if (datatype == TBIT)
 2658             naxis1 += (repeat + 7) / 8;
 2659         else if (datatype > 0)
 2660             naxis1 += repeat * (datatype / 10);
 2661         else if (tform[ii][0] == 'P' || tform[ii][1] == 'P'||
 2662                  tform[ii][0] == 'p' || tform[ii][1] == 'p')
 2663            /* this is a 'P' variable length descriptor (neg. datatype) */
 2664             naxis1 += 8;
 2665         else
 2666            /* this is a 'Q' variable length descriptor (neg. datatype) */
 2667             naxis1 += 16;
 2668 
 2669         if (*status > 0)
 2670             break;       /* abort loop on error */
 2671     }
 2672 
 2673     ffpkyj(fptr, "NAXIS1", naxis1, "width of table in bytes", status);
 2674     ffpkyj(fptr, "NAXIS2", naxis2, "number of rows in table", status);
 2675 
 2676     /*
 2677       the initial value of PCOUNT (= size of the variable length array heap)
 2678       should always be zero.  If any variable length data is written, then
 2679       the value of PCOUNT will be updated when the HDU is closed
 2680     */
 2681     ffpkyj(fptr, "PCOUNT", 0, "size of special data area", status);
 2682     ffpkyj(fptr, "GCOUNT", 1, "one data group (required keyword)", status);
 2683     ffpkyj(fptr, "TFIELDS", tfields, "number of fields in each row", status);
 2684 
 2685     for (ii = 0; ii < tfields; ii++) /* loop over every column */
 2686     {
 2687         if ( *(ttype[ii]) )  /* optional TTYPEn keyword */
 2688         {
 2689           snprintf(comm, FLEN_COMMENT,"label for field %3d", ii + 1);
 2690           ffkeyn("TTYPE", ii + 1, name, status);
 2691           ffpkys(fptr, name, ttype[ii], comm, status);
 2692         }
 2693 
 2694         if (strlen(tform[ii]) > 29)
 2695         {
 2696           ffpmsg("Error: BIN table TFORM code is too long (ffphbn)");
 2697           *status = BAD_TFORM;
 2698           break;
 2699         }
 2700         strcpy(tfmt, tform[ii]);  /* required TFORMn keyword */
 2701         ffupch(tfmt);
 2702 
 2703         ffkeyn("TFORM", ii + 1, name, status);
 2704         strcpy(comm, "data format of field");
 2705 
 2706         ffbnfm(tfmt, &datatype, &repeat, &width, status);
 2707 
 2708         if (datatype == TSTRING)
 2709         {
 2710             strcat(comm, ": ASCII Character");
 2711 
 2712             /* Do sanity check to see if an ASCII table format was used,  */
 2713             /* e.g., 'A8' instead of '8A', or a bad unit width eg '8A9'.  */
 2714             /* Don't want to return an error status, so write error into  */
 2715             /* the keyword comment.  */
 2716 
 2717             cptr = strchr(tfmt,'A');
 2718             cptr++;
 2719 
 2720             if (cptr)
 2721                iread = sscanf(cptr,"%ld", &width);
 2722 
 2723             if (iread == 1 && (width > repeat)) 
 2724             {
 2725               if (repeat == 1)
 2726                 strcpy(comm, "ERROR??  USING ASCII TABLE SYNTAX BY MISTAKE??");
 2727               else
 2728                 strcpy(comm, "rAw FORMAT ERROR! UNIT WIDTH w > COLUMN WIDTH r");
 2729             }
 2730         }
 2731         else if (datatype == TBIT)
 2732            strcat(comm, ": BIT");
 2733         else if (datatype == TBYTE)
 2734            strcat(comm, ": BYTE");
 2735         else if (datatype == TLOGICAL)
 2736            strcat(comm, ": 1-byte LOGICAL");
 2737         else if (datatype == TSHORT)
 2738            strcat(comm, ": 2-byte INTEGER");
 2739         else if (datatype == TUSHORT)
 2740            strcat(comm, ": 2-byte INTEGER");
 2741         else if (datatype == TLONG)
 2742            strcat(comm, ": 4-byte INTEGER");
 2743         else if (datatype == TLONGLONG)
 2744            strcat(comm, ": 8-byte INTEGER");
 2745         else if (datatype == TULONG)
 2746            strcat(comm, ": 4-byte INTEGER");
 2747         else if (datatype == TULONGLONG)
 2748            strcat(comm, ": 8-byte INTEGER");
 2749         else if (datatype == TFLOAT)
 2750            strcat(comm, ": 4-byte REAL");
 2751         else if (datatype == TDOUBLE)
 2752            strcat(comm, ": 8-byte DOUBLE");
 2753         else if (datatype == TCOMPLEX)
 2754            strcat(comm, ": COMPLEX");
 2755         else if (datatype == TDBLCOMPLEX)
 2756            strcat(comm, ": DOUBLE COMPLEX");
 2757         else if (datatype < 0)
 2758            strcat(comm, ": variable length array");
 2759 
 2760         if (abs(datatype) == TSBYTE) /* signed bytes */
 2761         {
 2762            /* Replace the 'S' with an 'B' in the TFORMn code */
 2763            cptr = tfmt;
 2764            while (*cptr != 'S') 
 2765               cptr++;
 2766 
 2767            *cptr = 'B';
 2768            ffpkys(fptr, name, tfmt, comm, status);
 2769 
 2770            /* write the TZEROn and TSCALn keywords */
 2771            ffkeyn("TZERO", ii + 1, name, status);
 2772            strcpy(comm, "offset for signed bytes");
 2773 
 2774            ffpkyg(fptr, name, -128., 0, comm, status);
 2775 
 2776            ffkeyn("TSCAL", ii + 1, name, status);
 2777            strcpy(comm, "data are not scaled");
 2778            ffpkyg(fptr, name, 1., 0, comm, status);
 2779         }
 2780         else if (abs(datatype) == TUSHORT) 
 2781         {
 2782            /* Replace the 'U' with an 'I' in the TFORMn code */
 2783            cptr = tfmt;
 2784            while (*cptr != 'U') 
 2785               cptr++;
 2786 
 2787            *cptr = 'I';
 2788            ffpkys(fptr, name, tfmt, comm, status);
 2789 
 2790            /* write the TZEROn and TSCALn keywords */
 2791            ffkeyn("TZERO", ii + 1, name, status);
 2792            strcpy(comm, "offset for unsigned integers");
 2793 
 2794            ffpkyg(fptr, name, 32768., 0, comm, status);
 2795 
 2796            ffkeyn("TSCAL", ii + 1, name, status);
 2797            strcpy(comm, "data are not scaled");
 2798            ffpkyg(fptr, name, 1., 0, comm, status);
 2799         }
 2800         else if (abs(datatype) == TULONG) 
 2801         {
 2802            /* Replace the 'V' with an 'J' in the TFORMn code */
 2803            cptr = tfmt;
 2804            while (*cptr != 'V') 
 2805               cptr++;
 2806 
 2807            *cptr = 'J';
 2808            ffpkys(fptr, name, tfmt, comm, status);
 2809 
 2810            /* write the TZEROn and TSCALn keywords */
 2811            ffkeyn("TZERO", ii + 1, name, status);
 2812            strcpy(comm, "offset for unsigned integers");
 2813 
 2814            ffpkyg(fptr, name, 2147483648., 0, comm, status);
 2815 
 2816            ffkeyn("TSCAL", ii + 1, name, status);
 2817            strcpy(comm, "data are not scaled");
 2818            ffpkyg(fptr, name, 1., 0, comm, status);
 2819         }
 2820         else if (abs(datatype) == TULONGLONG) 
 2821         {      
 2822            /* Replace the 'W' with an 'K' in the TFORMn code */
 2823            cptr = tfmt;
 2824            while (*cptr != 'W') 
 2825               cptr++;
 2826 
 2827            *cptr = 'K';
 2828            ffpkys(fptr, name, tfmt, comm, status);
 2829 
 2830            /* write the TZEROn and TSCALn keywords */
 2831            ffkeyn("TZERO", ii + 1, card, status);
 2832            strcat(card, "     ");  /* make sure name is >= 8 chars long */
 2833            *(card+8) = '\0';
 2834        strcat(card, "=  9223372036854775808 / offset for unsigned integers");
 2835        fits_write_record(fptr, card, status);
 2836 
 2837            ffkeyn("TSCAL", ii + 1, name, status);
 2838            strcpy(comm, "data are not scaled");
 2839            ffpkyg(fptr, name, 1., 0, comm, status);
 2840         }
 2841         else
 2842         {
 2843            ffpkys(fptr, name, tfmt, comm, status);
 2844         }
 2845 
 2846         if (tunit)
 2847         {
 2848          if (tunit[ii] && *(tunit[ii]) ) /* optional TUNITn keyword */
 2849          {
 2850           ffkeyn("TUNIT", ii + 1, name, status);
 2851           ffpkys(fptr, name, tunit[ii],
 2852              "physical unit of field", status);
 2853          }
 2854         }
 2855 
 2856         if (*status > 0)
 2857             break;       /* abort loop on error */
 2858     }
 2859 
 2860     if (extnm[0])       /* optional EXTNAME keyword */
 2861         ffpkys(fptr, "EXTNAME", extnm,
 2862                "name of this binary table extension", status);
 2863 
 2864     if (*status > 0)
 2865         ffpmsg("Failed to write binary table header keywords (ffphbn)");
 2866 
 2867     return(*status);
 2868 }
 2869 /*--------------------------------------------------------------------------*/
 2870 int ffphext(fitsfile *fptr,  /* I - FITS file pointer                       */
 2871            const char *xtensionx,   /* I - value for the XTENSION keyword          */
 2872            int bitpix,       /* I - value for the BIXPIX keyword            */
 2873            int naxis,        /* I - value for the NAXIS keyword             */
 2874            long naxes[],     /* I - value for the NAXISn keywords           */
 2875            LONGLONG pcount,  /* I - value for the PCOUNT keyword            */
 2876            LONGLONG gcount,  /* I - value for the GCOUNT keyword            */
 2877            int *status)      /* IO - error status                           */
 2878 /*
 2879   Put required Header keywords into a conforming extension:
 2880 */
 2881 {
 2882     char message[FLEN_ERRMSG],comm[81], name[20], xtension[FLEN_VALUE];
 2883     int ii;
 2884  
 2885     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 2886         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 2887 
 2888     if (*status > 0)
 2889         return(*status);
 2890     else if ((fptr->Fptr)->headend != (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu] )
 2891         return(*status = HEADER_NOT_EMPTY);
 2892 
 2893     if (naxis < 0 || naxis > 999)
 2894     {
 2895         snprintf(message,FLEN_ERRMSG,
 2896         "Illegal value for NAXIS keyword: %d", naxis);
 2897         ffpmsg(message);
 2898         return(*status = BAD_NAXIS);
 2899     }
 2900 
 2901     xtension[0] = '\0';
 2902     strncat(xtension, xtensionx, FLEN_VALUE-1);
 2903 
 2904     ffpkys(fptr, "XTENSION", xtension, "extension type", status);
 2905     ffpkyj(fptr, "BITPIX",   bitpix,   "number of bits per data pixel", status);
 2906     ffpkyj(fptr, "NAXIS",    naxis,    "number of data axes", status);
 2907 
 2908     strcpy(comm, "length of data axis ");
 2909     for (ii = 0; ii < naxis; ii++)
 2910     {
 2911         if (naxes[ii] < 0)
 2912         {
 2913             snprintf(message,FLEN_ERRMSG,
 2914             "Illegal negative value for NAXIS%d keyword: %.0f", ii + 1, (double) (naxes[ii]));
 2915             ffpmsg(message);
 2916             return(*status = BAD_NAXES);
 2917         }
 2918 
 2919         snprintf(&comm[20], 61, "%d", ii + 1);
 2920         ffkeyn("NAXIS", ii + 1, name, status);
 2921         ffpkyj(fptr, name, naxes[ii], comm, status);
 2922     }
 2923 
 2924 
 2925     ffpkyj(fptr, "PCOUNT", pcount, " ", status);
 2926     ffpkyj(fptr, "GCOUNT", gcount, " ", status);
 2927 
 2928     if (*status > 0)
 2929         ffpmsg("Failed to write extension header keywords (ffphext)");
 2930 
 2931     return(*status);
 2932 }
 2933 /*--------------------------------------------------------------------------*/
 2934 int ffi2c(LONGLONG ival,  /* I - value to be converted to a string */
 2935           char *cval,     /* O - character string representation of the value */
 2936           int *status)    /* IO - error status */
 2937 /*
 2938   convert  value to a null-terminated formatted string.
 2939 */
 2940 {
 2941     if (*status > 0)           /* inherit input status value if > 0 */
 2942         return(*status);
 2943 
 2944     cval[0] = '\0';
 2945 
 2946 #if defined(_MSC_VER)
 2947     /* Microsoft Visual C++ 6.0 uses '%I64d' syntax  for 8-byte integers */
 2948     if (sprintf(cval, "%I64d", ival) < 0)
 2949 
 2950 #elif (USE_LL_SUFFIX == 1)
 2951     if (sprintf(cval, "%lld", ival) < 0)
 2952 #else
 2953     if (sprintf(cval, "%ld", ival) < 0)
 2954 #endif
 2955     {
 2956         ffpmsg("Error in ffi2c converting integer to string");
 2957         *status = BAD_I2C;
 2958     }
 2959     return(*status);
 2960 }
 2961 /*--------------------------------------------------------------------------*/
 2962 int ffu2c(ULONGLONG ival,  /* I - value to be converted to a string */
 2963           char *cval,     /* O - character string representation of the value */
 2964           int *status)    /* IO - error status */
 2965 /*
 2966   convert  value to a null-terminated formatted string.
 2967 */
 2968 {
 2969     if (*status > 0)           /* inherit input status value if > 0 */
 2970         return(*status);
 2971 
 2972     cval[0] = '\0';
 2973 
 2974 #if defined(_MSC_VER)
 2975     /* Microsoft Visual C++ 6.0 uses '%I64d' syntax  for 8-byte integers */
 2976     if (sprintf(cval, "%I64u", ival) < 0)
 2977 
 2978 #elif (USE_LL_SUFFIX == 1)
 2979     if (sprintf(cval, "%llu", ival) < 0)
 2980 #else
 2981     if (sprintf(cval, "%lu", ival) < 0)
 2982 #endif
 2983     {
 2984         ffpmsg("Error in ffu2c converting integer to string");
 2985         *status = BAD_I2C;
 2986     }
 2987     return(*status);
 2988 }
 2989 /*--------------------------------------------------------------------------*/
 2990 int ffl2c(int lval,    /* I - value to be converted to a string */
 2991           char *cval,  /* O - character string representation of the value */
 2992           int *status) /* IO - error status ) */
 2993 /*
 2994   convert logical value to a null-terminated formatted string.  If the
 2995   input value == 0, then the output character is the letter F, else
 2996   the output character is the letter T.  The output string is null terminated.
 2997 */
 2998 {
 2999     if (*status > 0)           /* inherit input status value if > 0 */
 3000         return(*status);
 3001 
 3002     if (lval)
 3003         strcpy(cval,"T");
 3004     else
 3005         strcpy(cval,"F");
 3006 
 3007     return(*status);
 3008 }
 3009 /*--------------------------------------------------------------------------*/
 3010 int ffs2c(const char *instr, /* I - null terminated input string  */
 3011           char *outstr,      /* O - null terminated quoted output string */
 3012           int *status)       /* IO - error status */
 3013 /*
 3014   convert an input string to a quoted string. Leading spaces 
 3015   are significant.  FITS string keyword values must be at least 
 3016   8 chars long so pad out string with spaces if necessary.
 3017       Example:   km/s ==> 'km/s    '
 3018   Single quote characters in the input string will be replace by
 3019   two single quote characters. e.g., o'brian ==> 'o''brian'
 3020 */
 3021 {
 3022     size_t len, ii, jj;
 3023 
 3024     if (*status > 0)           /* inherit input status value if > 0 */
 3025         return(*status);
 3026 
 3027     if (!instr)            /* a null input pointer?? */
 3028     {
 3029        strcpy(outstr, "''");   /* a null FITS string */
 3030        return(*status);
 3031     }
 3032 
 3033     outstr[0] = '\'';      /* start output string with a quote */
 3034 
 3035     len = strlen(instr);
 3036     if (len > 68)
 3037         len = 68;    /* limit input string to 68 chars */
 3038 
 3039     for (ii=0, jj=1; ii < len && jj < 69; ii++, jj++)
 3040     {
 3041         outstr[jj] = instr[ii];  /* copy each char from input to output */
 3042         if (instr[ii] == '\'')
 3043         {
 3044             jj++;
 3045             outstr[jj]='\'';   /* duplicate any apostrophies in the input */
 3046         }
 3047     }
 3048 
 3049     for (; jj < 9; jj++)       /* pad string so it is at least 8 chars long */
 3050         outstr[jj] = ' ';
 3051 
 3052     if (jj == 70)   /* only occurs if the last char of string was a quote */
 3053         outstr[69] = '\0';
 3054     else
 3055     {
 3056         outstr[jj] = '\'';         /* append closing quote character */
 3057         outstr[jj+1] = '\0';          /* terminate the string */
 3058     }
 3059 
 3060     return(*status);
 3061 }
 3062 /*--------------------------------------------------------------------------*/
 3063 int ffr2f(float fval,   /* I - value to be converted to a string */
 3064           int  decim,   /* I - number of decimal places to display */
 3065           char *cval,   /* O - character string representation of the value */
 3066           int  *status) /* IO - error status */
 3067 /*
 3068   convert float value to a null-terminated F format string
 3069 */
 3070 {
 3071     char *cptr;
 3072         
 3073     if (*status > 0)           /* inherit input status value if > 0 */
 3074         return(*status);
 3075 
 3076     cval[0] = '\0';
 3077 
 3078     if (decim < 0)
 3079     {
 3080         ffpmsg("Error in ffr2f:  no. of decimal places < 0");
 3081         return(*status = BAD_DECIM);
 3082     }
 3083 
 3084     if (snprintf(cval, FLEN_VALUE,"%.*f", decim, fval) < 0)
 3085     {
 3086         ffpmsg("Error in ffr2f converting float to string");
 3087         *status = BAD_F2C;
 3088     }
 3089 
 3090     /* replace comma with a period (e.g. in French locale) */
 3091     if ( (cptr = strchr(cval, ','))) *cptr = '.';
 3092 
 3093     /* test if output string is 'NaN', 'INDEF', or 'INF' */
 3094     if (strchr(cval, 'N'))
 3095     {
 3096         ffpmsg("Error in ffr2f: float value is a NaN or INDEF");
 3097         *status = BAD_F2C;
 3098     }
 3099 
 3100     return(*status);
 3101 }
 3102 /*--------------------------------------------------------------------------*/
 3103 int ffr2e(float fval,  /* I - value to be converted to a string */
 3104          int decim,    /* I - number of decimal places to display */
 3105          char *cval,   /* O - character string representation of the value */
 3106          int *status)  /* IO - error status */
 3107 /*
 3108   convert float value to a null-terminated exponential format string
 3109 */
 3110 {
 3111     char *cptr;
 3112 
 3113     if (*status > 0)           /* inherit input status value if > 0 */
 3114         return(*status);
 3115 
 3116     cval[0] = '\0';
 3117 
 3118     if (decim < 0)
 3119     {   /* use G format if decim is negative */
 3120         if ( snprintf(cval, FLEN_VALUE,"%.*G", -decim, fval) < 0)
 3121         {
 3122             ffpmsg("Error in ffr2e converting float to string");
 3123             *status = BAD_F2C;
 3124         }
 3125         else
 3126         {
 3127             /* test if E format was used, and there is no displayed decimal */
 3128             if ( !strchr(cval, '.') && strchr(cval,'E') )
 3129             {
 3130                 /* reformat value with a decimal point and single zero */
 3131                 if ( snprintf(cval, FLEN_VALUE,"%.1E", fval) < 0)
 3132                 {
 3133                     ffpmsg("Error in ffr2e converting float to string");
 3134                     *status = BAD_F2C;
 3135                 }
 3136 
 3137                 return(*status);  
 3138             }
 3139         }
 3140     }
 3141     else
 3142     {
 3143         if ( snprintf(cval, FLEN_VALUE,"%.*E", decim, fval) < 0)
 3144         {
 3145             ffpmsg("Error in ffr2e converting float to string");
 3146             *status = BAD_F2C;
 3147         }
 3148     }
 3149 
 3150     if (*status <= 0)
 3151     {
 3152         /* replace comma with a period (e.g. in French locale) */
 3153         if ( (cptr = strchr(cval, ','))) *cptr = '.';
 3154 
 3155         /* test if output string is 'NaN', 'INDEF', or 'INF' */
 3156         if (strchr(cval, 'N'))
 3157         {
 3158             ffpmsg("Error in ffr2e: float value is a NaN or INDEF");
 3159             *status = BAD_F2C;
 3160         }
 3161         else if ( !strchr(cval, '.') && !strchr(cval,'E') && strlen(cval) < FLEN_VALUE-1 )
 3162         {
 3163             /* add decimal point if necessary to distinquish from integer */
 3164             strcat(cval, ".");
 3165         }
 3166     }
 3167 
 3168     return(*status);
 3169 }
 3170 /*--------------------------------------------------------------------------*/
 3171 int ffd2f(double dval,  /* I - value to be converted to a string */
 3172           int decim,    /* I - number of decimal places to display */
 3173           char *cval,   /* O - character string representation of the value */
 3174           int *status)  /* IO - error status */
 3175 /*
 3176   convert double value to a null-terminated F format string
 3177 */
 3178 {
 3179     char *cptr;
 3180 
 3181     if (*status > 0)           /* inherit input status value if > 0 */
 3182         return(*status);
 3183 
 3184     cval[0] = '\0';
 3185 
 3186     if (decim < 0)
 3187     {
 3188         ffpmsg("Error in ffd2f:  no. of decimal places < 0");
 3189         return(*status = BAD_DECIM);
 3190     }
 3191 
 3192     if (snprintf(cval, FLEN_VALUE,"%.*f", decim, dval) < 0)
 3193     {
 3194         ffpmsg("Error in ffd2f converting double to string");
 3195         *status = BAD_F2C;
 3196     }
 3197 
 3198     /* replace comma with a period (e.g. in French locale) */
 3199     if ( (cptr = strchr(cval, ','))) *cptr = '.';
 3200 
 3201     /* test if output string is 'NaN', 'INDEF', or 'INF' */
 3202     if (strchr(cval, 'N'))
 3203     {
 3204         ffpmsg("Error in ffd2f: double value is a NaN or INDEF");
 3205         *status = BAD_F2C;
 3206     }
 3207 
 3208     return(*status);
 3209 }
 3210 /*--------------------------------------------------------------------------*/
 3211 int ffd2e(double dval,  /* I - value to be converted to a string */
 3212           int decim,    /* I - number of decimal places to display */
 3213           char *cval,   /* O - character string representation of the value */
 3214           int *status)  /* IO - error status */
 3215 /*
 3216   convert double value to a null-terminated exponential format string.
 3217 */
 3218 {
 3219     char *cptr;
 3220 
 3221     if (*status > 0)           /* inherit input status value if > 0 */
 3222         return(*status);
 3223 
 3224     cval[0] = '\0';
 3225 
 3226     if (decim < 0)
 3227     {   /* use G format if decim is negative */
 3228         if ( snprintf(cval, FLEN_VALUE,"%.*G", -decim, dval) < 0)
 3229         {
 3230             ffpmsg("Error in ffd2e converting float to string");
 3231             *status = BAD_F2C;
 3232         }
 3233         else
 3234         {
 3235             /* test if E format was used, and there is no displayed decimal */
 3236             if ( !strchr(cval, '.') && strchr(cval,'E') )
 3237             {
 3238                 /* reformat value with a decimal point and single zero */
 3239                 if ( snprintf(cval, FLEN_VALUE,"%.1E", dval) < 0)
 3240                 {
 3241                     ffpmsg("Error in ffd2e converting float to string");
 3242                     *status = BAD_F2C;
 3243                 }
 3244 
 3245                 return(*status);  
 3246             }
 3247         }
 3248     }
 3249     else
 3250     {
 3251         if ( snprintf(cval, FLEN_VALUE,"%.*E", decim, dval) < 0)
 3252         {
 3253             ffpmsg("Error in ffd2e converting float to string");
 3254             *status = BAD_F2C;
 3255         }
 3256     }
 3257 
 3258     if (*status <= 0)
 3259     {
 3260         /* replace comma with a period (e.g. in French locale) */
 3261         if ( (cptr = strchr(cval, ','))) *cptr = '.';
 3262 
 3263         /* test if output string is 'NaN', 'INDEF', or 'INF' */
 3264         if (strchr(cval, 'N'))
 3265         {
 3266             ffpmsg("Error in ffd2e: double value is a NaN or INDEF");
 3267             *status = BAD_F2C;
 3268         }
 3269         else if ( !strchr(cval, '.') && !strchr(cval,'E') && strlen(cval) < FLEN_VALUE-1)
 3270         {
 3271             /* add decimal point if necessary to distinquish from integer */
 3272             strcat(cval, ".");
 3273         }
 3274     }
 3275 
 3276     return(*status);
 3277 }
 3278