"Fossies" - the Fresh Open Source Software Archive

Member "cfitsio-4.0.0/fitscore.c" (20 May 2021, 319841 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 "fitscore.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, fitscore.c, contains the core set of FITSIO routines.       */
    2 
    3 /*  The FITSIO software was written by William Pence at the High Energy    */
    4 /*  Astrophysic Science Archive Research Center (HEASARC) at the NASA      */
    5 /*  Goddard Space Flight Center.                                           */
    6 /*
    7 
    8 Copyright (Unpublished--all rights reserved under the copyright laws of
    9 the United States), U.S. Government as represented by the Administrator
   10 of the National Aeronautics and Space Administration.  No copyright is
   11 claimed in the United States under Title 17, U.S. Code.
   12 
   13 Permission to freely use, copy, modify, and distribute this software
   14 and its documentation without fee is hereby granted, provided that this
   15 copyright notice and disclaimer of warranty appears in all copies.
   16 
   17 DISCLAIMER:
   18 
   19 THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND,
   20 EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED TO,
   21 ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY
   22 IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
   23 PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE
   24 DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT THE
   25 SOFTWARE WILL BE ERROR FREE.  IN NO EVENT SHALL NASA BE LIABLE FOR ANY
   26 DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT, SPECIAL OR
   27 CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM, OR IN ANY WAY
   28 CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED UPON WARRANTY,
   29 CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY WAS SUSTAINED BY
   30 PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR NOT LOSS WAS SUSTAINED
   31 FROM, OR AROSE OUT OF THE RESULTS OF, OR USE OF, THE SOFTWARE OR
   32 SERVICES PROVIDED HEREUNDER."
   33 
   34 */
   35 
   36 
   37 #include <string.h>
   38 #include <limits.h>
   39 #include <stdlib.h>
   40 #include <math.h>
   41 #include <ctype.h>
   42 #include <errno.h>
   43 /* stddef.h is apparently needed to define size_t with some compilers ?? */
   44 #include <stddef.h>
   45 #include <locale.h>
   46 #include "fitsio2.h"
   47 
   48 #define errmsgsiz 25
   49 #define ESMARKER 27  /* Escape character is used as error stack marker */
   50 
   51 #define DelAll     1 /* delete all messages on the error stack */
   52 #define DelMark    2 /* delete newest messages back to and including marker */
   53 #define DelNewest  3 /* delete the newest message from the stack */
   54 #define GetMesg    4 /* pop and return oldest message, ignoring marks */
   55 #define PutMesg    5 /* add a new message to the stack */
   56 #define PutMark    6 /* add a marker to the stack */
   57 
   58 #ifdef _REENTRANT
   59 /*
   60     Fitsio_Lock and Fitsio_Pthread_Status are declared in fitsio2.h. 
   61 */
   62 pthread_mutex_t Fitsio_Lock;
   63 int Fitsio_Pthread_Status = 0;
   64 
   65 #endif
   66 
   67 int STREAM_DRIVER = 0;
   68 struct lconv *lcxxx;
   69 
   70 /*--------------------------------------------------------------------------*/
   71 float ffvers(float *version)  /* IO - version number */
   72 /*
   73   return the current version number of the FITSIO software
   74 */
   75 {
   76       *version = (float) 4.0;
   77 
   78 /*       May 2021
   79 
   80    Previous releases:
   81       *version = 3.49       Aug 2020
   82       *version = 3.48       Apr 2020
   83       *version = 3.47       May 2019
   84       *version = 3.46       Oct 2018
   85       *version = 3.45       May 2018
   86       *version = 3.44       Apr 2018
   87       *version = 3.43       Mar 2018
   88       *version = 3.42       Mar 2017
   89       *version = 3.41       Nov 2016
   90       *version = 3.40       Oct 2016
   91       *version = 3.39       Apr 2016
   92       *version = 3.38       Feb 2016
   93       *version = 3.37     3 Jun 2014
   94       *version = 3.36     6 Dec 2013
   95       *version = 3.35    23 May 2013
   96       *version = 3.34    20 Mar 2013
   97       *version = 3.33    14 Feb 2013
   98       *version = 3.32       Oct 2012
   99       *version = 3.31    18 Jul 2012
  100       *version = 3.30    11 Apr 2012
  101       *version = 3.29    22 Sep 2011
  102       *version = 3.28    12 May 2011
  103       *version = 3.27     3 Mar 2011
  104       *version = 3.26    30 Dec 2010
  105       *version = 3.25    9 June 2010
  106       *version = 3.24    26 Jan 2010
  107       *version = 3.23     7 Jan 2010
  108       *version = 3.22    28 Oct 2009
  109       *version = 3.21    24 Sep 2009
  110       *version = 3.20    31 Aug 2009
  111       *version = 3.18    12 May 2009 (beta version)
  112       *version = 3.14    18 Mar 2009 
  113       *version = 3.13     5 Jan 2009 
  114       *version = 3.12     8 Oct 2008 
  115       *version = 3.11    19 Sep 2008 
  116       *version = 3.10    20 Aug 2008 
  117       *version = 3.09     3 Jun 2008 
  118       *version = 3.08    15 Apr 2007  (internal release)
  119       *version = 3.07     5 Nov 2007  (internal release)
  120       *version = 3.06    27 Aug 2007  
  121       *version = 3.05    12 Jul 2007  (internal release)
  122       *version = 3.03    11 Dec 2006
  123       *version = 3.02    18 Sep 2006
  124       *version = 3.01       May 2006 included in FTOOLS 6.1 release
  125       *version = 3.006   20 Feb 2006 
  126       *version = 3.005   20 Dec 2005 (beta, in heasoft swift release
  127       *version = 3.004   16 Sep 2005 (beta, in heasoft swift release
  128       *version = 3.003   28 Jul 2005 (beta, in heasoft swift release
  129       *version = 3.002   15 Apr 2005 (beta)
  130       *version = 3.001   15 Mar 2005 (beta) released with heasoft 6.0
  131       *version = 3.000   1 Mar 2005 (internal release only)
  132       *version = 2.51     2 Dec 2004
  133       *version = 2.50    28 Jul 2004
  134       *version = 2.49    11 Feb 2004
  135       *version = 2.48    28 Jan 2004
  136       *version = 2.470   18 Aug 2003
  137       *version = 2.460   20 May 2003
  138       *version = 2.450   30 Apr 2003  (internal release only)
  139       *version = 2.440    8 Jan 2003
  140       *version = 2.430;   4 Nov 2002
  141       *version = 2.420;  19 Jul 2002
  142       *version = 2.410;  22 Apr 2002 used in ftools v5.2
  143       *version = 2.401;  28 Jan 2002
  144       *version = 2.400;  18 Jan 2002
  145       *version = 2.301;   7 Dec 2001
  146       *version = 2.300;  23 Oct 2001
  147       *version = 2.204;  26 Jul 2001
  148       *version = 2.203;  19 Jul 2001 used in ftools v5.1
  149       *version = 2.202;  22 May 2001
  150       *version = 2.201;  15 Mar 2001
  151       *version = 2.200;  26 Jan 2001
  152       *version = 2.100;  26 Sep 2000
  153       *version = 2.037;   6 Jul 2000
  154       *version = 2.036;   1 Feb 2000
  155       *version = 2.035;   7 Dec 1999 (internal release only)
  156       *version = 2.034;  23 Nov 1999
  157       *version = 2.033;  17 Sep 1999
  158       *version = 2.032;  25 May 1999
  159       *version = 2.031;  31 Mar 1999
  160       *version = 2.030;  24 Feb 1999
  161       *version = 2.029;  11 Feb 1999
  162       *version = 2.028;  26 Jan 1999
  163       *version = 2.027;  12 Jan 1999
  164       *version = 2.026;  23 Dec 1998
  165       *version = 2.025;   1 Dec 1998
  166       *version = 2.024;   9 Nov 1998
  167       *version = 2.023;   1 Nov 1998 first full release of V2.0
  168       *version = 1.42;   30 Apr 1998
  169       *version = 1.40;    6 Feb 1998
  170       *version = 1.33;   16 Dec 1997 (internal release only)
  171       *version = 1.32;   21 Nov 1997 (internal release only)
  172       *version = 1.31;    4 Nov 1997 (internal release only)
  173       *version = 1.30;   11 Sep 1997
  174       *version = 1.27;    3 Sep 1997 (internal release only)
  175       *version = 1.25;    2 Jul 1997
  176       *version = 1.24;    2 May 1997
  177       *version = 1.23;   24 Apr 1997
  178       *version = 1.22;   18 Apr 1997
  179       *version = 1.21;   26 Mar 1997
  180       *version = 1.2;    29 Jan 1997
  181       *version = 1.11;   04 Dec 1996
  182       *version = 1.101;  13 Nov 1996
  183       *version = 1.1;     6 Nov 1996
  184       *version = 1.04;   17 Sep 1996
  185       *version = 1.03;   20 Aug 1996
  186       *version = 1.02;   15 Aug 1996
  187       *version = 1.01;   12 Aug 1996
  188 */
  189 
  190     return(*version);
  191 }
  192 /*--------------------------------------------------------------------------*/
  193 int ffflnm(fitsfile *fptr,    /* I - FITS file pointer  */
  194            char *filename,    /* O - name of the file   */
  195            int *status)       /* IO - error status      */
  196 /*
  197   return the name of the FITS file
  198 */
  199 {
  200     strcpy(filename,(fptr->Fptr)->filename);
  201     return(*status);
  202 }
  203 /*--------------------------------------------------------------------------*/
  204 int ffflmd(fitsfile *fptr,    /* I - FITS file pointer  */
  205            int *filemode,     /* O - open mode of the file  */
  206            int *status)       /* IO - error status      */
  207 /*
  208   return the access mode of the FITS file
  209 */
  210 {
  211     *filemode = (fptr->Fptr)->writemode;
  212     return(*status);
  213 }
  214 /*--------------------------------------------------------------------------*/
  215 void ffgerr(int status,     /* I - error status value */
  216             char *errtext)  /* O - error message (max 30 char long + null) */
  217 /*
  218   Return a short descriptive error message that corresponds to the input
  219   error status value.  The message may be up to 30 characters long, plus
  220   the terminating null character.
  221 */
  222 {
  223   errtext[0] = '\0';
  224 
  225   if (status >= 0 && status < 300)
  226   {
  227     switch (status) {
  228 
  229     case 0:
  230        strcpy(errtext, "OK - no error");
  231        break;
  232     case 1:
  233        strcpy(errtext, "non-CFITSIO program error");
  234        break;
  235     case 101:
  236        strcpy(errtext, "same input and output files");
  237        break;
  238     case 103:
  239        strcpy(errtext, "attempt to open too many files");
  240        break;
  241     case 104:
  242        strcpy(errtext, "could not open the named file");
  243        break;
  244     case 105:
  245        strcpy(errtext, "couldn't create the named file");
  246        break;
  247     case 106:
  248        strcpy(errtext, "error writing to FITS file");
  249        break;
  250     case 107:
  251        strcpy(errtext, "tried to move past end of file");
  252        break;
  253     case 108:
  254        strcpy(errtext, "error reading from FITS file");
  255        break;
  256     case 110:
  257        strcpy(errtext, "could not close the file");
  258        break;
  259     case 111:
  260        strcpy(errtext, "array dimensions too big");
  261        break;
  262     case 112:
  263        strcpy(errtext, "cannot write to readonly file");
  264        break;
  265     case 113:
  266        strcpy(errtext, "could not allocate memory");
  267        break;
  268     case 114:
  269        strcpy(errtext, "invalid fitsfile pointer");
  270        break;
  271     case 115:
  272        strcpy(errtext, "NULL input pointer");
  273        break;
  274     case 116:
  275        strcpy(errtext, "error seeking file position");
  276        break;
  277     case 117:
  278        strcpy(errtext, "bad value for file download timeout setting");
  279        break;
  280     case 121:
  281        strcpy(errtext, "invalid URL prefix");
  282        break;
  283     case 122:
  284        strcpy(errtext, "too many I/O drivers");
  285        break;
  286     case 123:
  287        strcpy(errtext, "I/O driver init failed");
  288        break;
  289     case 124:
  290        strcpy(errtext, "no I/O driver for this URLtype");
  291        break;
  292     case 125:
  293        strcpy(errtext, "parse error in input file URL");
  294        break;
  295     case 126:
  296        strcpy(errtext, "parse error in range list");
  297        break;
  298     case 151:
  299        strcpy(errtext, "bad argument (shared mem drvr)");
  300        break;
  301     case 152:
  302        strcpy(errtext, "null ptr arg (shared mem drvr)");
  303        break;
  304     case 153:
  305        strcpy(errtext, "no free shared memory handles");
  306        break;
  307     case 154:
  308        strcpy(errtext, "share mem drvr not initialized");
  309        break;
  310     case 155:
  311        strcpy(errtext, "IPC system error (shared mem)");
  312        break;
  313     case 156:
  314        strcpy(errtext, "no memory (shared mem drvr)");
  315        break;
  316     case 157:
  317        strcpy(errtext, "share mem resource deadlock");
  318        break;
  319     case 158:
  320        strcpy(errtext, "lock file open/create failed");
  321        break;
  322     case 159:
  323        strcpy(errtext, "can't resize share mem block");
  324        break;
  325     case 201:
  326        strcpy(errtext, "header already has keywords");
  327        break;
  328     case 202:
  329        strcpy(errtext, "keyword not found in header");
  330        break;
  331     case 203:
  332        strcpy(errtext, "keyword number out of bounds");
  333        break;
  334     case 204:
  335        strcpy(errtext, "keyword value is undefined");
  336        break;
  337     case 205:
  338        strcpy(errtext, "string missing closing quote");
  339        break;
  340     case 206:
  341        strcpy(errtext, "error in indexed keyword name");
  342        break;
  343     case 207:
  344        strcpy(errtext, "illegal character in keyword");
  345        break;
  346     case 208:
  347        strcpy(errtext, "required keywords out of order");
  348        break;
  349     case 209:
  350        strcpy(errtext, "keyword value not positive int");
  351        break;
  352     case 210:
  353        strcpy(errtext, "END keyword not found");
  354        break;
  355     case 211:
  356        strcpy(errtext, "illegal BITPIX keyword value");
  357        break;
  358     case 212:
  359        strcpy(errtext, "illegal NAXIS keyword value");
  360        break;
  361     case 213:
  362        strcpy(errtext, "illegal NAXISn keyword value");
  363        break;
  364     case 214:
  365        strcpy(errtext, "illegal PCOUNT keyword value");
  366        break;
  367     case 215:
  368        strcpy(errtext, "illegal GCOUNT keyword value");
  369        break;
  370     case 216:
  371        strcpy(errtext, "illegal TFIELDS keyword value");
  372        break;
  373     case 217:
  374        strcpy(errtext, "negative table row size");
  375        break;
  376     case 218:
  377        strcpy(errtext, "negative number of rows");
  378        break;
  379     case 219:
  380        strcpy(errtext, "named column not found");
  381        break;
  382     case 220:
  383        strcpy(errtext, "illegal SIMPLE keyword value");
  384        break;
  385     case 221:
  386        strcpy(errtext, "first keyword not SIMPLE");
  387        break;
  388     case 222:
  389        strcpy(errtext, "second keyword not BITPIX");
  390        break;
  391     case 223:
  392        strcpy(errtext, "third keyword not NAXIS");
  393        break;
  394     case 224:
  395        strcpy(errtext, "missing NAXISn keywords");
  396        break;
  397     case 225:
  398        strcpy(errtext, "first keyword not XTENSION");
  399        break;
  400     case 226:
  401        strcpy(errtext, "CHDU not an ASCII table");
  402        break;
  403     case 227:
  404        strcpy(errtext, "CHDU not a binary table");
  405        break;
  406     case 228:
  407        strcpy(errtext, "PCOUNT keyword not found");
  408        break;
  409     case 229:
  410        strcpy(errtext, "GCOUNT keyword not found");
  411        break;
  412     case 230:
  413        strcpy(errtext, "TFIELDS keyword not found");
  414        break;
  415     case 231:
  416        strcpy(errtext, "missing TBCOLn keyword");
  417        break;
  418     case 232:
  419        strcpy(errtext, "missing TFORMn keyword");
  420        break;
  421     case 233:
  422        strcpy(errtext, "CHDU not an IMAGE extension");
  423        break;
  424     case 234:
  425        strcpy(errtext, "illegal TBCOLn keyword value");
  426        break;
  427     case 235:
  428        strcpy(errtext, "CHDU not a table extension");
  429        break;
  430     case 236:
  431        strcpy(errtext, "column exceeds width of table");
  432        break;
  433     case 237:
  434        strcpy(errtext, "more than 1 matching col. name");
  435        break;
  436     case 241:
  437        strcpy(errtext, "row width not = field widths");
  438        break;
  439     case 251:
  440        strcpy(errtext, "unknown FITS extension type");
  441        break;
  442     case 252:
  443        strcpy(errtext, "1st key not SIMPLE or XTENSION");
  444        break;
  445     case 253:
  446        strcpy(errtext, "END keyword is not blank");
  447        break;
  448     case 254:
  449        strcpy(errtext, "Header fill area not blank");
  450        break;
  451     case 255:
  452        strcpy(errtext, "Data fill area invalid");
  453        break;
  454     case 261:
  455        strcpy(errtext, "illegal TFORM format code");
  456        break;
  457     case 262:
  458        strcpy(errtext, "unknown TFORM datatype code");
  459        break;
  460     case 263:
  461        strcpy(errtext, "illegal TDIMn keyword value");
  462        break;
  463     case 264:
  464        strcpy(errtext, "invalid BINTABLE heap pointer");
  465        break;
  466     default:
  467        strcpy(errtext, "unknown error status");
  468        break;
  469     }
  470   }
  471   else if (status < 600)
  472   {
  473     switch(status) {
  474 
  475     case 301:
  476        strcpy(errtext, "illegal HDU number");
  477        break;
  478     case 302:
  479        strcpy(errtext, "column number < 1 or > tfields");
  480        break;
  481     case 304:
  482        strcpy(errtext, "negative byte address");
  483        break;
  484     case 306:
  485        strcpy(errtext, "negative number of elements");
  486        break;
  487     case 307:
  488        strcpy(errtext, "bad first row number");
  489        break;
  490     case 308:
  491        strcpy(errtext, "bad first element number");
  492        break;
  493     case 309:
  494        strcpy(errtext, "not an ASCII (A) column");
  495        break;
  496     case 310:
  497        strcpy(errtext, "not a logical (L) column");
  498        break;
  499     case 311:
  500        strcpy(errtext, "bad ASCII table datatype");
  501        break;
  502     case 312:
  503        strcpy(errtext, "bad binary table datatype");
  504        break;
  505     case 314:
  506        strcpy(errtext, "null value not defined");
  507        break;
  508     case 317:
  509        strcpy(errtext, "not a variable length column");
  510        break;
  511     case 320:
  512        strcpy(errtext, "illegal number of dimensions");
  513        break;
  514     case 321:
  515        strcpy(errtext, "1st pixel no. > last pixel no.");
  516        break;
  517     case 322:
  518        strcpy(errtext, "BSCALE or TSCALn = 0.");
  519        break;
  520     case 323:
  521        strcpy(errtext, "illegal axis length < 1");
  522        break;
  523     case 340:
  524        strcpy(errtext, "not group table");
  525        break;
  526     case 341:
  527        strcpy(errtext, "HDU already member of group");
  528        break;
  529     case 342:
  530        strcpy(errtext, "group member not found");
  531        break;
  532     case 343:
  533        strcpy(errtext, "group not found");
  534        break;
  535     case 344:
  536        strcpy(errtext, "bad group id");
  537        break;
  538     case 345:
  539        strcpy(errtext, "too many HDUs tracked");
  540        break;
  541     case 346:
  542        strcpy(errtext, "HDU alread tracked");
  543        break;
  544     case 347:
  545        strcpy(errtext, "bad Grouping option");
  546        break;
  547     case 348:
  548        strcpy(errtext, "identical pointers (groups)");
  549        break;
  550     case 360:
  551        strcpy(errtext, "malloc failed in parser");
  552        break;
  553     case 361:
  554        strcpy(errtext, "file read error in parser");
  555        break;
  556     case 362:
  557        strcpy(errtext, "null pointer arg (parser)");
  558        break;
  559     case 363:
  560        strcpy(errtext, "empty line (parser)");
  561        break;
  562     case 364:
  563        strcpy(errtext, "cannot unread > 1 line");
  564        break;
  565     case 365:
  566        strcpy(errtext, "parser too deeply nested");
  567        break;
  568     case 366:
  569        strcpy(errtext, "file open failed (parser)");
  570        break;
  571     case 367:
  572        strcpy(errtext, "hit EOF (parser)");
  573        break;
  574     case 368:
  575        strcpy(errtext, "bad argument (parser)");
  576        break;
  577     case 369:
  578        strcpy(errtext, "unexpected token (parser)");
  579        break;
  580     case 401:
  581        strcpy(errtext, "bad int to string conversion");
  582        break;
  583     case 402:
  584        strcpy(errtext, "bad float to string conversion");
  585        break;
  586     case 403:
  587        strcpy(errtext, "keyword value not integer");
  588        break;
  589     case 404:
  590        strcpy(errtext, "keyword value not logical");
  591        break;
  592     case 405:
  593        strcpy(errtext, "keyword value not floating pt");
  594        break;
  595     case 406:
  596        strcpy(errtext, "keyword value not double");
  597        break;
  598     case 407:
  599        strcpy(errtext, "bad string to int conversion");
  600        break;
  601     case 408:
  602        strcpy(errtext, "bad string to float conversion");
  603        break;
  604     case 409:
  605        strcpy(errtext, "bad string to double convert");
  606        break;
  607     case 410:
  608        strcpy(errtext, "illegal datatype code value");
  609        break;
  610     case 411:
  611        strcpy(errtext, "illegal no. of decimals");
  612        break;
  613     case 412:
  614        strcpy(errtext, "datatype conversion overflow");
  615        break;
  616     case 413:
  617        strcpy(errtext, "error compressing image");
  618        break;
  619     case 414:
  620        strcpy(errtext, "error uncompressing image");
  621        break;
  622     case 420:
  623        strcpy(errtext, "bad date or time conversion");
  624        break;
  625     case 431:
  626        strcpy(errtext, "syntax error in expression");
  627        break;
  628     case 432:
  629        strcpy(errtext, "expression result wrong type");
  630        break;
  631     case 433:
  632        strcpy(errtext, "vector result too large");
  633        break;
  634     case 434:
  635        strcpy(errtext, "missing output column");
  636        break;
  637     case 435:
  638        strcpy(errtext, "bad data in parsed column");
  639        break;
  640     case 436:
  641        strcpy(errtext, "output extension of wrong type");
  642        break;
  643     case 501:
  644        strcpy(errtext, "WCS angle too large");
  645        break;
  646     case 502:
  647        strcpy(errtext, "bad WCS coordinate");
  648        break;
  649     case 503:
  650        strcpy(errtext, "error in WCS calculation");
  651        break;
  652     case 504:
  653        strcpy(errtext, "bad WCS projection type");
  654        break;
  655     case 505:
  656        strcpy(errtext, "WCS keywords not found");
  657        break;
  658     default:
  659        strcpy(errtext, "unknown error status");
  660        break;
  661     }
  662   }
  663   else
  664   {
  665      strcpy(errtext, "unknown error status");
  666   }
  667   return;
  668 }
  669 /*--------------------------------------------------------------------------*/
  670 void ffpmsg(const char *err_message)
  671 /*
  672   put message on to error stack
  673 */
  674 {
  675     ffxmsg(PutMesg, (char *)err_message);
  676     return;
  677 }
  678 /*--------------------------------------------------------------------------*/
  679 void ffpmrk(void)
  680 /*
  681   write a marker to the stack.  It is then possible to pop only those
  682   messages following the marker off of the stack, leaving the previous
  683   messages unaffected.
  684 
  685   The marker is ignored by the ffgmsg routine.
  686 */
  687 {
  688     char *dummy = 0;
  689 
  690     ffxmsg(PutMark, dummy);
  691     return;
  692 }
  693 /*--------------------------------------------------------------------------*/
  694 int ffgmsg(char *err_message)
  695 /*
  696   get oldest message from error stack, ignoring markers
  697 */
  698 {
  699     ffxmsg(GetMesg, err_message);
  700     return(*err_message);
  701 }
  702 /*--------------------------------------------------------------------------*/
  703 void ffcmsg(void)
  704 /*
  705   erase all messages in the error stack
  706 */
  707 {
  708     char *dummy = 0;
  709 
  710     ffxmsg(DelAll, dummy);
  711     return;
  712 }
  713 /*--------------------------------------------------------------------------*/
  714 void ffcmrk(void)
  715 /*
  716   erase newest messages in the error stack, stopping if a marker is found.
  717   The marker is also erased in this case.
  718 */
  719 {
  720     char *dummy = 0;
  721 
  722     ffxmsg(DelMark, dummy);
  723     return;
  724 }
  725 /*--------------------------------------------------------------------------*/
  726 void ffxmsg( int action,
  727             char *errmsg)
  728 /*
  729   general routine to get, put, or clear the error message stack.
  730   Use a static array rather than allocating memory as needed for
  731   the error messages because it is likely to be more efficient
  732   and simpler to implement.
  733 
  734   Action Code:
  735 DelAll     1  delete all messages on the error stack 
  736 DelMark    2  delete messages back to and including the 1st marker 
  737 DelNewest  3  delete the newest message from the stack 
  738 GetMesg    4  pop and return oldest message, ignoring marks 
  739 PutMesg    5  add a new message to the stack 
  740 PutMark    6  add a marker to the stack 
  741 
  742 */
  743 {
  744     int ii;
  745     char markflag;
  746     static char *txtbuff[errmsgsiz], *tmpbuff, *msgptr;
  747     static char errbuff[errmsgsiz][81];  /* initialize all = \0 */
  748     static int nummsg = 0;
  749 
  750     FFLOCK;
  751     
  752     if (action == DelAll)  /* clear the whole message stack */
  753     {
  754       for (ii = 0; ii < nummsg; ii ++)
  755         *txtbuff[ii] = '\0';
  756 
  757       nummsg = 0;
  758     }
  759     else if (action == DelMark)  /* clear up to and including first marker */
  760     {
  761       while (nummsg > 0) {
  762         nummsg--;  
  763         markflag = *txtbuff[nummsg]; /* store possible marker character */
  764         *txtbuff[nummsg] = '\0';  /* clear the buffer for this msg */
  765 
  766         if (markflag == ESMARKER)
  767            break;   /* found a marker, so quit */
  768       }
  769     }
  770     else if (action == DelNewest)  /* remove newest message from stack */ 
  771     {
  772       if (nummsg > 0)
  773       {
  774         nummsg--;  
  775         *txtbuff[nummsg] = '\0';  /* clear the buffer for this msg */
  776       }
  777     }
  778     else if (action == GetMesg)  /* pop and return oldest message from stack */ 
  779     {                            /* ignoring markers */
  780       while (nummsg > 0)
  781       {
  782          strcpy(errmsg, txtbuff[0]);   /* copy oldest message to output */
  783 
  784          *txtbuff[0] = '\0';  /* clear the buffer for this msg */
  785            
  786          nummsg--;  
  787          for (ii = 0; ii < nummsg; ii++)
  788              txtbuff[ii] = txtbuff[ii + 1]; /* shift remaining pointers */
  789 
  790          if (errmsg[0] != ESMARKER) {   /* quit if this is not a marker */
  791             FFUNLOCK;
  792             return;
  793          }
  794        }
  795        errmsg[0] = '\0';  /*  no messages in the stack */
  796     }
  797     else if (action == PutMesg)  /* add new message to stack */
  798     {
  799      msgptr = errmsg;
  800      while (strlen(msgptr))
  801      {
  802       if (nummsg == errmsgsiz)
  803       {
  804         tmpbuff = txtbuff[0];  /* buffers full; reuse oldest buffer */
  805         *txtbuff[0] = '\0';  /* clear the buffer for this msg */
  806 
  807         nummsg--;
  808         for (ii = 0; ii < nummsg; ii++)
  809              txtbuff[ii] = txtbuff[ii + 1];   /* shift remaining pointers */
  810 
  811         txtbuff[nummsg] = tmpbuff;  /* set pointer for the new message */
  812       }
  813       else
  814       {
  815         for (ii = 0; ii < errmsgsiz; ii++)
  816         {
  817           if (*errbuff[ii] == '\0') /* find first empty buffer */
  818           {
  819             txtbuff[nummsg] = errbuff[ii];
  820             break;
  821           }
  822         }
  823       }
  824 
  825       strncat(txtbuff[nummsg], msgptr, 80);
  826       nummsg++;
  827 
  828       msgptr += minvalue(80, strlen(msgptr));
  829      }
  830     }
  831     else if (action == PutMark)  /* put a marker on the stack */
  832     {
  833       if (nummsg == errmsgsiz)
  834       {
  835         tmpbuff = txtbuff[0];  /* buffers full; reuse oldest buffer */
  836         *txtbuff[0] = '\0';  /* clear the buffer for this msg */
  837 
  838         nummsg--;
  839         for (ii = 0; ii < nummsg; ii++)
  840              txtbuff[ii] = txtbuff[ii + 1];   /* shift remaining pointers */
  841 
  842         txtbuff[nummsg] = tmpbuff;  /* set pointer for the new message */
  843       }
  844       else
  845       {
  846         for (ii = 0; ii < errmsgsiz; ii++)
  847         {
  848           if (*errbuff[ii] == '\0') /* find first empty buffer */
  849           {
  850             txtbuff[nummsg] = errbuff[ii];
  851             break;
  852           }
  853         }
  854       }
  855 
  856       *txtbuff[nummsg] = ESMARKER;      /* write the marker */
  857       *(txtbuff[nummsg] + 1) = '\0';
  858       nummsg++;
  859 
  860     }
  861 
  862     FFUNLOCK;
  863     return;
  864 }
  865 /*--------------------------------------------------------------------------*/
  866 int ffpxsz(int datatype)
  867 /*
  868    return the number of bytes per pixel associated with the datatype
  869 */
  870 {
  871     if (datatype == TBYTE)
  872        return(sizeof(char));
  873     else if (datatype == TUSHORT)
  874        return(sizeof(short));
  875     else if (datatype == TSHORT)
  876        return(sizeof(short));
  877     else if (datatype == TULONG)
  878        return(sizeof(long));
  879     else if (datatype == TLONG)
  880        return(sizeof(long));
  881     else if (datatype == TINT)
  882        return(sizeof(int));
  883     else if (datatype == TUINT)
  884        return(sizeof(int));
  885     else if (datatype == TFLOAT)
  886        return(sizeof(float));
  887     else if (datatype == TDOUBLE)
  888        return(sizeof(double));
  889     else if (datatype == TLOGICAL)
  890        return(sizeof(char));
  891     else
  892        return(0);
  893 }
  894 /*--------------------------------------------------------------------------*/
  895 int fftkey(const char *keyword,    /* I -  keyword name */
  896            int *status)      /* IO - error status */
  897 /*
  898   Test that the keyword name conforms to the FITS standard.  Must contain
  899   only capital letters, digits, minus or underscore chars.  Trailing spaces
  900   are allowed.  If the input status value is less than zero, then the test
  901   is modified so that upper or lower case letters are allowed, and no 
  902   error messages are printed if the keyword is not legal.
  903 */
  904 {
  905     size_t maxchr, ii;
  906     int spaces=0;
  907     char msg[FLEN_ERRMSG], testchar;
  908 
  909     if (*status > 0)           /* inherit input status value if > 0 */
  910         return(*status);
  911 
  912     maxchr=strlen(keyword);
  913     if (maxchr > 8)
  914         maxchr = 8;
  915 
  916     for (ii = 0; ii < maxchr; ii++)
  917     {
  918         if (*status == 0)
  919             testchar = keyword[ii];
  920         else
  921             testchar = toupper(keyword[ii]);
  922 
  923         if ( (testchar >= 'A' && testchar <= 'Z') ||
  924              (testchar >= '0' && testchar <= '9') ||
  925               testchar == '-' || testchar == '_'   )
  926               {
  927                 if (spaces)
  928                 {
  929                   if (*status == 0)
  930                   {
  931                      /* don't print error message if status < 0  */
  932                     snprintf(msg, FLEN_ERRMSG,
  933                        "Keyword name contains embedded space(s): %.8s",
  934                         keyword);
  935                      ffpmsg(msg);
  936                   }
  937                   return(*status = BAD_KEYCHAR);        
  938                 }
  939               }
  940         else if (keyword[ii] == ' ')
  941             spaces = 1;
  942 
  943         else     
  944         {
  945           if (*status == 0)
  946           {
  947             /* don't print error message if status < 0  */
  948             snprintf(msg, FLEN_ERRMSG,"Character %d in this keyword is illegal: %.8s",
  949                     (int) (ii+1), keyword);
  950             ffpmsg(msg);
  951 
  952             /* explicitly flag the 2 most common cases */
  953             if (keyword[ii] == 0) 
  954                 ffpmsg(" (This a NULL (0) character).");                
  955             else if (keyword[ii] == 9)
  956                 ffpmsg(" (This an ASCII TAB (9) character).");   
  957           }             
  958 
  959           return(*status = BAD_KEYCHAR);        
  960         }                
  961     }
  962     return(*status);        
  963 }
  964 /*--------------------------------------------------------------------------*/
  965 int fftrec(char *card,       /* I -  keyword card to test */
  966            int *status)      /* IO - error status */
  967 /*
  968   Test that the keyword card conforms to the FITS standard.  Must contain
  969   only printable ASCII characters;
  970 */
  971 {
  972     size_t ii, maxchr;
  973     char msg[FLEN_ERRMSG];
  974 
  975     if (*status > 0)           /* inherit input status value if > 0 */
  976         return(*status);
  977 
  978     maxchr = strlen(card);
  979 
  980     for (ii = 8; ii < maxchr; ii++)
  981     {
  982         if (card[ii] < 32 || card[ii] > 126)
  983         {
  984             snprintf(msg, FLEN_ERRMSG, 
  985            "Character %d in this keyword is illegal. Hex Value = %X",
  986               (int) (ii+1), (int) card[ii] );
  987 
  988             if (card[ii] == 0)
  989             strncat(msg, " (NULL char.)",FLEN_ERRMSG-strlen(msg)-1);
  990             else if (card[ii] == 9)
  991             strncat(msg, " (TAB char.)",FLEN_ERRMSG-strlen(msg)-1);
  992             else if (card[ii] == 10)
  993             strncat(msg, " (Line Feed char.)",FLEN_ERRMSG-strlen(msg)-1);
  994             else if (card[ii] == 11)
  995             strncat(msg, " (Vertical Tab)",FLEN_ERRMSG-strlen(msg)-1);
  996             else if (card[ii] == 12)
  997             strncat(msg, " (Form Feed char.)",FLEN_ERRMSG-strlen(msg)-1);
  998             else if (card[ii] == 13)
  999             strncat(msg, " (Carriage Return)",FLEN_ERRMSG-strlen(msg)-1);
 1000             else if (card[ii] == 27)
 1001             strncat(msg, " (Escape char.)",FLEN_ERRMSG-strlen(msg)-1);
 1002             else if (card[ii] == 127)
 1003             strncat(msg, " (Delete char.)",FLEN_ERRMSG-strlen(msg)-1);
 1004 
 1005             ffpmsg(msg);
 1006 
 1007             strncpy(msg, card, 80);
 1008             msg[80] = '\0';
 1009             ffpmsg(msg);
 1010             return(*status = BAD_KEYCHAR);        
 1011         }
 1012     }
 1013     return(*status);        
 1014 }
 1015 /*--------------------------------------------------------------------------*/
 1016 void ffupch(char *string)
 1017 /*
 1018   convert string to upper case, in place.
 1019 */
 1020 {
 1021     size_t len, ii;
 1022 
 1023     len = strlen(string);
 1024     for (ii = 0; ii < len; ii++)
 1025         string[ii] = toupper(string[ii]);
 1026     return;
 1027 }
 1028 /*--------------------------------------------------------------------------*/
 1029 int ffmkky(const char *keyname,   /* I - keyword name    */
 1030             char *value,     /* I - keyword value   */
 1031             const char *comm,      /* I - keyword comment */
 1032             char *card,      /* O - constructed keyword card */
 1033             int  *status)    /* IO - status value   */
 1034 /*
 1035   Make a complete FITS 80-byte keyword card from the input name, value and
 1036   comment strings. Output card is null terminated without any trailing blanks.
 1037 */
 1038 {
 1039     size_t namelen, len, ii;
 1040     char tmpname[FLEN_KEYWORD], tmpname2[FLEN_KEYWORD],*cptr;
 1041     char *saveptr;
 1042     int tstatus = -1, nblank = 0, ntoken = 0, maxlen = 0, specialchar = 0;
 1043 
 1044     if (*status > 0)
 1045         return(*status);
 1046 
 1047     *tmpname = '\0';
 1048     *tmpname2 = '\0';
 1049     *card = '\0';
 1050 
 1051     /* skip leading blanks in the name */
 1052     while(*(keyname + nblank) == ' ')
 1053         nblank++;
 1054 
 1055     strncat(tmpname, keyname + nblank, FLEN_KEYWORD - 1);
 1056 
 1057     len = strlen(value);        
 1058     namelen = strlen(tmpname);
 1059 
 1060     /* delete non-significant trailing blanks in the name */
 1061     if (namelen) {
 1062         cptr = tmpname + namelen - 1;
 1063 
 1064         while(*cptr == ' ') {
 1065             *cptr = '\0';
 1066             cptr--;
 1067         }
 1068 
 1069         namelen = cptr - tmpname + 1;
 1070     }
 1071     
 1072     /* check that the name does not contain an '=' (equals sign) */
 1073     if (strchr(tmpname, '=') ) {
 1074         ffpmsg("Illegal keyword name; contains an equals sign (=)");
 1075         ffpmsg(tmpname);
 1076         return(*status = BAD_KEYCHAR);
 1077     }
 1078 
 1079     if (namelen <= 8 && fftkey(tmpname, &tstatus) <= 0 ) { 
 1080     
 1081         /* a normal 8-char (or less) FITS keyword. */
 1082         strcat(card, tmpname);   /* copy keyword name to buffer */
 1083    
 1084         for (ii = namelen; ii < 8; ii++)
 1085             card[ii] = ' ';      /* pad keyword name with spaces */
 1086 
 1087         card[8]  = '=';          /* append '= ' in columns 9-10 */
 1088         card[9]  = ' ';
 1089         card[10] = '\0';        /* terminate the partial string */
 1090         namelen = 10;
 1091     } else if ((FSTRNCMP(tmpname, "HIERARCH ", 9) == 0) || 
 1092                (FSTRNCMP(tmpname, "hierarch ", 9) == 0) ) {
 1093 
 1094         /* this is an explicit ESO HIERARCH keyword */
 1095 
 1096         strcat(card, tmpname);  /* copy keyword name to buffer */
 1097 
 1098         if (namelen + 3 + len > 80) {
 1099             /* save 1 char by not putting a space before the equals sign */
 1100             strcat(card, "= ");
 1101             namelen += 2;
 1102         } else {
 1103             strcat(card, " = ");
 1104             namelen += 3;
 1105         }
 1106     } else {
 1107 
 1108     /* scan the keyword name to determine the number and max length of the tokens */
 1109     /* and test if any of the tokens contain nonstandard characters */
 1110     
 1111         strncat(tmpname2, tmpname, FLEN_KEYWORD - 1);
 1112         cptr = ffstrtok(tmpname2, " ",&saveptr);
 1113     while (cptr) {
 1114         if (strlen(cptr) > maxlen) maxlen = strlen(cptr); /* find longest token */
 1115 
 1116         /* name contains special characters? */
 1117             tstatus = -1;  /* suppress any error message */
 1118         if (fftkey(cptr, &tstatus) > 0) specialchar = 1; 
 1119         
 1120         cptr = ffstrtok(NULL, " ",&saveptr);
 1121         ntoken++;
 1122     }
 1123 
 1124         tstatus = -1;  /* suppress any error message */
 1125 
 1126 /*      if (ntoken > 1) { */
 1127         if (ntoken > 0) {  /*  temporarily change so that this case should always be true  */
 1128         /* for now at least, treat all cases as an implicit ESO HIERARCH keyword. */
 1129         /* This could  change if FITS is ever expanded to directly support longer keywords. */
 1130         
 1131             if (namelen + 11 > FLEN_CARD-1)
 1132             {
 1133                 ffpmsg(
 1134                "The following keyword is too long to fit on a card:");
 1135                 ffpmsg(keyname);
 1136                 return(*status = BAD_KEYCHAR);
 1137             }
 1138             strcat(card, "HIERARCH ");
 1139             strcat(card, tmpname);
 1140         namelen += 9;
 1141 
 1142             if (namelen + 3 + len > 80) {
 1143                 /* save 1 char by not putting a space before the equals sign */
 1144                 strcat(card, "= ");
 1145                 namelen += 2;
 1146             } else {
 1147                 strcat(card, " = ");
 1148                 namelen += 3;
 1149             }
 1150 
 1151     } else if ((fftkey(tmpname, &tstatus) <= 0)) {
 1152           /* should never get here (at least for now) */
 1153             /* allow keyword names longer than 8 characters */
 1154 
 1155             strncat(card, tmpname, FLEN_KEYWORD - 1);
 1156             strcat(card, "= ");
 1157             namelen += 2;
 1158         } else {
 1159           /* should never get here (at least for now) */
 1160             ffpmsg("Illegal keyword name:");
 1161             ffpmsg(tmpname);
 1162             return(*status = BAD_KEYCHAR);
 1163         }
 1164     }
 1165 
 1166     if (len > 0)  /* now process the value string */
 1167     {
 1168         if (value[0] == '\'')  /* is this a quoted string value? */
 1169         {
 1170             if (namelen > 77)
 1171             {
 1172                 ffpmsg(
 1173                "The following keyword + value is too long to fit on a card:");
 1174                 ffpmsg(keyname);
 1175                 ffpmsg(value);
 1176                 return(*status = BAD_KEYCHAR);
 1177             }
 1178 
 1179             strncat(card, value, 80 - namelen); /* append the value string */
 1180             len = minvalue(80, namelen + len);
 1181 
 1182             /* restore the closing quote if it got truncated */
 1183             if (len == 80)
 1184             {
 1185                    card[79] = '\'';
 1186             }
 1187 
 1188             if (comm)
 1189             {
 1190               if (comm[0] != 0)
 1191               {
 1192                 if (len < 30)
 1193                 {
 1194                   for (ii = len; ii < 30; ii++)
 1195                     card[ii] = ' '; /* fill with spaces to col 30 */
 1196 
 1197                   card[30] = '\0';
 1198                   len = 30;
 1199                 }
 1200               }
 1201             }
 1202         }
 1203         else
 1204         {
 1205             if (namelen + len > 80)
 1206             {
 1207                 ffpmsg(
 1208                "The following keyword + value is too long to fit on a card:");
 1209                 ffpmsg(keyname);
 1210                 ffpmsg(value);
 1211                 return(*status = BAD_KEYCHAR);
 1212             }
 1213             else if (namelen + len < 30)
 1214             {
 1215                 /* add spaces so field ends at least in col 30 */
 1216                 strncat(card, "                    ", 30 - (namelen + len));
 1217             }
 1218 
 1219             strncat(card, value, 80 - namelen); /* append the value string */
 1220             len = minvalue(80, namelen + len);
 1221             len = maxvalue(30, len);
 1222         }
 1223 
 1224         if (comm)
 1225         {
 1226           if ((len < 77) && ( strlen(comm) > 0) )  /* room for a comment? */
 1227           {
 1228             strcat(card, " / ");   /* append comment separator */
 1229             strncat(card, comm, 77 - len); /* append comment (what fits) */
 1230           } 
 1231         }
 1232     }
 1233     else
 1234     {
 1235       if (namelen == 10)  /* This case applies to normal keywords only */
 1236       {
 1237         card[8] = ' '; /* keywords with no value have no '=' */ 
 1238         if (comm)
 1239         {
 1240           strncat(card, comm, 80 - namelen); /* append comment (what fits) */
 1241         }
 1242       }
 1243     }
 1244 
 1245     /* issue a warning if this keyword does not strictly conform to the standard
 1246            HIERARCH convention, which requires,
 1247              1) at least 2 tokens in the name,
 1248          2) no tokens longer than 8 characters, and
 1249          3) no special characters in any of the tokens */
 1250 
 1251             if (ntoken == 1 || specialchar == 1) {
 1252            ffpmsg("Warning: the following keyword does not conform to the HIERARCH convention");
 1253          /*  ffpmsg(" (e.g., name is not hierarchical or contains non-standard characters)."); */
 1254            ffpmsg(card);
 1255         }
 1256 
 1257     return(*status);
 1258 }
 1259 /*--------------------------------------------------------------------------*/
 1260 int ffmkey(fitsfile *fptr,    /* I - FITS file pointer  */
 1261            const char *card,  /* I - card string value  */
 1262            int *status)       /* IO - error status      */
 1263 /*
 1264   replace the previously read card (i.e. starting 80 bytes before the
 1265   (fptr->Fptr)->nextkey position) with the contents of the input card.
 1266 */
 1267 {
 1268     char tcard[81];
 1269     size_t len, ii;
 1270     int keylength = 8;
 1271 
 1272     /* reset position to the correct HDU if necessary */
 1273     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 1274         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 1275 
 1276     strncpy(tcard,card,80);
 1277     tcard[80] = '\0';
 1278 
 1279     len = strlen(tcard);
 1280 
 1281     /* silently replace any illegal characters with a space */
 1282     for (ii=0; ii < len; ii++)  
 1283         if (tcard[ii] < ' ' || tcard[ii] > 126) tcard[ii] = ' ';
 1284 
 1285     for (ii=len; ii < 80; ii++)    /* fill card with spaces if necessary */
 1286         tcard[ii] = ' ';
 1287 
 1288     keylength = strcspn(tcard, "=");
 1289     if (keylength == 80) keylength = 8;
 1290 
 1291     for (ii=0; ii < keylength; ii++)       /* make sure keyword name is uppercase */
 1292         tcard[ii] = toupper(tcard[ii]);
 1293 
 1294     fftkey(tcard, status);        /* test keyword name contains legal chars */
 1295 
 1296 /*  no need to do this any more, since any illegal characters have been removed
 1297     fftrec(tcard, status);   */     /* test rest of keyword for legal chars   */
 1298 
 1299     /* move position of keyword to be over written */
 1300     ffmbyt(fptr, ((fptr->Fptr)->nextkey) - 80, REPORT_EOF, status); 
 1301     ffpbyt(fptr, 80, tcard, status);   /* write the 80 byte card */
 1302 
 1303     return(*status);
 1304 }
 1305 /*--------------------------------------------------------------------------*/
 1306 int ffkeyn(const char *keyroot,   /* I - root string for keyword name */
 1307            int value,       /* I - index number to be appended to root name */
 1308            char *keyname,   /* O - output root + index keyword name */
 1309            int *status)     /* IO - error status  */
 1310 /*
 1311   Construct a keyword name string by appending the index number to the root.
 1312   e.g., if root = "TTYPE" and value = 12 then keyname = "TTYPE12".
 1313 */
 1314 {
 1315     char suffix[16];
 1316     size_t rootlen;
 1317 
 1318     keyname[0] = '\0';            /* initialize output name to null */
 1319     rootlen = strlen(keyroot);
 1320 
 1321     if (rootlen == 0 || value < 0 )
 1322        return(*status = 206);
 1323 
 1324     snprintf(suffix, 16, "%d", value); /* construct keyword suffix */
 1325 
 1326     strcpy(keyname, keyroot);   /* copy root string to name string */
 1327     while (rootlen > 0 && keyname[rootlen - 1] == ' ') {
 1328         rootlen--;                 /* remove trailing spaces in root name */
 1329         keyname[rootlen] = '\0';
 1330     }
 1331     if (strlen(suffix) + strlen(keyname) > 8)
 1332        return (*status=206);
 1333        
 1334     strcat(keyname, suffix);    /* append suffix to the root */
 1335     return(*status);
 1336 }
 1337 /*--------------------------------------------------------------------------*/
 1338 int ffnkey(int value,       /* I - index number to be appended to root name */
 1339            const char *keyroot,   /* I - root string for keyword name */
 1340            char *keyname,   /* O - output root + index keyword name */
 1341            int *status)     /* IO - error status  */
 1342 /*
 1343   Construct a keyword name string by appending the root string to the index
 1344   number. e.g., if root = "TTYPE" and value = 12 then keyname = "12TTYPE".
 1345 */
 1346 {
 1347     size_t rootlen;
 1348 
 1349     keyname[0] = '\0';            /* initialize output name to null */
 1350     rootlen = strlen(keyroot);
 1351 
 1352     if (rootlen == 0 || rootlen > 7 || value < 0 )
 1353        return(*status = 206);
 1354 
 1355     snprintf(keyname, FLEN_VALUE,"%d", value); /* construct keyword prefix */
 1356 
 1357     if (rootlen +  strlen(keyname) > 8)
 1358        return(*status = 206);
 1359 
 1360     strcat(keyname, keyroot);  /* append root to the prefix */
 1361     return(*status);
 1362 }
 1363 /*--------------------------------------------------------------------------*/
 1364 int ffpsvc(char *card,    /* I - FITS header card (nominally 80 bytes long) */
 1365            char *value,   /* O - value string parsed from the card */
 1366            char *comm,    /* O - comment string parsed from the card */
 1367            int *status)   /* IO - error status   */
 1368 /*
 1369   ParSe the Value and Comment strings from the input header card string.
 1370   If the card contains a quoted string value, the returned value string
 1371   includes the enclosing quote characters.  If comm = NULL, don't return
 1372   the comment string.
 1373 */
 1374 {
 1375     int jj;
 1376     size_t ii, cardlen, nblank, valpos;
 1377 
 1378     if (*status > 0)
 1379         return(*status);
 1380 
 1381     value[0] = '\0';
 1382     if (comm)
 1383         comm[0] = '\0';
 1384 
 1385     cardlen = strlen(card);
 1386 
 1387     /* support for ESO HIERARCH keywords; find the '=' */
 1388     if (FSTRNCMP(card, "HIERARCH ", 9) == 0)
 1389     {
 1390       valpos = strcspn(card, "=");
 1391 
 1392       if (valpos == cardlen)   /* no value indicator ??? */
 1393       {
 1394         if (comm != NULL)
 1395         {
 1396           if (cardlen > 8)
 1397           {
 1398             strcpy(comm, &card[8]);
 1399 
 1400             jj=cardlen - 8;
 1401             for (jj--; jj >= 0; jj--)  /* replace trailing blanks with nulls */
 1402             {
 1403                if (comm[jj] == ' ')
 1404                   comm[jj] = '\0';
 1405                else
 1406                   break;
 1407             }
 1408           }
 1409         }
 1410         return(*status);  /* no value indicator */
 1411       }
 1412       valpos++;  /* point to the position after the '=' */
 1413     }
 1414     else if (cardlen < 9  ||
 1415         FSTRNCMP(card, "COMMENT ", 8) == 0 ||  /* keywords with no value */
 1416         FSTRNCMP(card, "HISTORY ", 8) == 0 ||
 1417         FSTRNCMP(card, "END     ", 8) == 0 ||
 1418         FSTRNCMP(card, "CONTINUE", 8) == 0 ||
 1419         FSTRNCMP(card, "        ", 8) == 0 )
 1420     {
 1421         /*  no value, so the comment extends from cols 9 - 80  */
 1422         if (comm != NULL)
 1423         {
 1424           if (cardlen > 8)
 1425           {
 1426              strcpy(comm, &card[8]);
 1427 
 1428              jj=cardlen - 8;
 1429              for (jj--; jj >= 0; jj--)  /* replace trailing blanks with nulls */
 1430              {
 1431                if (comm[jj] == ' ')
 1432                   comm[jj] = '\0';
 1433                else
 1434                   break;
 1435              }
 1436           }
 1437         }
 1438         return(*status);
 1439     }
 1440     else if (FSTRNCMP(&card[8], "= ", 2) == 0  )
 1441     {
 1442         /* normal keyword with '= ' in cols 9-10 */
 1443         valpos = 10;  /* starting position of the value field */
 1444     }
 1445     else
 1446     {
 1447       valpos = strcspn(card, "=");
 1448 
 1449       if (valpos == cardlen)   /* no value indicator ??? */
 1450       {
 1451         if (comm != NULL)
 1452         {
 1453           if (cardlen > 8)
 1454           {
 1455             strcpy(comm, &card[8]);
 1456 
 1457             jj=cardlen - 8;
 1458             for (jj--; jj >= 0; jj--)  /* replace trailing blanks with nulls */
 1459             {
 1460                if (comm[jj] == ' ')
 1461                   comm[jj] = '\0';
 1462                else
 1463                   break;
 1464             }
 1465           }
 1466         }
 1467         return(*status);  /* no value indicator */
 1468       }
 1469       valpos++;  /* point to the position after the '=' */
 1470     }
 1471 
 1472     nblank = strspn(&card[valpos], " "); /* find number of leading blanks */
 1473 
 1474     if (nblank + valpos == cardlen)
 1475     {
 1476       /* the absence of a value string is legal, and simply indicates
 1477          that the keyword value is undefined.  Don't write an error
 1478          message in this case.
 1479       */
 1480         return(*status);
 1481     }
 1482 
 1483     ii = valpos + nblank;
 1484 
 1485     if (card[ii] == '/' )  /* slash indicates start of the comment */
 1486     {
 1487          ii++;
 1488     }
 1489     else if (card[ii] == '\'' )  /* is this a quoted string value? */
 1490     {
 1491         value[0] = card[ii];
 1492         for (jj=1, ii++; ii < cardlen; ii++, jj++)
 1493         {
 1494             if (card[ii] == '\'')  /*  is this the closing quote?  */
 1495             {
 1496                 if (card[ii+1] == '\'')  /* 2 successive quotes? */ 
 1497                 {
 1498                    value[jj] = card[ii];
 1499                    ii++;  
 1500                    jj++;
 1501                 }
 1502                 else
 1503                 {
 1504                     value[jj] = card[ii];
 1505                     break;   /* found the closing quote, so exit this loop  */
 1506                 }
 1507             }
 1508             value[jj] = card[ii];  /* copy the next character to the output */
 1509         }
 1510 
 1511         if (ii == cardlen)
 1512         {
 1513             jj = minvalue(jj, 69);  /* don't exceed 70 char string length */
 1514             value[jj] = '\'';  /*  close the bad value string  */
 1515             value[jj+1] = '\0';  /*  terminate the bad value string  */
 1516             ffpmsg("This keyword string value has no closing quote:");
 1517             ffpmsg(card);
 1518         /*  May 2008 - modified to not fail on this minor error  */
 1519 /*            return(*status = NO_QUOTE);  */
 1520         }
 1521         else
 1522         {
 1523             value[jj+1] = '\0';  /*  terminate the good value string  */
 1524             ii++;   /*  point to the character following the value  */
 1525         }
 1526     }
 1527     else if (card[ii] == '(' )  /* is this a complex value? */
 1528     {
 1529         nblank = strcspn(&card[ii], ")" ); /* find closing ) */
 1530         if (nblank == strlen( &card[ii] ) )
 1531         {
 1532             ffpmsg("This complex keyword value has no closing ')':");
 1533             ffpmsg(card);
 1534             return(*status = NO_QUOTE);
 1535         }
 1536 
 1537         nblank++;
 1538         strncpy(value, &card[ii], nblank);
 1539         value[nblank] = '\0';
 1540         ii = ii + nblank;        
 1541     }
 1542     else   /*  an integer, floating point, or logical FITS value string  */
 1543     {
 1544         nblank = strcspn(&card[ii], " /");  /* find the end of the token */
 1545         strncpy(value, &card[ii], nblank);
 1546         value[nblank] = '\0';
 1547         ii = ii + nblank;
 1548     }
 1549 
 1550     /*  now find the comment string, if any  */
 1551     if (comm)
 1552     {
 1553       nblank = strspn(&card[ii], " ");  /*  find next non-space character  */
 1554       ii = ii + nblank;
 1555 
 1556       if (ii < 80)
 1557       {
 1558         if (card[ii] == '/')   /*  ignore the slash separator  */
 1559         {
 1560             ii++;
 1561             if (card[ii] == ' ')  /*  also ignore the following space  */
 1562                 ii++;
 1563         }
 1564         strcat(comm, &card[ii]);  /*  copy the remaining characters  */
 1565 
 1566         jj=strlen(comm);
 1567         for (jj--; jj >= 0; jj--)  /* replace trailing blanks with nulls */
 1568         {
 1569             if (comm[jj] == ' ')
 1570                 comm[jj] = '\0';
 1571             else
 1572                 break;
 1573         }
 1574       }
 1575     }
 1576     return(*status);
 1577 }
 1578 /*--------------------------------------------------------------------------*/
 1579 int ffgthd(char *tmplt, /* I - input header template string */
 1580            char *card,  /* O - returned FITS header record */
 1581            int *hdtype, /* O - how to interpreter the returned card string */ 
 1582             /*
 1583               -2 = modify the name of a keyword; the old keyword name
 1584                    is returned starting at address chars[0]; the new name
 1585                    is returned starting at address char[40] (to be consistent
 1586                    with the Fortran version).  Both names are null terminated. 
 1587               -1 = card contains the name of a keyword that is to be deleted
 1588                0 = append this keyword if it doesn't already exist, or 
 1589                    modify the value if the keyword already exists.
 1590                1 = append this comment keyword ('HISTORY', 
 1591                    'COMMENT', or blank keyword name) 
 1592                2  =  this is the END keyword; do not write it to the header
 1593             */
 1594            int *status)   /* IO - error status   */
 1595 /*
 1596   'Get Template HeaDer'
 1597   parse a template header line and create a formated
 1598   character string which is suitable for appending to a FITS header 
 1599 */
 1600 {
 1601     char keyname[FLEN_KEYWORD], value[140], comment[140];
 1602     char *tok, *suffix, *loc, tvalue[140];
 1603     int len, vlen, more, tstatus, lentok1=0, remainlen=0;
 1604     double dval;
 1605 
 1606     if (*status > 0)
 1607         return(*status);
 1608 
 1609     card[0]   = '\0';
 1610     *hdtype   = 0;
 1611 
 1612     if (!FSTRNCMP(tmplt, "        ", 8) )
 1613     {
 1614         /* if first 8 chars of template are blank, then this is a comment */
 1615         strncat(card, tmplt, 80);
 1616         *hdtype = 1;
 1617         return(*status);
 1618     }
 1619 
 1620     tok = tmplt;   /* point to start of template string */
 1621  
 1622     keyname[0] = '\0';
 1623     value[0]   = '\0';
 1624     comment[0] = '\0';
 1625 
 1626     len = strspn(tok, " ");  /* no. of spaces before keyword */
 1627     tok += len;
 1628 
 1629     /* test for pecular case where token is a string of dashes */
 1630     if (strncmp(tok, "--------------------", 20) == 0)
 1631             return(*status = BAD_KEYCHAR);
 1632 
 1633     if (tok[0] == '-')  /* is there a leading minus sign? */
 1634     {
 1635         /* first token is name of keyword to be deleted or renamed */
 1636         *hdtype = -1;
 1637         tok++;
 1638         len = strspn(tok, " ");  /* no. of spaces before keyword */
 1639         tok += len;
 1640         
 1641         len = strcspn(tok, " =+");  /* length of name */
 1642         if (len >= FLEN_KEYWORD)
 1643           return(*status = BAD_KEYCHAR);
 1644 
 1645         lentok1 = len;
 1646         strncat(card, tok, len);
 1647 
 1648         /*
 1649           The HIERARCH convention supports non-standard characters
 1650           in the keyword name, so don't always convert to upper case or
 1651           abort if there are illegal characters in the name or if the
 1652           name is greater than 8 characters long.
 1653         */
 1654 
 1655         if (len < 9)  /* this is possibly a normal FITS keyword name */
 1656         {
 1657           ffupch(card);
 1658           tstatus = 0;
 1659           if (fftkey(card, &tstatus) > 0)
 1660           {
 1661              /* name contained non-standard characters, so reset */
 1662              card[0] = '\0';
 1663              strncat(card, tok, len);
 1664           }
 1665         }
 1666 
 1667         tok += len;
 1668 
 1669     /* Check optional "+" indicator to delete multiple keywords */
 1670     if (tok[0] == '+' && len < FLEN_KEYWORD) {
 1671       strcat(card, "+");
 1672       return (*status);
 1673     }
 1674 
 1675         /* second token, if present, is the new name for the keyword */
 1676 
 1677         len = strspn(tok, " ");  /* no. of spaces before next token */
 1678         tok += len;
 1679 
 1680         if (tok[0] == '\0' || tok[0] == '=')
 1681             return(*status);  /* no second token */
 1682 
 1683         *hdtype = -2;
 1684         len = strcspn(tok, " ");  /* length of new name */
 1685         /* this name has to fit on columns 41-80 of card,
 1686            and first name must now fit in 1-40 */
 1687         if (lentok1 > 40)
 1688         {
 1689            card[0] = '\0';
 1690            return (*status = BAD_KEYCHAR);
 1691         }
 1692         if (len > 40)
 1693         {
 1694            card[0] = '\0'; 
 1695            return(*status = BAD_KEYCHAR);
 1696         }
 1697 
 1698         /* copy the new name to card + 40;  This is awkward, */
 1699         /* but is consistent with the way the Fortran FITSIO works */
 1700     strcat(card,"                                        ");
 1701         strncpy(&card[40], tok, len);
 1702         card[80] = '\0'; /* necessary to add terminator in case len = 40 */
 1703 
 1704         /*
 1705             The HIERARCH convention supports non-standard characters
 1706             in the keyword name, so don't always convert to upper case or
 1707             abort if there are illegal characters in the name or if the
 1708             name is greater than 8 characters long.
 1709         */
 1710 
 1711         if (len < 9)  /* this is possibly a normal FITS keyword name */
 1712         {
 1713             ffupch(&card[40]);
 1714             tstatus = 0;
 1715             if (fftkey(&card[40], &tstatus) > 0)
 1716             {
 1717                /* name contained non-standard characters, so reset */
 1718                strncpy(&card[40], tok, len);
 1719             }
 1720         }
 1721     }
 1722     else  /* no negative sign at beginning of template */
 1723     {
 1724       /* get the keyword name token */
 1725 
 1726       len = strcspn(tok, " =");  /* length of keyword name */
 1727       if (len >= FLEN_KEYWORD)
 1728         return(*status = BAD_KEYCHAR);
 1729 
 1730       strncat(keyname, tok, len);
 1731 
 1732       /*
 1733         The HIERARCH convention supports non-standard characters
 1734         in the keyword name, so don't always convert to upper case or
 1735         abort if there are illegal characters in the name or if the
 1736         name is greater than 8 characters long.
 1737       */
 1738 
 1739       if (len < 9)  /* this is possibly a normal FITS keyword name */
 1740       {
 1741         ffupch(keyname);
 1742         tstatus = 0;
 1743         if (fftkey(keyname, &tstatus) > 0)
 1744         {
 1745            /* name contained non-standard characters, so reset */
 1746            keyname[0] = '\0';
 1747            strncat(keyname, tok, len);
 1748         }
 1749       }
 1750 
 1751       if (!FSTRCMP(keyname, "END") )
 1752       {
 1753          strcpy(card, "END");
 1754          *hdtype = 2;
 1755          return(*status);
 1756       }
 1757 
 1758       tok += len; /* move token pointer to end of the keyword */
 1759 
 1760       if (!FSTRCMP(keyname, "COMMENT") || !FSTRCMP(keyname, "HISTORY")
 1761          || !FSTRCMP(keyname, "HIERARCH") )
 1762       {
 1763         *hdtype = 1;   /* simply append COMMENT and HISTORY keywords */
 1764         strcpy(card, keyname);
 1765         strncat(card, tok, 72);
 1766         return(*status);
 1767       }
 1768 
 1769       /* look for the value token */
 1770       len = strspn(tok, " =");  /* spaces or = between name and value */
 1771       tok += len;
 1772 
 1773       if (*tok == '\'') /* is value enclosed in quotes? */
 1774       {
 1775           more = TRUE;
 1776           remainlen = 139;
 1777           while (more)
 1778           {
 1779             tok++;  /* temporarily move past the quote char */
 1780             len = strcspn(tok, "'");  /* length of quoted string */
 1781             tok--;
 1782             if (len+2 > remainlen)
 1783                return (*status=BAD_KEYCHAR);
 1784             strncat(value, tok, len + 2);
 1785             remainlen -= (len+2); 
 1786  
 1787             tok += len + 1;
 1788             if (tok[0] != '\'')   /* check there is a closing quote */
 1789               return(*status = NO_QUOTE);
 1790 
 1791             tok++;
 1792             if (tok[0] != '\'')  /* 2 quote chars = literal quote */
 1793               more = FALSE;
 1794           }
 1795       }
 1796       else if (*tok == '/' || *tok == '\0')  /* There is no value */
 1797       {
 1798           strcat(value, " ");
 1799       }
 1800       else   /* not a quoted string value */
 1801       {
 1802           len = strcspn(tok, " /"); /* length of value string */
 1803           if (len > 139)
 1804              return (*status=BAD_KEYCHAR);
 1805           strncat(value, tok, len);
 1806           if (!( (tok[0] == 'T' || tok[0] == 'F') &&
 1807                  (tok[1] == ' ' || tok[1] == '/' || tok[1] == '\0') )) 
 1808           {
 1809              /* not a logical value */
 1810 
 1811             dval = strtod(value, &suffix); /* try to read value as number */
 1812 
 1813             if (*suffix != '\0' && *suffix != ' ' && *suffix != '/')
 1814             { 
 1815                 /* value not recognized as a number; might be because it */
 1816                 /* contains a 'd' or 'D' exponent character  */ 
 1817                 strcpy(tvalue, value);
 1818                 if ((loc = strchr(tvalue, 'D')))
 1819                 {          
 1820                     *loc = 'E'; /*  replace D's with E's. */ 
 1821                     dval = strtod(tvalue, &suffix); /* read value again */
 1822                 }
 1823                 else if ((loc = strchr(tvalue, 'd')))
 1824                 {
 1825                     *loc = 'E'; /*  replace d's with E's. */ 
 1826                     dval = strtod(tvalue, &suffix); /* read value again */
 1827                 }
 1828                 else if ((loc = strchr(tvalue, '.')))
 1829                 {
 1830                     *loc = ','; /*  replace period with a comma */ 
 1831                     dval = strtod(tvalue, &suffix); /* read value again */
 1832                 }
 1833             }
 1834    
 1835             if (*suffix != '\0' && *suffix != ' ' && *suffix != '/')
 1836             { 
 1837               /* value is not a number; must enclose it in quotes */
 1838               if (len > 137)
 1839                 return (*status=BAD_KEYCHAR);              
 1840               strcpy(value, "'");
 1841               strncat(value, tok, len);
 1842               strcat(value, "'");
 1843 
 1844               /* the following useless statement stops the compiler warning */
 1845               /* that dval is not used anywhere */
 1846               if (dval == 0.)
 1847                  len += (int) dval; 
 1848             }
 1849             else  
 1850             {
 1851                 /* value is a number; convert any 'e' to 'E', or 'd' to 'D' */
 1852                 loc = strchr(value, 'e');
 1853                 if (loc)
 1854                 {          
 1855                     *loc = 'E';  
 1856                 }
 1857                 else
 1858                 {
 1859                     loc = strchr(value, 'd');
 1860                     if (loc)
 1861                     {          
 1862                         *loc = 'D';  
 1863                     }
 1864                 }
 1865             }
 1866           }
 1867           tok += len;
 1868       }
 1869 
 1870       len = strspn(tok, " /"); /* no. of spaces between value and comment */
 1871       tok += len;
 1872 
 1873       vlen = strlen(value);
 1874       if (vlen > 0 && vlen < 10 && value[0] == '\'')
 1875       {
 1876           /* pad quoted string with blanks so it is at least 8 chars long */
 1877           value[vlen-1] = '\0';
 1878           strncat(value, "        ", 10 - vlen);
 1879           strcat(&value[9], "'");
 1880       }
 1881 
 1882       /* get the comment string */
 1883       strncat(comment, tok, 70);
 1884 
 1885       /* construct the complete FITS header card */
 1886       ffmkky(keyname, value, comment, card, status);
 1887     }
 1888     return(*status);
 1889 }
 1890 /*--------------------------------------------------------------------------*/
 1891 int fits_translate_keyword(
 1892       char *inrec,        /* I - input string */
 1893       char *outrec,       /* O - output converted string, or */
 1894                           /*     a null string if input does not  */
 1895                           /*     match any of the patterns */
 1896       char *patterns[][2],/* I - pointer to input / output string */
 1897                           /*     templates */
 1898       int npat,           /* I - number of templates passed */
 1899       int n_value,        /* I - base 'n' template value of interest */
 1900       int n_offset,       /* I - offset to be applied to the 'n' */
 1901                           /*     value in the output string */
 1902       int n_range,        /* I - controls range of 'n' template */
 1903                           /*     values of interest (-1,0, or +1) */
 1904       int *pat_num,       /* O - matched pattern number (0 based) or -1 */
 1905       int *i,             /* O - value of i, if any, else 0 */
 1906       int *j,             /* O - value of j, if any, else 0 */
 1907       int *m,             /* O - value of m, if any, else 0 */
 1908       int *n,             /* O - value of n, if any, else 0 */
 1909 
 1910       int *status)        /* IO - error status */
 1911 
 1912 /* 
 1913 
 1914 Translate a keyword name to a new name, based on a set of patterns.
 1915 The user passes an array of patterns to be matched.  Input pattern
 1916 number i is pattern[i][0], and output pattern number i is
 1917 pattern[i][1].  Keywords are matched against the input patterns.  If a
 1918 match is found then the keyword is re-written according to the output
 1919 pattern.
 1920 
 1921 Order is important.  The first match is accepted.  The fastest match
 1922 will be made when templates with the same first character are grouped
 1923 together.
 1924 
 1925 Several characters have special meanings:
 1926 
 1927      i,j - single digits, preserved in output template
 1928      n - column number of one or more digits, preserved in output template
 1929      m - generic number of one or more digits, preserved in output template
 1930      a - coordinate designator, preserved in output template
 1931      # - number of one or more digits
 1932      ? - any character
 1933      * - only allowed in first character position, to match all
 1934          keywords; only useful as last pattern in the list
 1935 
 1936 i, j, n, and m are returned by the routine.
 1937 
 1938 For example, the input pattern "iCTYPn" will match "1CTYP5" (if n_value
 1939 is 5); the output pattern "CTYPEi" will be re-written as "CTYPE1".
 1940 Notice that "i" is preserved.
 1941 
 1942 The following output patterns are special
 1943 
 1944 Special output pattern characters:
 1945 
 1946     "-" - do not copy a keyword that matches the corresponding input pattern
 1947 
 1948     "+" - copy the input unchanged
 1949 
 1950 The inrec string could be just the 8-char keyword name, or the entire 
 1951 80-char header record.  Characters 9 = 80 in the input string simply get
 1952 appended to the translated keyword name.
 1953 
 1954 If n_range = 0, then only keywords with 'n' equal to n_value will be 
 1955 considered as a pattern match.  If n_range = +1, then all values of 
 1956 'n' greater than or equal to n_value will be a match, and if -1, 
 1957 then values of 'n' less than or equal to n_value will match.
 1958 
 1959   This routine was written by Craig Markwardt, GSFC
 1960 */
 1961 
 1962 {
 1963     int i1 = 0, j1 = 0, n1 = 0, m1 = 0;
 1964     int fac;
 1965     char a = ' ';
 1966     char oldp;
 1967     char c, s;
 1968     int ip, ic, pat, pass = 0, firstfail;
 1969     char *spat;
 1970 
 1971     if (*status > 0)
 1972         return(*status);
 1973     if ((inrec == 0) || (outrec == 0)) 
 1974       return (*status = NULL_INPUT_PTR);
 1975 
 1976     *outrec = '\0';
 1977 /*
 1978     if (*inrec == '\0') return 0;
 1979 */
 1980 
 1981     if (*inrec == '\0')    /* expand to full 8 char blank keyword name */
 1982        strcpy(inrec, "        ");
 1983        
 1984     oldp = '\0';
 1985     firstfail = 0;
 1986 
 1987     /* ===== Pattern match stage */
 1988     for (pat=0; pat < npat; pat++) {
 1989       spat = patterns[pat][0];
 1990       
 1991       i1 = 0; j1 = 0; m1 = -1; n1 = -1; a = ' ';  /* Initialize the place-holders */
 1992       pass = 0;
 1993       
 1994       /* Pass the wildcard pattern */
 1995       if (spat[0] == '*') { 
 1996     pass = 1;
 1997     break;
 1998       }
 1999       
 2000       /* Optimization: if we have seen this initial pattern character before,
 2001      then it must have failed, and we can skip the pattern */
 2002       if (firstfail && spat[0] == oldp) continue;
 2003       oldp = spat[0];
 2004 
 2005       /* 
 2006      ip = index of pattern character being matched
 2007      ic = index of keyname character being matched
 2008      firstfail = 1 if we fail on the first characteor (0=not)
 2009       */
 2010       
 2011       for (ip=0, ic=0, firstfail=1;
 2012        (spat[ip]) && (ic < 8);
 2013        ip++, ic++, firstfail=0) {
 2014     c = inrec[ic];
 2015     s = spat[ip];
 2016 
 2017     if (s == 'i') {
 2018       /* Special pattern: 'i' placeholder */
 2019       if (isdigit(c)) { i1 = c - '0'; pass = 1;}
 2020     } else if (s == 'j') {
 2021       /* Special pattern: 'j' placeholder */
 2022       if (isdigit(c)) { j1 = c - '0'; pass = 1;}
 2023     } else if ((s == 'n')||(s == 'm')||(s == '#')) {
 2024       /* Special patterns: multi-digit number */
 2025       int val = 0;
 2026       pass = 0;
 2027       if (isdigit(c)) {
 2028         pass = 1;  /* NOTE, could fail below */
 2029         
 2030         /* Parse decimal number */
 2031         while (ic<8 && isdigit(c)) { 
 2032           val = val*10 + (c - '0');
 2033           ic++; c = inrec[ic];
 2034         }
 2035         ic--; c = inrec[ic];
 2036         
 2037         if (s == 'n') { 
 2038           
 2039           /* Is it a column number? */
 2040           if ( val >= 1 && val <= 999 &&                    /* Row range check */
 2041            (((n_range == 0) && (val == n_value)) ||     /* Strict equality */
 2042             ((n_range == -1) && (val <= n_value)) ||    /* n <= n_value */
 2043             ((n_range == +1) && (val >= n_value))) ) {  /* n >= n_value */
 2044         n1 = val;
 2045           } else {
 2046         pass = 0;
 2047           }
 2048         } else if (s == 'm') {
 2049           
 2050           /* Generic number */
 2051           m1 = val; 
 2052         }
 2053       }
 2054     } else if (s == 'a') {
 2055       /* Special pattern: coordinate designator */
 2056       if (isupper(c) || c == ' ') { a = c; pass = 1;} 
 2057     } else if (s == '?') {
 2058       /* Match any individual character */
 2059       pass = 1;
 2060     } else if (c == s) {
 2061       /* Match a specific character */
 2062       pass = 1;
 2063     } else {
 2064       /* FAIL */
 2065       pass = 0;
 2066     }
 2067     if (!pass) break;
 2068       }
 2069       
 2070       /* Must pass to the end of the keyword.  No partial matches allowed */
 2071       if (pass && (ic >= 8 || inrec[ic] == ' ')) break;
 2072     }
 2073 
 2074     /* Transfer the pattern-matched numbers to the output parameters */
 2075     if (i) { *i = i1; }
 2076     if (j) { *j = j1; }
 2077     if (n) { *n = n1; }
 2078     if (m) { *m = m1; }
 2079     if (pat_num) { *pat_num = pat; }
 2080 
 2081     /* ===== Keyword rewriting and output stage */
 2082     spat = patterns[pat][1];
 2083 
 2084     /* Return case: explicit deletion, return '-' */
 2085     if (pass && strcmp(spat,"--") == 0) {
 2086       strcpy(outrec, "-");
 2087       strncat(outrec, inrec, 8);
 2088       outrec[9] = 0;
 2089       for(i1=8; i1>1 && outrec[i1] == ' '; i1--) outrec[i1] = 0;
 2090       return 0;
 2091     }
 2092 
 2093     /* Return case: no match, or do-not-transfer pattern */
 2094     if (pass == 0 || spat[0] == '\0' || strcmp(spat,"-") == 0) return 0;
 2095     /* A match: we start by copying the input record to the output */
 2096     strcpy(outrec, inrec);
 2097 
 2098     /* Return case: return the input record unchanged */
 2099     if (spat[0] == '+') return 0;
 2100 
 2101 
 2102     /* Final case: a new output pattern */
 2103     for (ip=0, ic=0; spat[ip]; ip++, ic++) {
 2104       s = spat[ip];
 2105       if (s == 'i') {
 2106     outrec[ic] = (i1+'0');
 2107       } else if (s == 'j') {
 2108     outrec[ic] = (j1+'0');
 2109       } else if (s == 'n') {
 2110     if (n1 == -1) { n1 = n_value; }
 2111     if (n1 > 0) {
 2112       n1 += n_offset;
 2113       for (fac = 1; (n1/fac) > 0; fac *= 10);
 2114       fac /= 10;
 2115       while(fac > 0) {
 2116         outrec[ic] = ((n1/fac) % 10) + '0';
 2117         fac /= 10;
 2118         ic ++;
 2119       }
 2120       ic--;
 2121     }
 2122       } else if (s == 'm' && m1 >= 0) {
 2123     for (fac = 1; (m1/fac) > 0; fac *= 10);
 2124     fac /= 10;
 2125     while(fac > 0) {
 2126       outrec[ic] = ((m1/fac) % 10) + '0';
 2127       fac /= 10;
 2128       ic ++;
 2129     }
 2130     ic --;
 2131       } else if (s == 'a') {
 2132     outrec[ic] = a;
 2133       } else {
 2134     outrec[ic] = s;
 2135       }
 2136     }
 2137 
 2138     /* Pad the keyword name with spaces */
 2139     for ( ; ic<8; ic++) { outrec[ic] = ' '; }
 2140 
 2141     return(*status);
 2142 }
 2143 /*--------------------------------------------------------------------------*/
 2144 int fits_translate_keywords(
 2145        fitsfile *infptr,   /* I - pointer to input HDU */
 2146        fitsfile *outfptr,  /* I - pointer to output HDU */
 2147        int firstkey,       /* I - first HDU record number to start with */
 2148        char *patterns[][2],/* I - pointer to input / output keyword templates */
 2149        int npat,           /* I - number of templates passed */
 2150        int n_value,        /* I - base 'n' template value of interest */
 2151        int n_offset,       /* I - offset to be applied to the 'n' */
 2152                            /*     value in the output string */
 2153        int n_range,        /* I - controls range of 'n' template */
 2154                            /*     values of interest (-1,0, or +1) */
 2155            int *status)        /* IO - error status */
 2156 /*
 2157      Copy relevant keywords from the table header into the newly
 2158      created primary array header.  Convert names of keywords where
 2159      appropriate.  See fits_translate_keyword() for the definitions.
 2160 
 2161      Translation begins at header record number 'firstkey', and
 2162      continues to the end of the header.
 2163 
 2164   This routine was written by Craig Markwardt, GSFC
 2165 */
 2166 {
 2167     int nrec, nkeys, nmore;
 2168     char rec[FLEN_CARD];
 2169     int i = 0, j = 0, n = 0, m = 0;
 2170     int pat_num = 0, maxchr, ii;
 2171     char outrec[FLEN_CARD];
 2172 
 2173     if (*status > 0)
 2174         return(*status);
 2175 
 2176     ffghsp(infptr, &nkeys, &nmore, status);  /* get number of keywords */
 2177 
 2178     for (nrec = firstkey; (*status == 0) && (nrec <= nkeys); nrec++) {
 2179       outrec[0] = '\0';
 2180 
 2181       ffgrec(infptr, nrec, rec, status);
 2182 
 2183       /* silently overlook any illegal ASCII characters in the value or */
 2184       /* comment fields of the record. It is usually not appropriate to */
 2185       /* abort the process because of this minor transgression of the FITS rules. */
 2186       /* Set the offending character to a blank */
 2187 
 2188       maxchr = strlen(rec);
 2189       for (ii = 8; ii < maxchr; ii++)
 2190       {
 2191         if (rec[ii] < 32 || rec[ii] > 126)
 2192           rec[ii] = ' ';
 2193       }
 2194       
 2195       fits_translate_keyword(rec, outrec, patterns, npat, 
 2196                  n_value, n_offset, n_range, 
 2197                  &pat_num, &i, &j, &m, &n, status);
 2198       
 2199       if (*status == 0) {
 2200     if (outrec[0] == '-') { /* prefix -KEYNAME means delete */
 2201       int i1;
 2202 
 2203       /* Preserve only the keyword portion of name */
 2204       outrec[9] = 0;
 2205       for(i1=8; i1>1 && outrec[i1] == ' '; i1--) outrec[i1] = 0;
 2206 
 2207       ffpmrk();
 2208       ffdkey(outfptr, outrec+1, status); /* delete the keyword */
 2209       if (*status == 0) {
 2210         int nkeys1;
 2211         /* get number of keywords again in case of change*/
 2212         ffghsp(infptr, &nkeys1, &nmore, status);  
 2213         if (nkeys1 != nkeys) {
 2214           nrec --;
 2215           nkeys = nkeys1;
 2216         }
 2217       }
 2218       *status = 0;
 2219       ffcmrk();
 2220 
 2221     } else if (outrec[0]) {
 2222       ffprec(outfptr, outrec, status); /* copy the keyword */
 2223     }     
 2224       }
 2225       rec[8] = 0; outrec[8] = 0;
 2226 
 2227     }   
 2228 
 2229     return(*status);
 2230 }
 2231 /*--------------------------------------------------------------------------*/
 2232 int fits_copy_pixlist2image(
 2233        fitsfile *infptr,   /* I - pointer to input HDU */
 2234        fitsfile *outfptr,  /* I - pointer to output HDU */
 2235        int firstkey,       /* I - first HDU record number to start with */
 2236            int naxis,          /* I - number of axes in the image */
 2237            int *colnum,       /* I - numbers of the columns to be binned  */
 2238            int *status)        /* IO - error status */
 2239 /*
 2240      Copy relevant keywords from the pixel list table header into a newly
 2241      created primary array header.  Convert names of keywords where
 2242      appropriate.  See fits_translate_pixkeyword() for the definitions.
 2243 
 2244      Translation begins at header record number 'firstkey', and
 2245      continues to the end of the header.
 2246 */
 2247 {
 2248     int nrec, nkeys, nmore;
 2249     char rec[FLEN_CARD], outrec[FLEN_CARD];
 2250     int pat_num = 0, npat;
 2251     int iret, jret, nret, mret, lret;
 2252     char *patterns[][2] = {
 2253 
 2254                {"TCTYPn",  "CTYPEn"    },
 2255                {"TCTYna",  "CTYPEna"   },
 2256                {"TCUNIn",  "CUNITn"    },
 2257                {"TCUNna",  "CUNITna"   },
 2258                {"TCRVLn",  "CRVALn"    },
 2259                {"TCRVna",  "CRVALna"   },
 2260                {"TCDLTn",  "CDELTn"    },
 2261                {"TCDEna",  "CDELTna"   },
 2262                {"TCRPXn",  "CRPIXn"    },
 2263                {"TCRPna",  "CRPIXna"   },
 2264                {"TCROTn",  "CROTAn"    },
 2265                {"TPn_ma",  "PCn_ma"    },
 2266                {"TPCn_m",  "PCn_ma"    },
 2267                {"TCn_ma",  "CDn_ma"    },
 2268                {"TCDn_m",  "CDn_ma"    },
 2269                {"TVn_la",  "PVn_la"    },
 2270                {"TPVn_l",  "PVn_la"    },
 2271                {"TSn_la",  "PSn_la"    },
 2272                {"TPSn_l",  "PSn_la"    },
 2273                {"TWCSna",  "WCSNAMEa"  },
 2274                {"TCNAna",  "CNAMEna"   },
 2275                {"TCRDna",  "CRDERna"   },
 2276                {"TCSYna",  "CSYERna"   },
 2277                {"LONPna",  "LONPOLEa"  },
 2278                {"LATPna",  "LATPOLEa"  },
 2279                {"EQUIna",  "EQUINOXa"  },
 2280                {"MJDOBn",  "MJD-OBS"   },
 2281                {"MJDAn",   "MJD-AVG"   },
 2282                {"DAVGn",   "DATE-AVG"  },
 2283                {"RADEna",  "RADESYSa"  },
 2284                {"RFRQna",  "RESTFRQa"  },
 2285                {"RWAVna",  "RESTWAVa"  },
 2286                {"SPECna",  "SPECSYSa"  },
 2287                {"SOBSna",  "SSYSOBSa"  },
 2288                {"SSRCna",  "SSYSSRCa"  },
 2289 
 2290                            /* preserve common keywords */
 2291                {"LONPOLEa",   "+"       },
 2292                {"LATPOLEa",   "+"       },
 2293                {"EQUINOXa",   "+"       },
 2294                {"EPOCH",      "+"       },
 2295                {"MJD-????",   "+"       },
 2296                {"DATE????",   "+"       },
 2297                {"TIME????",   "+"       },
 2298                {"RADESYSa",   "+"       },
 2299                {"RADECSYS",   "+"       },
 2300                {"TELESCOP",   "+"       },
 2301                {"INSTRUME",   "+"       },
 2302                {"OBSERVER",   "+"       },
 2303                {"OBJECT",     "+"       },
 2304 
 2305                            /* Delete general table column keywords */
 2306                {"XTENSION", "-"       },
 2307                {"BITPIX",   "-"       },
 2308                {"NAXIS",    "-"       },
 2309                {"NAXISi",   "-"       },
 2310                {"PCOUNT",   "-"       },
 2311                {"GCOUNT",   "-"       },
 2312                {"TFIELDS",  "-"       },
 2313 
 2314                {"TDIM#",   "-"       },
 2315                {"THEAP",   "-"       },
 2316                {"EXTNAME", "-"       }, 
 2317                {"EXTVER",  "-"       },
 2318                {"EXTLEVEL","-"       },
 2319                {"CHECKSUM","-"       },
 2320                {"DATASUM", "-"       },
 2321                {"NAXLEN",  "-"       },
 2322                {"AXLEN#",  "-"       },
 2323                {"CPREF",  "-"       },
 2324                
 2325                            /* Delete table keywords related to other columns */
 2326                {"T????#a", "-"       }, 
 2327                {"TC??#a",  "-"       },
 2328                {"T??#_#",  "-"       },
 2329                {"TWCS#a",  "-"       },
 2330 
 2331                {"LONP#a",  "-"       },
 2332                {"LATP#a",  "-"       },
 2333                {"EQUI#a",  "-"       },
 2334                {"MJDOB#",  "-"       },
 2335                {"MJDA#",   "-"       },
 2336                {"RADE#a",  "-"       },
 2337                {"DAVG#",   "-"       },
 2338 
 2339                {"iCTYP#",  "-"       },
 2340                {"iCTY#a",  "-"       },
 2341                {"iCUNI#",  "-"       },
 2342                {"iCUN#a",  "-"       },
 2343                {"iCRVL#",  "-"       },
 2344                {"iCDLT#",  "-"       },
 2345                {"iCRPX#",  "-"       },
 2346                {"iCTY#a",  "-"       },
 2347                {"iCUN#a",  "-"       },
 2348                {"iCRV#a",  "-"       },
 2349                {"iCDE#a",  "-"       },
 2350                {"iCRP#a",  "-"       },
 2351                {"ijPC#a",  "-"       },
 2352                {"ijCD#a",  "-"       },
 2353                {"iV#_#a",  "-"       },
 2354                {"iS#_#a",  "-"       },
 2355                {"iCRD#a",  "-"       },
 2356                {"iCSY#a",  "-"       },
 2357                {"iCROT#",  "-"       },
 2358                {"WCAX#a",  "-"       },
 2359                {"WCSN#a",  "-"       },
 2360                {"iCNA#a",  "-"       },
 2361 
 2362                {"*",       "+"       }}; /* copy all other keywords */
 2363 
 2364     if (*status > 0)
 2365         return(*status);
 2366 
 2367     npat = sizeof(patterns)/sizeof(patterns[0][0])/2;
 2368 
 2369     ffghsp(infptr, &nkeys, &nmore, status);  /* get number of keywords */
 2370 
 2371     for (nrec = firstkey; nrec <= nkeys; nrec++) {
 2372       outrec[0] = '\0';
 2373 
 2374       ffgrec(infptr, nrec, rec, status);
 2375 
 2376       fits_translate_pixkeyword(rec, outrec, patterns, npat, 
 2377                  naxis, colnum, 
 2378                  &pat_num, &iret, &jret, &nret, &mret, &lret, status);
 2379 
 2380       if (outrec[0]) {
 2381     ffprec(outfptr, outrec, status); /* copy the keyword */
 2382       } 
 2383 
 2384       rec[8] = 0; outrec[8] = 0;
 2385     }   
 2386 
 2387     return(*status);
 2388 }
 2389 /*--------------------------------------------------------------------------*/
 2390 int fits_translate_pixkeyword(
 2391       char *inrec,        /* I - input string */
 2392       char *outrec,       /* O - output converted string, or */
 2393                           /*     a null string if input does not  */
 2394                           /*     match any of the patterns */
 2395       char *patterns[][2],/* I - pointer to input / output string */
 2396                           /*     templates */
 2397       int npat,           /* I - number of templates passed */
 2398       int naxis,          /* I - number of columns to be binned */
 2399       int *colnum,       /* I - numbers of the columns to be binned */
 2400       int *pat_num,       /* O - matched pattern number (0 based) or -1 */
 2401       int *i,
 2402       int *j,
 2403       int *n,
 2404       int *m,
 2405       int *l,
 2406       int *status)        /* IO - error status */
 2407       
 2408 /* 
 2409 
 2410 Translate a keyword name to a new name, based on a set of patterns.
 2411 The user passes an array of patterns to be matched.  Input pattern
 2412 number i is pattern[i][0], and output pattern number i is
 2413 pattern[i][1].  Keywords are matched against the input patterns.  If a
 2414 match is found then the keyword is re-written according to the output
 2415 pattern.
 2416 
 2417 Order is important.  The first match is accepted.  The fastest match
 2418 will be made when templates with the same first character are grouped
 2419 together.
 2420 
 2421 Several characters have special meanings:
 2422 
 2423      i,j - single digits, preserved in output template
 2424      n, m - column number of one or more digits, preserved in output template
 2425      k - generic number of one or more digits, preserved in output template
 2426      a - coordinate designator, preserved in output template
 2427      # - number of one or more digits
 2428      ? - any character
 2429      * - only allowed in first character position, to match all
 2430          keywords; only useful as last pattern in the list
 2431 
 2432 i, j, n, and m are returned by the routine.
 2433 
 2434 For example, the input pattern "iCTYPn" will match "1CTYP5" (if n_value
 2435 is 5); the output pattern "CTYPEi" will be re-written as "CTYPE1".
 2436 Notice that "i" is preserved.
 2437 
 2438 The following output patterns are special
 2439 
 2440 Special output pattern characters:
 2441 
 2442     "-" - do not copy a keyword that matches the corresponding input pattern
 2443 
 2444     "+" - copy the input unchanged
 2445 
 2446 The inrec string could be just the 8-char keyword name, or the entire 
 2447 80-char header record.  Characters 9 = 80 in the input string simply get
 2448 appended to the translated keyword name.
 2449 
 2450 If n_range = 0, then only keywords with 'n' equal to n_value will be 
 2451 considered as a pattern match.  If n_range = +1, then all values of 
 2452 'n' greater than or equal to n_value will be a match, and if -1, 
 2453 then values of 'n' less than or equal to n_value will match.
 2454 
 2455 */
 2456 
 2457 {
 2458     int i1 = 0, j1 = 0, val;
 2459     int fac, nval = 0, mval = 0, lval = 0;
 2460     char a = ' ';
 2461     char oldp;
 2462     char c, s;
 2463     int ip, ic, pat, pass = 0, firstfail;
 2464     char *spat;
 2465 
 2466     if (*status > 0)
 2467         return(*status);
 2468 
 2469     if ((inrec == 0) || (outrec == 0)) 
 2470       return (*status = NULL_INPUT_PTR);
 2471 
 2472     *outrec = '\0';
 2473     if (*inrec == '\0') return 0;
 2474 
 2475     oldp = '\0';
 2476     firstfail = 0;
 2477 
 2478     /* ===== Pattern match stage */
 2479     for (pat=0; pat < npat; pat++) {
 2480 
 2481       spat = patterns[pat][0];
 2482       
 2483       i1 = 0; j1 = 0;   a = ' ';  /* Initialize the place-holders */
 2484       pass = 0;
 2485       
 2486       /* Pass the wildcard pattern */
 2487       if (spat[0] == '*') { 
 2488     pass = 1;
 2489     break;
 2490       }
 2491       
 2492       /* Optimization: if we have seen this initial pattern character before,
 2493      then it must have failed, and we can skip the pattern */
 2494       if (firstfail && spat[0] == oldp) continue;
 2495       oldp = spat[0];
 2496 
 2497       /* 
 2498      ip = index of pattern character being matched
 2499      ic = index of keyname character being matched
 2500      firstfail = 1 if we fail on the first characteor (0=not)
 2501       */
 2502       
 2503       for (ip=0, ic=0, firstfail=1;
 2504        (spat[ip]) && (ic < 8);
 2505        ip++, ic++, firstfail=0) {
 2506     c = inrec[ic];
 2507     s = spat[ip];
 2508 
 2509     if (s == 'i') {
 2510       /* Special pattern: 'i' placeholder */
 2511       if (isdigit(c)) { i1 = c - '0'; pass = 1;}
 2512     } else if (s == 'j') {
 2513       /* Special pattern: 'j' placeholder */
 2514       if (isdigit(c)) { j1 = c - '0'; pass = 1;}
 2515     } else if ((s == 'n')||(s == 'm')||(s == 'l')||(s == '#')) {
 2516       /* Special patterns: multi-digit number */
 2517           val = 0;
 2518       pass = 0;
 2519       if (isdigit(c)) {
 2520         pass = 1;  /* NOTE, could fail below */
 2521         
 2522         /* Parse decimal number */
 2523         while (ic<8 && isdigit(c)) { 
 2524           val = val*10 + (c - '0');
 2525           ic++; c = inrec[ic];
 2526         }
 2527         ic--; c = inrec[ic];
 2528 
 2529         if (s == 'n' || s == 'm') { 
 2530           
 2531           /* Is it a column number? */
 2532           if ( val >= 1 && val <= 999) {
 2533              
 2534          if (val == colnum[0])
 2535              val = 1; 
 2536          else if (val == colnum[1]) 
 2537              val = 2; 
 2538          else if (val == colnum[2]) 
 2539              val = 3; 
 2540          else if (val == colnum[3]) 
 2541              val = 4; 
 2542          else {
 2543              pass = 0;
 2544              val = 0; 
 2545          }
 2546 
 2547              if (s == 'n')
 2548             nval = val;
 2549          else
 2550             mval = val;
 2551  
 2552               } else {
 2553           pass = 0;
 2554               }
 2555         } else if (s == 'l') {
 2556           /* Generic number */
 2557           lval = val; 
 2558         }
 2559       }
 2560     } else if (s == 'a') {
 2561       /* Special pattern: coordinate designator */
 2562       if (isupper(c) || c == ' ') { a = c; pass = 1;} 
 2563     } else if (s == '?') {
 2564       /* Match any individual character */
 2565       pass = 1;
 2566     } else if (c == s) {
 2567       /* Match a specific character */
 2568       pass = 1;
 2569     } else {
 2570       /* FAIL */
 2571       pass = 0;
 2572     }
 2573     
 2574     if (!pass) break;
 2575       }
 2576       
 2577 
 2578       /* Must pass to the end of the keyword.  No partial matches allowed */
 2579       if (pass && (ic >= 8 || inrec[ic] == ' ')) break;
 2580     }
 2581 
 2582 
 2583     /* Transfer the pattern-matched numbers to the output parameters */
 2584     if (i) { *i = i1; }
 2585     if (j) { *j = j1; }
 2586     if (n) { *n = nval; }
 2587     if (m) { *m = mval; }
 2588     if (l) { *l = lval; }
 2589     if (pat_num) { *pat_num = pat; }
 2590 
 2591     /* ===== Keyword rewriting and output stage */
 2592     spat = patterns[pat][1];
 2593 
 2594     /* Return case: no match, or explicit deletion pattern */
 2595     if (pass == 0 || spat[0] == '\0' || spat[0] == '-') return 0;
 2596 
 2597     /* A match: we start by copying the input record to the output */
 2598     strcpy(outrec, inrec);
 2599 
 2600     /* Return case: return the input record unchanged */
 2601     if (spat[0] == '+') return 0;
 2602 
 2603     /* Final case: a new output pattern */
 2604     for (ip=0, ic=0; spat[ip]; ip++, ic++) {
 2605       s = spat[ip];
 2606       if (s == 'i') {
 2607     outrec[ic] = (i1+'0');
 2608       } else if (s == 'j') {
 2609     outrec[ic] = (j1+'0');
 2610       } else if (s == 'n' && nval > 0) {
 2611       for (fac = 1; (nval/fac) > 0; fac *= 10);
 2612       fac /= 10;
 2613       while(fac > 0) {
 2614         outrec[ic] = ((nval/fac) % 10) + '0';
 2615         fac /= 10;
 2616         ic ++;
 2617       }
 2618       ic--;
 2619       } else if (s == 'm' && mval > 0) {
 2620       for (fac = 1; (mval/fac) > 0; fac *= 10);
 2621       fac /= 10;
 2622       while(fac > 0) {
 2623         outrec[ic] = ((mval/fac) % 10) + '0';
 2624         fac /= 10;
 2625         ic ++;
 2626       }
 2627       ic--;
 2628       } else if (s == 'l' && lval >= 0) {
 2629     for (fac = 1; (lval/fac) > 0; fac *= 10);
 2630     fac /= 10;
 2631     while(fac > 0) {
 2632       outrec[ic] = ((lval/fac) % 10) + '0';
 2633       fac /= 10;
 2634       ic ++;
 2635     }
 2636     ic --;
 2637       } else if (s == 'a') {
 2638     outrec[ic] = a;
 2639       } else {
 2640     outrec[ic] = s;
 2641       }
 2642     }
 2643 
 2644     /* Pad the keyword name with spaces */
 2645     for ( ; ic<8; ic++) { outrec[ic] = ' '; }
 2646 
 2647     return(*status);
 2648 }
 2649 /*--------------------------------------------------------------------------*/
 2650 int ffasfm(char *tform,    /* I - format code from the TFORMn keyword */
 2651            int *dtcode,    /* O - numerical datatype code */
 2652            long *twidth,   /* O - width of the field, in chars */
 2653            int *decimals,  /* O - number of decimal places (F, E, D format) */
 2654            int *status)    /* IO - error status      */
 2655 {
 2656 /*
 2657   parse the ASCII table TFORM column format to determine the data
 2658   type, the field width, and number of decimal places (if relevant)
 2659 */
 2660     int ii, datacode;
 2661     long longval, width;
 2662     float fwidth;
 2663     char *form, temp[FLEN_VALUE], message[FLEN_ERRMSG];
 2664 
 2665     if (*status > 0)
 2666         return(*status);
 2667 
 2668     if (dtcode)
 2669         *dtcode = 0;
 2670 
 2671     if (twidth)
 2672         *twidth = 0;
 2673 
 2674     if (decimals)
 2675         *decimals = 0;
 2676 
 2677     ii = 0;
 2678     while (tform[ii] != 0 && tform[ii] == ' ') /* find first non-blank char */
 2679          ii++;
 2680 
 2681     if (strlen(&tform[ii]) > FLEN_VALUE-1)
 2682     {
 2683        ffpmsg("Error: ASCII table TFORM code is too long (ffasfm)");
 2684        return(*status = BAD_TFORM);
 2685     }
 2686     strcpy(temp, &tform[ii]); /* copy format string */
 2687     ffupch(temp);     /* make sure it is in upper case */
 2688     form = temp;      /* point to start of format string */
 2689 
 2690 
 2691     if (form[0] == 0)
 2692     {
 2693         ffpmsg("Error: ASCII table TFORM code is blank");
 2694         return(*status = BAD_TFORM);
 2695     }
 2696 
 2697     /*-----------------------------------------------*/
 2698     /*       determine default datatype code         */
 2699     /*-----------------------------------------------*/
 2700     if (form[0] == 'A')
 2701         datacode = TSTRING;
 2702     else if (form[0] == 'I')
 2703         datacode = TLONG;
 2704     else if (form[0] == 'F')
 2705         datacode = TFLOAT;
 2706     else if (form[0] == 'E')
 2707         datacode = TFLOAT;
 2708     else if (form[0] == 'D')
 2709         datacode = TDOUBLE;
 2710     else
 2711     {
 2712         snprintf(message, FLEN_ERRMSG,
 2713                 "Illegal ASCII table TFORMn datatype: \'%s\'", tform);
 2714         ffpmsg(message);
 2715         return(*status = BAD_TFORM_DTYPE);
 2716     }
 2717 
 2718     if (dtcode)
 2719        *dtcode = datacode;
 2720 
 2721     form++;  /* point to the start of field width */
 2722 
 2723     if (datacode == TSTRING || datacode == TLONG)
 2724     { 
 2725         /*-----------------------------------------------*/
 2726         /*              A or I data formats:             */
 2727         /*-----------------------------------------------*/
 2728 
 2729         if (ffc2ii(form, &width, status) <= 0)  /* read the width field */
 2730         {
 2731             if (width <= 0)
 2732             {
 2733                 width = 0;
 2734                 *status = BAD_TFORM;
 2735             }
 2736             else
 2737             {                
 2738                 /* set to shorter precision if I4 or less */
 2739                 if (width <= 4 && datacode == TLONG)
 2740                     datacode = TSHORT;
 2741             }
 2742         }
 2743     }
 2744     else
 2745     {  
 2746         /*-----------------------------------------------*/
 2747         /*              F, E or D data formats:          */
 2748         /*-----------------------------------------------*/
 2749 
 2750         if (ffc2rr(form, &fwidth, status) <= 0) /* read ww.dd width field */
 2751         {
 2752            if (fwidth <= 0.)
 2753             *status = BAD_TFORM;
 2754           else
 2755           {
 2756             width = (long) fwidth;  /* convert from float to long */
 2757 
 2758             if (width > 7 && *temp == 'F')
 2759                 datacode = TDOUBLE;  /* type double if >7 digits */
 2760 
 2761             if (width < 10)
 2762                 form = form + 1; /* skip 1 digit  */
 2763             else
 2764                 form = form + 2; /* skip 2 digits */
 2765 
 2766             if (form[0] == '.') /* should be a decimal point here */
 2767             {
 2768                 form++;  /*  point to start of decimals field */
 2769 
 2770                 if (ffc2ii(form, &longval, status) <= 0) /* read decimals */
 2771                 {
 2772                     if (decimals)
 2773                         *decimals = longval;  /* long to short convertion */
 2774 
 2775                     if (longval >= width)  /* width < no. of decimals */
 2776                         *status = BAD_TFORM; 
 2777 
 2778                     if (longval > 6 && *temp == 'E')
 2779                         datacode = TDOUBLE;  /* type double if >6 digits */
 2780                 }
 2781             }
 2782 
 2783           }
 2784         }
 2785     }
 2786     if (*status > 0)
 2787     {
 2788         *status = BAD_TFORM;
 2789         snprintf(message,FLEN_ERRMSG,"Illegal ASCII table TFORMn code: \'%s\'", tform);
 2790         ffpmsg(message);
 2791     }
 2792 
 2793     if (dtcode)
 2794        *dtcode = datacode;
 2795 
 2796     if (twidth)
 2797        *twidth = width;
 2798 
 2799     return(*status);
 2800 }
 2801 /*--------------------------------------------------------------------------*/
 2802 int ffbnfm(char *tform,     /* I - format code from the TFORMn keyword */
 2803            int *dtcode,   /* O - numerical datatype code */
 2804            long *trepeat,    /* O - repeat count of the field  */
 2805            long *twidth,     /* O - width of the field, in chars */
 2806            int *status)     /* IO - error status      */
 2807 {
 2808 /*
 2809   parse the binary table TFORM column format to determine the data
 2810   type, repeat count, and the field width (if it is an ASCII (A) field)
 2811 */
 2812     size_t ii, nchar;
 2813     int datacode, variable, iread;
 2814     long width, repeat;
 2815     char *form, temp[FLEN_VALUE], message[FLEN_ERRMSG];
 2816 
 2817     if (*status > 0)
 2818         return(*status);
 2819 
 2820     if (dtcode)
 2821         *dtcode = 0;
 2822 
 2823     if (trepeat)
 2824         *trepeat = 0;
 2825 
 2826     if (twidth)
 2827         *twidth = 0;
 2828 
 2829     nchar = strlen(tform);
 2830 
 2831     for (ii = 0; ii < nchar; ii++)
 2832     {
 2833         if (tform[ii] != ' ')     /* find first non-space char */
 2834             break;
 2835     }
 2836 
 2837     if (ii == nchar)
 2838     {
 2839         ffpmsg("Error: binary table TFORM code is blank (ffbnfm).");
 2840         return(*status = BAD_TFORM);
 2841     }
 2842 
 2843     if (nchar-ii > FLEN_VALUE-1)
 2844     {
 2845         ffpmsg("Error: binary table TFORM code is too long (ffbnfm).");
 2846         return (*status = BAD_TFORM);
 2847     }
 2848     strcpy(temp, &tform[ii]); /* copy format string */
 2849     ffupch(temp);     /* make sure it is in upper case */
 2850     form = temp;      /* point to start of format string */
 2851 
 2852     /*-----------------------------------------------*/
 2853     /*       get the repeat count                    */
 2854     /*-----------------------------------------------*/
 2855 
 2856     ii = 0;
 2857     while(isdigit((int) form[ii]))
 2858         ii++;   /* look for leading digits in the field */
 2859 
 2860     if (ii == 0)
 2861         repeat = 1;  /* no explicit repeat count */
 2862     else
 2863     {
 2864         if (sscanf(form,"%ld", &repeat) != 1) /* read repeat count */
 2865         {
 2866            ffpmsg("Error: Bad repeat format in TFORM (ffbnfm).");
 2867            return(*status = BAD_TFORM);
 2868         }  
 2869     }
 2870 
 2871     /*-----------------------------------------------*/
 2872     /*             determine datatype code           */
 2873     /*-----------------------------------------------*/
 2874 
 2875     form = form + ii;  /* skip over the repeat field */
 2876 
 2877     if (form[0] == 'P' || form[0] == 'Q')
 2878     {
 2879         variable = 1;  /* this is a variable length column */
 2880 /*        repeat = 1;  */ /* disregard any other repeat value */
 2881         form++;        /* move to the next data type code char */
 2882     }
 2883     else
 2884         variable = 0;
 2885 
 2886     if (form[0] == 'U')  /* internal code to signify unsigned short integer */
 2887     { 
 2888         datacode = TUSHORT;
 2889         width = 2;
 2890     }
 2891     else if (form[0] == 'I')
 2892     {
 2893         datacode = TSHORT;
 2894         width = 2;
 2895     }
 2896     else if (form[0] == 'V') /* internal code to signify unsigned integer */
 2897     {
 2898         datacode = TULONG;
 2899         width = 4;
 2900     }
 2901     else if (form[0] == 'W') /* internal code to signify unsigned long long integer */
 2902     {
 2903         datacode = TULONGLONG;
 2904         width = 8;
 2905     }
 2906     else if (form[0] == 'J')
 2907     {
 2908         datacode = TLONG;
 2909         width = 4;
 2910     }
 2911     else if (form[0] == 'K')
 2912     {
 2913         datacode = TLONGLONG;
 2914         width = 8;
 2915     }
 2916     else if (form[0] == 'E')
 2917     {
 2918         datacode = TFLOAT;
 2919         width = 4;
 2920     }
 2921     else if (form[0] == 'D')
 2922     {
 2923         datacode = TDOUBLE;
 2924         width = 8;
 2925     }
 2926     else if (form[0] == 'A')
 2927     {
 2928         datacode = TSTRING;
 2929 
 2930         /*
 2931           the following code is used to support the non-standard
 2932           datatype of the form rAw where r = total width of the field
 2933           and w = width of fixed-length substrings within the field.
 2934         */
 2935         iread = 0;
 2936         if (form[1] != 0)
 2937         {
 2938             if (form[1] == '(' )  /* skip parenthesis around */
 2939                 form++;          /* variable length column width */
 2940 
 2941             iread = sscanf(&form[1],"%ld", &width);
 2942         }
 2943 
 2944         if (iread != 1 || (!variable && (width > repeat)) )
 2945             width = repeat;
 2946   
 2947     }
 2948     else if (form[0] == 'L')
 2949     {
 2950         datacode = TLOGICAL;
 2951         width = 1;
 2952     }
 2953     else if (form[0] == 'X')
 2954     {
 2955         datacode = TBIT;
 2956         width = 1;
 2957     }
 2958     else if (form[0] == 'B')
 2959     {
 2960         datacode = TBYTE;
 2961         width = 1;
 2962     }
 2963     else if (form[0] == 'S') /* internal code to signify signed byte */
 2964     {
 2965         datacode = TSBYTE;
 2966         width = 1;
 2967     }
 2968     else if (form[0] == 'C')
 2969     {
 2970         datacode = TCOMPLEX;
 2971         width = 8;
 2972     }
 2973     else if (form[0] == 'M')
 2974     {
 2975         datacode = TDBLCOMPLEX;
 2976         width = 16;
 2977     }
 2978     else
 2979     {
 2980         snprintf(message, FLEN_ERRMSG,
 2981         "Illegal binary table TFORMn datatype: \'%s\' ", tform);
 2982         ffpmsg(message);
 2983         return(*status = BAD_TFORM_DTYPE);
 2984     }
 2985 
 2986     if (variable)
 2987         datacode = datacode * (-1); /* flag variable cols w/ neg type code */
 2988 
 2989     if (dtcode)
 2990        *dtcode = datacode;
 2991 
 2992     if (trepeat)
 2993        *trepeat = repeat;
 2994 
 2995     if (twidth)
 2996        *twidth = width;
 2997 
 2998     return(*status);
 2999 }
 3000 /*--------------------------------------------------------------------------*/
 3001 int ffbnfmll(char *tform,     /* I - format code from the TFORMn keyword */
 3002            int *dtcode,   /* O - numerical datatype code */
 3003            LONGLONG *trepeat,    /* O - repeat count of the field  */
 3004            long *twidth,     /* O - width of the field, in chars */
 3005            int *status)     /* IO - error status      */
 3006 {
 3007 /*
 3008   parse the binary table TFORM column format to determine the data
 3009   type, repeat count, and the field width (if it is an ASCII (A) field)
 3010 */
 3011     size_t ii, nchar;
 3012     int datacode, variable, iread;
 3013     long width;
 3014     LONGLONG repeat;
 3015     char *form, temp[FLEN_VALUE], message[FLEN_ERRMSG];
 3016     double drepeat;
 3017 
 3018     if (*status > 0)
 3019         return(*status);
 3020 
 3021     if (dtcode)
 3022         *dtcode = 0;
 3023 
 3024     if (trepeat)
 3025         *trepeat = 0;
 3026 
 3027     if (twidth)
 3028         *twidth = 0;
 3029 
 3030     nchar = strlen(tform);
 3031 
 3032     for (ii = 0; ii < nchar; ii++)
 3033     {
 3034         if (tform[ii] != ' ')     /* find first non-space char */
 3035             break;
 3036     }
 3037 
 3038     if (ii == nchar)
 3039     {
 3040         ffpmsg("Error: binary table TFORM code is blank (ffbnfmll).");
 3041         return(*status = BAD_TFORM);
 3042     }
 3043     
 3044     if (strlen(&tform[ii]) > FLEN_VALUE-1)
 3045     {
 3046        ffpmsg("Error: binary table TFORM code is too long (ffbnfmll).");
 3047        return(*status = BAD_TFORM);
 3048     }
 3049     strcpy(temp, &tform[ii]); /* copy format string */
 3050     ffupch(temp);     /* make sure it is in upper case */
 3051     form = temp;      /* point to start of format string */
 3052 
 3053     /*-----------------------------------------------*/
 3054     /*       get the repeat count                    */
 3055     /*-----------------------------------------------*/
 3056 
 3057     ii = 0;
 3058     while(isdigit((int) form[ii]))
 3059         ii++;   /* look for leading digits in the field */
 3060 
 3061     if (ii == 0)
 3062         repeat = 1;  /* no explicit repeat count */
 3063     else {
 3064        /* read repeat count */
 3065 
 3066         /* print as double, because the string-to-64-bit int conversion */
 3067         /* character is platform dependent (%lld, %ld, %I64d)           */
 3068 
 3069         sscanf(form,"%lf", &drepeat);
 3070         repeat = (LONGLONG) (drepeat + 0.1);
 3071     }
 3072     /*-----------------------------------------------*/
 3073     /*             determine datatype code           */
 3074     /*-----------------------------------------------*/
 3075 
 3076     form = form + ii;  /* skip over the repeat field */
 3077 
 3078     if (form[0] == 'P' || form[0] == 'Q')
 3079     {
 3080         variable = 1;  /* this is a variable length column */
 3081 /*        repeat = 1;  */  /* disregard any other repeat value */
 3082         form++;        /* move to the next data type code char */
 3083     }
 3084     else
 3085         variable = 0;
 3086 
 3087     if (form[0] == 'U')  /* internal code to signify unsigned integer */
 3088     { 
 3089         datacode = TUSHORT;
 3090         width = 2;
 3091     }
 3092     else if (form[0] == 'I')
 3093     {
 3094         datacode = TSHORT;
 3095         width = 2;
 3096     }
 3097     else if (form[0] == 'V') /* internal code to signify unsigned integer */
 3098     {
 3099         datacode = TULONG;
 3100         width = 4;
 3101     }
 3102     else if (form[0] == 'W') /* internal code to signify unsigned long long integer */
 3103     {
 3104         datacode = TULONGLONG;
 3105         width = 8;
 3106     }
 3107     else if (form[0] == 'J')
 3108     {
 3109         datacode = TLONG;
 3110         width = 4;
 3111     }
 3112     else if (form[0] == 'K')
 3113     {
 3114         datacode = TLONGLONG;
 3115         width = 8;
 3116     }
 3117     else if (form[0] == 'E')
 3118     {
 3119         datacode = TFLOAT;
 3120         width = 4;
 3121     }
 3122     else if (form[0] == 'D')
 3123     {
 3124         datacode = TDOUBLE;
 3125         width = 8;
 3126     }
 3127     else if (form[0] == 'A')
 3128     {
 3129         datacode = TSTRING;
 3130 
 3131         /*
 3132           the following code is used to support the non-standard
 3133           datatype of the form rAw where r = total width of the field
 3134           and w = width of fixed-length substrings within the field.
 3135         */
 3136         iread = 0;
 3137         if (form[1] != 0)
 3138         {
 3139             if (form[1] == '(' )  /* skip parenthesis around */
 3140                 form++;          /* variable length column width */
 3141 
 3142             iread = sscanf(&form[1],"%ld", &width);
 3143         }
 3144 
 3145         if (iread != 1 || (!variable && (width > repeat)) )
 3146             width = (long) repeat;
 3147   
 3148     }
 3149     else if (form[0] == 'L')
 3150     {
 3151         datacode = TLOGICAL;
 3152         width = 1;
 3153     }
 3154     else if (form[0] == 'X')
 3155     {
 3156         datacode = TBIT;
 3157         width = 1;
 3158     }
 3159     else if (form[0] == 'B')
 3160     {
 3161         datacode = TBYTE;
 3162         width = 1;
 3163     }
 3164     else if (form[0] == 'S') /* internal code to signify signed byte */
 3165     {
 3166         datacode = TSBYTE;
 3167         width = 1;
 3168     }
 3169     else if (form[0] == 'C')
 3170     {
 3171         datacode = TCOMPLEX;
 3172         width = 8;
 3173     }
 3174     else if (form[0] == 'M')
 3175     {
 3176         datacode = TDBLCOMPLEX;
 3177         width = 16;
 3178     }
 3179     else
 3180     {
 3181         snprintf(message, FLEN_ERRMSG,
 3182         "Illegal binary table TFORMn datatype: \'%s\' ", tform);
 3183         ffpmsg(message);
 3184         return(*status = BAD_TFORM_DTYPE);
 3185     }
 3186 
 3187     if (variable)
 3188         datacode = datacode * (-1); /* flag variable cols w/ neg type code */
 3189 
 3190     if (dtcode)
 3191        *dtcode = datacode;
 3192 
 3193     if (trepeat)
 3194        *trepeat = repeat;
 3195 
 3196     if (twidth)
 3197        *twidth = width;
 3198 
 3199     return(*status);
 3200 }
 3201 
 3202 /*--------------------------------------------------------------------------*/
 3203 void ffcfmt(char *tform,    /* value of an ASCII table TFORMn keyword */
 3204             char *cform)    /* equivalent format code in C language syntax */
 3205 /*
 3206   convert the FITS format string for an ASCII Table extension column into the
 3207   equivalent C format string that can be used in a printf statement, after
 3208   the values have been read as a double.
 3209 */
 3210 {
 3211     int ii;
 3212 
 3213     cform[0] = '\0';
 3214     ii = 0;
 3215     while (tform[ii] != 0 && tform[ii] == ' ') /* find first non-blank char */
 3216          ii++;
 3217 
 3218     if (tform[ii] == 0)
 3219         return;    /* input format string was blank */
 3220 
 3221     cform[0] = '%';  /* start the format string */
 3222 
 3223     strcpy(&cform[1], &tform[ii + 1]); /* append the width and decimal code */
 3224 
 3225 
 3226     if (tform[ii] == 'A')
 3227         strcat(cform, "s");
 3228     else if (tform[ii] == 'I')
 3229         strcat(cform, ".0f");  /*  0 precision to suppress decimal point */
 3230     if (tform[ii] == 'F')
 3231         strcat(cform, "f");
 3232     if (tform[ii] == 'E')
 3233         strcat(cform, "E");
 3234     if (tform[ii] == 'D')
 3235         strcat(cform, "E");
 3236 
 3237     return;
 3238 }
 3239 /*--------------------------------------------------------------------------*/
 3240 void ffcdsp(char *tform,    /* value of an ASCII table TFORMn keyword */
 3241             char *cform)    /* equivalent format code in C language syntax */
 3242 /*
 3243   convert the FITS TDISPn display format into the equivalent C format
 3244   suitable for use in a printf statement.
 3245 */
 3246 {
 3247     int ii;
 3248 
 3249     cform[0] = '\0';
 3250     ii = 0;
 3251     while (tform[ii] != 0 && tform[ii] == ' ') /* find first non-blank char */
 3252          ii++;
 3253 
 3254     if (tform[ii] == 0)
 3255     {
 3256         cform[0] = '\0';
 3257         return;    /* input format string was blank */
 3258     }
 3259 
 3260     if (strchr(tform+ii, '%'))  /* is there a % character in the string?? */
 3261     {
 3262         cform[0] = '\0';
 3263         return;    /* illegal TFORM string (possibly even harmful) */
 3264     }
 3265 
 3266     cform[0] = '%';  /* start the format string */
 3267 
 3268     strcpy(&cform[1], &tform[ii + 1]); /* append the width and decimal code */
 3269 
 3270     if      (tform[ii] == 'A' || tform[ii] == 'a')
 3271         strcat(cform, "s");
 3272     else if (tform[ii] == 'I' || tform[ii] == 'i')
 3273         strcat(cform, "d");
 3274     else if (tform[ii] == 'O' || tform[ii] == 'o')
 3275         strcat(cform, "o");
 3276     else if (tform[ii] == 'Z' || tform[ii] == 'z')
 3277         strcat(cform, "X");
 3278     else if (tform[ii] == 'F' || tform[ii] == 'f')
 3279         strcat(cform, "f");
 3280     else if (tform[ii] == 'E' || tform[ii] == 'e')
 3281         strcat(cform, "E");
 3282     else if (tform[ii] == 'D' || tform[ii] == 'd')
 3283         strcat(cform, "E");
 3284     else if (tform[ii] == 'G' || tform[ii] == 'g')
 3285         strcat(cform, "G");
 3286     else
 3287         cform[0] = '\0';  /* unrecognized tform code */
 3288 
 3289     return;
 3290 }
 3291 /*--------------------------------------------------------------------------*/
 3292 int ffgcno( fitsfile *fptr,  /* I - FITS file pionter                       */
 3293             int  casesen,    /* I - case sensitive string comparison? 0=no  */
 3294             char *templt,    /* I - input name of column (w/wildcards)      */
 3295             int  *colnum,    /* O - number of the named column; 1=first col */
 3296             int  *status)    /* IO - error status                           */
 3297 /*
 3298   Determine the column number corresponding to an input column name.
 3299   The first column of the table = column 1;  
 3300   This supports the * and ? wild cards in the input template.
 3301 */
 3302 {
 3303     char colname[FLEN_VALUE];  /*  temporary string to hold column name  */
 3304 
 3305     ffgcnn(fptr, casesen, templt, colname, colnum, status);
 3306 
 3307     return(*status);
 3308 }
 3309 /*--------------------------------------------------------------------------*/
 3310 int ffgcnn( fitsfile *fptr,  /* I - FITS file pointer                       */
 3311             int  casesen,    /* I - case sensitive string comparison? 0=no  */
 3312             char *templt,    /* I - input name of column (w/wildcards)      */
 3313             char *colname,   /* O - full column name up to 68 + 1 chars long*/
 3314             int  *colnum,    /* O - number of the named column; 1=first col */
 3315             int  *status)    /* IO - error status                           */
 3316 /*
 3317   Return the full column name and column number of the next column whose
 3318   TTYPEn keyword value matches the input template string.
 3319   The template may contain the * and ? wildcards.  Status = 237 is
 3320   returned if the match is not unique.  If so, one may call this routine
 3321   again with input status=237  to get the next match.  A status value of
 3322   219 is returned when there are no more matching columns.
 3323 */
 3324 {
 3325     char errmsg[FLEN_ERRMSG];
 3326     int tstatus, ii, founde, foundw, match, exact, unique;
 3327     long ivalue;
 3328     tcolumn *colptr;
 3329 
 3330     if (*status <= 0)
 3331     {
 3332         (fptr->Fptr)->startcol = 0;   /* start search with first column */
 3333         tstatus = 0;
 3334     }
 3335     else if (*status == COL_NOT_UNIQUE) /* start search from previous spot */
 3336     {
 3337         tstatus = COL_NOT_UNIQUE;
 3338         *status = 0;
 3339     }
 3340     else
 3341         return(*status);  /* bad input status value */
 3342 
 3343     colname[0] = 0;    /* initialize null return */
 3344     *colnum = 0;
 3345 
 3346     /* reset position to the correct HDU if necessary */
 3347     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 3348         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 3349     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 3350         if ( ffrdef(fptr, status) > 0)   /* rescan header to get col struct */
 3351             return(*status);
 3352 
 3353     colptr = (fptr->Fptr)->tableptr;   /* pointer to first column */
 3354     colptr += ((fptr->Fptr)->startcol);      /* offset to starting column */
 3355 
 3356     founde = FALSE;   /* initialize 'found exact match' flag */
 3357     foundw = FALSE;   /* initialize 'found wildcard match' flag */
 3358     unique = FALSE;
 3359 
 3360     for (ii = (fptr->Fptr)->startcol; ii < (fptr->Fptr)->tfield; ii++, colptr++)
 3361     {
 3362         ffcmps(templt, colptr->ttype, casesen, &match, &exact);
 3363         if (match)
 3364         {
 3365             if (founde && exact)
 3366             {
 3367                 /* warning: this is the second exact match we've found     */
 3368                 /*reset pointer to first match so next search starts there */
 3369                (fptr->Fptr)->startcol = *colnum;
 3370                return(*status = COL_NOT_UNIQUE);
 3371             }
 3372             else if (founde)   /* a wildcard match */
 3373             {
 3374                 /* already found exact match so ignore this non-exact match */
 3375             }
 3376             else if (exact)
 3377             {
 3378                 /* this is the first exact match we have found, so save it. */
 3379                 strcpy(colname, colptr->ttype);
 3380                 *colnum = ii + 1;
 3381                 founde = TRUE;
 3382             }
 3383             else if (foundw)
 3384             {
 3385                 /* we have already found a wild card match, so not unique */
 3386                 /* continue searching for other matches                   */
 3387                 unique = FALSE;
 3388             }
 3389             else
 3390             {
 3391                /* this is the first wild card match we've found. save it */
 3392                strcpy(colname, colptr->ttype);
 3393                *colnum = ii + 1;
 3394                (fptr->Fptr)->startcol = *colnum;
 3395                foundw = TRUE;
 3396                unique = TRUE;
 3397             }
 3398         }
 3399     }
 3400 
 3401     /* OK, we've checked all the names now see if we got any matches */
 3402     if (founde)
 3403     {
 3404         if (tstatus == COL_NOT_UNIQUE)  /* we did find 1 exact match but */
 3405             *status = COL_NOT_UNIQUE;   /* there was a previous match too */
 3406     }
 3407     else if (foundw)
 3408     {
 3409         /* found one or more wildcard matches; report error if not unique */
 3410        if (!unique || tstatus == COL_NOT_UNIQUE)
 3411            *status = COL_NOT_UNIQUE;
 3412     }
 3413     else
 3414     {
 3415         /* didn't find a match; check if template is a positive integer */
 3416         ffc2ii(templt, &ivalue, &tstatus);
 3417         if (tstatus ==  0 && ivalue <= (fptr->Fptr)->tfield && ivalue > 0)
 3418         {
 3419             *colnum = ivalue;
 3420 
 3421             colptr = (fptr->Fptr)->tableptr;   /* pointer to first column */
 3422             colptr += (ivalue - 1);    /* offset to correct column */
 3423             strcpy(colname, colptr->ttype);
 3424         }
 3425         else
 3426         {
 3427             *status = COL_NOT_FOUND;
 3428             if (tstatus != COL_NOT_UNIQUE)
 3429             {
 3430               snprintf(errmsg, FLEN_ERRMSG, "ffgcnn could not find column: %.45s", templt);
 3431               ffpmsg(errmsg);
 3432             }
 3433         }
 3434     }
 3435     
 3436     (fptr->Fptr)->startcol = *colnum;  /* save pointer for next time */
 3437     return(*status);
 3438 }
 3439 /*--------------------------------------------------------------------------*/
 3440 void ffcmps(char *templt,   /* I - input template (may have wildcards)      */
 3441             char *colname,  /* I - full column name up to 68 + 1 chars long */
 3442             int  casesen,   /* I - case sensitive string comparison? 1=yes  */
 3443             int  *match,    /* O - do template and colname match? 1=yes     */
 3444             int  *exact)    /* O - do strings exactly match, or wildcards   */
 3445 /*
 3446   compare the template to the string and test if they match.
 3447   The strings are limited to 68 characters or less (the max. length
 3448   of a FITS string keyword value.  This routine reports whether
 3449   the two strings match and whether the match is exact or
 3450   involves wildcards.
 3451 
 3452   This algorithm is very similar to the way unix filename wildcards
 3453   work except that this first treats a wild card as a literal character
 3454   when looking for a match.  If there is no literal match, then
 3455   it interpretes it as a wild card.  So the template 'AB*DE'
 3456   is considered to be an exact rather than a wild card match to
 3457   the string 'AB*DE'.  The '#' wild card in the template string will 
 3458   match any consecutive string of decimal digits in the colname.
 3459   
 3460 */
 3461 {
 3462     int ii, found, t1, s1, wildsearch = 0, tsave = 0, ssave = 0;
 3463     char temp[FLEN_VALUE], col[FLEN_VALUE];
 3464 
 3465     *match = FALSE;
 3466     *exact = TRUE;
 3467 
 3468     strncpy(temp, templt, FLEN_VALUE); /* copy strings to work area */
 3469     strncpy(col, colname, FLEN_VALUE);
 3470     temp[FLEN_VALUE - 1] = '\0';  /* make sure strings are terminated */
 3471     col[FLEN_VALUE - 1]  = '\0';
 3472 
 3473     /* truncate trailing non-significant blanks */
 3474     for (ii = strlen(temp) - 1; ii >= 0 && temp[ii] == ' '; ii--)
 3475         temp[ii] = '\0';
 3476 
 3477     for (ii = strlen(col) - 1; ii >= 0 && col[ii] == ' '; ii--)
 3478         col[ii] = '\0';
 3479        
 3480     if (!casesen)
 3481     {             /* convert both strings to uppercase before comparison */
 3482         ffupch(temp);
 3483         ffupch(col);
 3484     }
 3485 
 3486     if (!FSTRCMP(temp, col) )
 3487     {
 3488         *match = TRUE;     /* strings exactly match */
 3489         return;
 3490     }
 3491 
 3492     *exact = FALSE;    /* strings don't exactly match */
 3493 
 3494     t1 = 0;   /* start comparison with 1st char of each string */
 3495     s1 = 0;
 3496 
 3497     while(1)  /* compare corresponding chars in each string */
 3498     {
 3499       if (temp[t1] == '\0' && col[s1] == '\0')
 3500       { 
 3501          /* completely scanned both strings so they match */
 3502          *match = TRUE;
 3503          return;
 3504       }
 3505       else if (temp[t1] == '\0')
 3506       { 
 3507         if (wildsearch)
 3508         {
 3509             /* 
 3510                the previous wildcard search may have been going down
 3511                a blind alley.  Backtrack, and resume the wildcard
 3512                search with the next character in the string.
 3513             */
 3514             t1 = tsave;
 3515             s1 = ssave + 1;
 3516         }
 3517         else
 3518         {
 3519             /* reached end of template string so they don't match */
 3520             return;
 3521         }
 3522       }
 3523       else if (col[s1] == '\0')
 3524       { 
 3525          /* reached end of other string; they match if the next */
 3526          /* character in the template string is a '*' wild card */
 3527 
 3528         if (temp[t1] == '*' && temp[t1 + 1] == '\0')
 3529         {
 3530            *match = TRUE;
 3531         }
 3532 
 3533         return;
 3534       }
 3535 
 3536       if (temp[t1] == col[s1] || (temp[t1] == '?') )
 3537       {
 3538         s1++;  /* corresponding chars in the 2 strings match */
 3539         t1++;  /* increment both pointers and loop back again */
 3540       }
 3541       else if (temp[t1] == '#' && isdigit((int) col[s1]) )
 3542       {
 3543         s1++;  /* corresponding chars in the 2 strings match */
 3544         t1++;  /* increment both pointers */
 3545 
 3546         /* find the end of the string of digits */
 3547         while (isdigit((int) col[s1]) ) 
 3548             s1++;        
 3549       }
 3550       else if (temp[t1] == '*')
 3551       {
 3552 
 3553         /* save current string locations, in case we need to restart */
 3554         wildsearch = 1;
 3555         tsave = t1;
 3556         ssave = s1;
 3557 
 3558         /* get next char from template and look for it in the col name */
 3559         t1++;
 3560         if (temp[t1] == '\0' || temp[t1] == ' ')
 3561         {
 3562           /* reached end of template so strings match */
 3563           *match = TRUE;
 3564           return;
 3565         }
 3566 
 3567         found = FALSE;
 3568         while (col[s1] && !found)
 3569         {
 3570           if (temp[t1] == col[s1])
 3571           {
 3572             t1++;  /* found matching characters; incre both pointers */
 3573             s1++;  /* and loop back to compare next chars */
 3574             found = TRUE;
 3575           }
 3576           else
 3577             s1++;  /* increment the column name pointer and try again */
 3578         }
 3579 
 3580         if (!found)
 3581         {
 3582           return;  /* hit end of column name and failed to find a match */
 3583         }
 3584       }
 3585       else
 3586       {
 3587         if (wildsearch)
 3588         {
 3589             /* 
 3590                the previous wildcard search may have been going down
 3591                a blind alley.  Backtrack, and resume the wildcard
 3592                search with the next character in the string.
 3593             */
 3594             t1 = tsave;
 3595             s1 = ssave + 1;
 3596         }
 3597         else
 3598         {
 3599           return;   /* strings don't match */
 3600         }
 3601       }
 3602     }
 3603 }
 3604 /*--------------------------------------------------------------------------*/
 3605 int ffgtcl( fitsfile *fptr,  /* I - FITS file pointer                       */
 3606             int  colnum,     /* I - column number                           */
 3607             int *typecode,   /* O - datatype code (21 = short, etc)         */
 3608             long *repeat,    /* O - repeat count of field                   */
 3609             long *width,     /* O - if ASCII, width of field or unit string */
 3610             int  *status)    /* IO - error status                           */
 3611 /*
 3612   Get Type of table column. 
 3613   Returns the datatype code of the column, as well as the vector
 3614   repeat count and (if it is an ASCII character column) the
 3615   width of the field or a unit string within the field.  This supports the
 3616   TFORMn = 'rAw' syntax for specifying arrays of substrings, so
 3617   if TFORMn = '60A12' then repeat = 60 and width = 12.
 3618 */
 3619 {
 3620     LONGLONG trepeat, twidth;
 3621     
 3622     ffgtclll(fptr, colnum, typecode, &trepeat, &twidth, status);
 3623 
 3624     if (*status > 0)
 3625         return(*status);
 3626     
 3627     if (repeat)
 3628         *repeat= (long) trepeat;
 3629       
 3630     if (width)
 3631         *width = (long) twidth;
 3632     
 3633     return(*status);
 3634 }
 3635 /*--------------------------------------------------------------------------*/
 3636 int ffgtclll( fitsfile *fptr,  /* I - FITS file pointer                       */
 3637             int  colnum,       /* I - column number                           */
 3638             int *typecode,   /* O - datatype code (21 = short, etc)         */
 3639             LONGLONG *repeat, /* O - repeat count of field                   */
 3640             LONGLONG *width, /* O - if ASCII, width of field or unit string */
 3641             int  *status)    /* IO - error status                           */
 3642 /*
 3643   Get Type of table column. 
 3644   Returns the datatype code of the column, as well as the vector
 3645   repeat count and (if it is an ASCII character column) the
 3646   width of the field or a unit string within the field.  This supports the
 3647   TFORMn = 'rAw' syntax for specifying arrays of substrings, so
 3648   if TFORMn = '60A12' then repeat = 60 and width = 12.
 3649 */
 3650 {
 3651     tcolumn *colptr;
 3652     int hdutype, decims;
 3653     long tmpwidth;
 3654 
 3655     if (*status > 0)
 3656         return(*status);
 3657 
 3658     /* reset position to the correct HDU if necessary */
 3659     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 3660         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 3661     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 3662         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 3663             return(*status);
 3664 
 3665     if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
 3666         return(*status = BAD_COL_NUM);
 3667 
 3668     colptr = (fptr->Fptr)->tableptr;   /* pointer to first column */
 3669     colptr += (colnum - 1);    /* offset to correct column */
 3670 
 3671     if (ffghdt(fptr, &hdutype, status) > 0)
 3672         return(*status);
 3673 
 3674     if (hdutype == ASCII_TBL)
 3675     {
 3676        ffasfm(colptr->tform, typecode, &tmpwidth, &decims, status);
 3677        *width = tmpwidth;
 3678        
 3679       if (repeat)
 3680            *repeat = 1;
 3681     }
 3682     else
 3683     {
 3684       if (typecode)
 3685           *typecode = colptr->tdatatype;
 3686 
 3687       if (width)
 3688           *width = colptr->twidth;
 3689 
 3690       if (repeat)
 3691           *repeat = colptr->trepeat;
 3692     }
 3693 
 3694     return(*status);
 3695 }
 3696 /*--------------------------------------------------------------------------*/
 3697 int ffeqty( fitsfile *fptr,  /* I - FITS file pointer                       */
 3698             int  colnum,     /* I - column number                           */
 3699             int *typecode,   /* O - datatype code (21 = short, etc)         */
 3700             long *repeat,    /* O - repeat count of field                   */
 3701             long *width,     /* O - if ASCII, width of field or unit string */
 3702             int  *status)    /* IO - error status                           */
 3703 /*
 3704   Get the 'equivalent' table column type. 
 3705 
 3706   This routine is similar to the ffgtcl routine (which returns the physical
 3707   datatype of the column, as stored in the FITS file) except that if the
 3708   TSCALn and TZEROn keywords are defined for the column, then it returns
 3709   the 'equivalent' datatype.  Thus, if the column is defined as '1I'  (short
 3710   integer) this routine may return the type as 'TUSHORT' or as 'TFLOAT'
 3711   depending on the TSCALn and TZEROn values.
 3712   
 3713   Returns the datatype code of the column, as well as the vector
 3714   repeat count and (if it is an ASCII character column) the
 3715   width of the field or a unit string within the field.  This supports the
 3716   TFORMn = 'rAw' syntax for specifying arrays of substrings, so
 3717   if TFORMn = '60A12' then repeat = 60 and width = 12.
 3718 */
 3719 {
 3720     LONGLONG trepeat, twidth;
 3721     
 3722     ffeqtyll(fptr, colnum, typecode, &trepeat, &twidth, status);
 3723 
 3724     if (repeat)
 3725         *repeat= (long) trepeat;
 3726 
 3727     if (width)
 3728         *width = (long) twidth;
 3729 
 3730     return(*status);
 3731 }
 3732 /*--------------------------------------------------------------------------*/
 3733 int ffeqtyll( fitsfile *fptr,  /* I - FITS file pointer                       */
 3734             int  colnum,     /* I - column number                           */
 3735             int *typecode,   /* O - datatype code (21 = short, etc)         */
 3736             LONGLONG *repeat,    /* O - repeat count of field                   */
 3737             LONGLONG *width,     /* O - if ASCII, width of field or unit string */
 3738             int  *status)    /* IO - error status                           */
 3739 /*
 3740   Get the 'equivalent' table column type. 
 3741 
 3742   This routine is similar to the ffgtcl routine (which returns the physical
 3743   datatype of the column, as stored in the FITS file) except that if the
 3744   TSCALn and TZEROn keywords are defined for the column, then it returns
 3745   the 'equivalent' datatype.  Thus, if the column is defined as '1I'  (short
 3746   integer) this routine may return the type as 'TUSHORT' or as 'TFLOAT'
 3747   depending on the TSCALn and TZEROn values.
 3748   
 3749   Returns the datatype code of the column, as well as the vector
 3750   repeat count and (if it is an ASCII character column) the
 3751   width of the field or a unit string within the field.  This supports the
 3752   TFORMn = 'rAw' syntax for specifying arrays of substrings, so
 3753   if TFORMn = '60A12' then repeat = 60 and width = 12.
 3754 */
 3755 {
 3756     tcolumn *colptr;
 3757     int hdutype, decims, tcode, effcode;
 3758     double tscale, tzero, min_val, max_val;
 3759     long lngscale, lngzero = 0, tmpwidth;
 3760 
 3761     if (*status > 0)
 3762         return(*status);
 3763 
 3764     /* reset position to the correct HDU if necessary */
 3765     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 3766         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 3767     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 3768         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 3769             return(*status);
 3770 
 3771     if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
 3772         return(*status = BAD_COL_NUM);
 3773 
 3774     colptr = (fptr->Fptr)->tableptr;   /* pointer to first column */
 3775     colptr += (colnum - 1);    /* offset to correct column */
 3776 
 3777     if (ffghdt(fptr, &hdutype, status) > 0)
 3778         return(*status);
 3779 
 3780     if (hdutype == ASCII_TBL)
 3781     {
 3782       ffasfm(colptr->tform, typecode, &tmpwidth, &decims, status);
 3783       if (width)
 3784           *width = tmpwidth;
 3785 
 3786       if (repeat)
 3787            *repeat = 1;
 3788     }
 3789     else
 3790     {
 3791       if (typecode)
 3792           *typecode = colptr->tdatatype;
 3793 
 3794       if (width)
 3795           *width = colptr->twidth;
 3796 
 3797       if (repeat)
 3798           *repeat = colptr->trepeat;
 3799     }
 3800 
 3801     /* return if caller is not interested in the typecode value */
 3802     if (!typecode)
 3803         return(*status);
 3804 
 3805     /* check if the tscale and tzero keywords are defined, which might
 3806        change the effective datatype of the column  */
 3807 
 3808     tscale = colptr->tscale;
 3809     tzero = colptr->tzero;
 3810 
 3811     if (tscale == 1.0 && tzero == 0.0)  /* no scaling */
 3812         return(*status);
 3813  
 3814     tcode = abs(*typecode);
 3815 
 3816     switch (tcode)
 3817     {
 3818       case TBYTE:   /* binary table 'rB' column */
 3819         min_val = 0.;
 3820         max_val = 255.0;
 3821         break;
 3822 
 3823       case TSHORT:
 3824         min_val = -32768.0;
 3825         max_val =  32767.0;
 3826         break;
 3827         
 3828       case TLONG:
 3829 
 3830         min_val = -2147483648.0;
 3831         max_val =  2147483647.0;
 3832         break;
 3833         
 3834       case TLONGLONG:
 3835         min_val = -9.2233720368547755808E18;
 3836         max_val =  9.2233720368547755807E18;
 3837         break;
 3838     
 3839       default:  /* don't have to deal with other data types */
 3840         return(*status);
 3841     }
 3842 
 3843     if (tscale >= 0.) {
 3844         min_val = tzero + tscale * min_val;
 3845         max_val = tzero + tscale * max_val;
 3846     } else {
 3847         max_val = tzero + tscale * min_val;
 3848         min_val = tzero + tscale * max_val;
 3849     }
 3850     if (tzero < 2147483648.)  /* don't exceed range of 32-bit integer */
 3851        lngzero = (long) tzero;
 3852     lngscale   = (long) tscale;
 3853 
 3854     if ((tzero != 2147483648.) && /* special value that exceeds integer range */
 3855         (tzero != 9223372036854775808.) &&  /* indicates unsigned long long */
 3856        (lngzero != tzero || lngscale != tscale)) { /* not integers? */
 3857        /* floating point scaled values; just decide on required precision */
 3858        if (tcode == TBYTE || tcode == TSHORT)
 3859           effcode = TFLOAT;
 3860        else
 3861           effcode = TDOUBLE;
 3862 
 3863     /*
 3864        In all the remaining cases, TSCALn and TZEROn are integers,
 3865        and not equal to 1 and 0, respectively.  
 3866     */
 3867 
 3868     } else if ((min_val == -128.) && (max_val == 127.)) {
 3869         effcode = TSBYTE;
 3870  
 3871     } else if ((min_val >= -32768.0) && (max_val <= 32767.0)) {
 3872         effcode = TSHORT;
 3873 
 3874     } else if ((min_val >= 0.0) && (max_val <= 65535.0)) {
 3875         effcode = TUSHORT;
 3876 
 3877     } else if ((min_val >= -2147483648.0) && (max_val <= 2147483647.0)) {
 3878         effcode = TLONG;
 3879 
 3880     } else if ((min_val >= 0.0) && (max_val < 4294967296.0)) {
 3881         effcode = TULONG;
 3882 
 3883     } else if ((min_val >= -9.2233720368547755808E18) && (max_val <= 9.2233720368547755807E18)) {
 3884         effcode = TLONGLONG;
 3885 
 3886     } else if ((min_val >= 0.0) && (max_val <= 1.8446744073709551616E19)) {
 3887         effcode = TULONGLONG;
 3888 
 3889     } else {  /* exceeds the range of a 64-bit integer */
 3890         effcode = TDOUBLE;
 3891     }   
 3892 
 3893     /* return the effective datatype code (negative if variable length col.) */
 3894     if (*typecode < 0)  /* variable length array column */
 3895         *typecode = -effcode;
 3896     else
 3897         *typecode = effcode;
 3898 
 3899     return(*status);
 3900 }
 3901 /*--------------------------------------------------------------------------*/
 3902 int ffgncl( fitsfile *fptr,  /* I - FITS file pointer                       */
 3903             int  *ncols,     /* O - number of columns in the table          */
 3904             int  *status)    /* IO - error status                           */
 3905 /*
 3906   Get the number of columns in the table (= TFIELDS keyword)
 3907 */
 3908 {
 3909     if (*status > 0)
 3910         return(*status);
 3911 
 3912     /* reset position to the correct HDU if necessary */
 3913     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 3914         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 3915     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 3916         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 3917             return(*status);
 3918 
 3919     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
 3920         return(*status = NOT_TABLE);
 3921 
 3922     *ncols = (fptr->Fptr)->tfield;
 3923 
 3924     return(*status);
 3925 }
 3926 /*--------------------------------------------------------------------------*/
 3927 int ffgnrw( fitsfile *fptr,  /* I - FITS file pointer                       */
 3928             long  *nrows,    /* O - number of rows in the table             */
 3929             int  *status)    /* IO - error status                           */
 3930 /*
 3931   Get the number of rows in the table (= NAXIS2 keyword)
 3932 */
 3933 {
 3934     if (*status > 0)
 3935         return(*status);
 3936 
 3937     /* reset position to the correct HDU if necessary */
 3938     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 3939         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 3940     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 3941         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 3942             return(*status);
 3943 
 3944     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
 3945         return(*status = NOT_TABLE);
 3946 
 3947     /* the NAXIS2 keyword may not be up to date, so use the structure value */
 3948     *nrows = (long) (fptr->Fptr)->numrows;
 3949 
 3950     return(*status);
 3951 }
 3952 /*--------------------------------------------------------------------------*/
 3953 int ffgnrwll( fitsfile *fptr,  /* I - FITS file pointer                     */
 3954             LONGLONG  *nrows,  /* O - number of rows in the table           */
 3955             int  *status)      /* IO - error status                         */
 3956 /*
 3957   Get the number of rows in the table (= NAXIS2 keyword)
 3958 */
 3959 {
 3960     if (*status > 0)
 3961         return(*status);
 3962 
 3963     /* reset position to the correct HDU if necessary */
 3964     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 3965         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 3966     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 3967         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 3968             return(*status);
 3969 
 3970     if ((fptr->Fptr)->hdutype == IMAGE_HDU)
 3971         return(*status = NOT_TABLE);
 3972 
 3973     /* the NAXIS2 keyword may not be up to date, so use the structure value */
 3974     *nrows = (fptr->Fptr)->numrows;
 3975 
 3976     return(*status);
 3977 }
 3978 /*--------------------------------------------------------------------------*/
 3979 int ffgacl( fitsfile *fptr,   /* I - FITS file pointer                      */
 3980             int  colnum,      /* I - column number                          */
 3981             char *ttype,      /* O - TTYPEn keyword value                   */
 3982             long *tbcol,      /* O - TBCOLn keyword value                   */
 3983             char *tunit,      /* O - TUNITn keyword value                   */
 3984             char *tform,      /* O - TFORMn keyword value                   */
 3985             double *tscal,    /* O - TSCALn keyword value                   */
 3986             double *tzero,    /* O - TZEROn keyword value                   */
 3987             char *tnull,      /* O - TNULLn keyword value                   */
 3988             char *tdisp,      /* O - TDISPn keyword value                   */
 3989             int  *status)     /* IO - error status                          */
 3990 /*
 3991   get ASCII column keyword values
 3992 */
 3993 {
 3994     char name[FLEN_KEYWORD], comm[FLEN_COMMENT];
 3995     tcolumn *colptr;
 3996     int tstatus;
 3997 
 3998     if (*status > 0)
 3999         return(*status);
 4000 
 4001     /* reset position to the correct HDU if necessary */
 4002     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 4003         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 4004     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 4005         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 4006             return(*status);
 4007 
 4008     if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
 4009         return(*status = BAD_COL_NUM);
 4010 
 4011     /* get what we can from the column structure */
 4012 
 4013     colptr = (fptr->Fptr)->tableptr;   /* pointer to first column */
 4014     colptr += (colnum -1);     /* offset to correct column */
 4015 
 4016     if (ttype)
 4017         strcpy(ttype, colptr->ttype);
 4018 
 4019     if (tbcol)
 4020         *tbcol = (long) ((colptr->tbcol) + 1);  /* first col is 1, not 0 */
 4021 
 4022     if (tform)
 4023         strcpy(tform, colptr->tform);
 4024 
 4025     if (tscal)
 4026         *tscal = colptr->tscale;
 4027 
 4028     if (tzero)
 4029         *tzero = colptr->tzero;
 4030 
 4031     if (tnull)
 4032         strcpy(tnull, colptr->strnull);
 4033 
 4034     /* read keywords to get additional parameters */
 4035 
 4036     if (tunit)
 4037     {
 4038         ffkeyn("TUNIT", colnum, name, status);
 4039         tstatus = 0;
 4040         *tunit = '\0';
 4041         ffgkys(fptr, name, tunit, comm, &tstatus);
 4042     }
 4043 
 4044     if (tdisp)
 4045     {
 4046         ffkeyn("TDISP", colnum, name, status);
 4047         tstatus = 0;
 4048         *tdisp = '\0';
 4049         ffgkys(fptr, name, tdisp, comm, &tstatus);
 4050     }
 4051 
 4052     return(*status);
 4053 }
 4054 /*--------------------------------------------------------------------------*/
 4055 int ffgbcl( fitsfile *fptr,   /* I - FITS file pointer                      */
 4056             int  colnum,      /* I - column number                          */
 4057             char *ttype,      /* O - TTYPEn keyword value                   */
 4058             char *tunit,      /* O - TUNITn keyword value                   */
 4059             char *dtype,      /* O - datatype char: I, J, E, D, etc.        */
 4060             long *repeat,     /* O - vector column repeat count             */
 4061             double *tscal,    /* O - TSCALn keyword value                   */
 4062             double *tzero,    /* O - TZEROn keyword value                   */
 4063             long *tnull,      /* O - TNULLn keyword value integer cols only */
 4064             char *tdisp,      /* O - TDISPn keyword value                   */
 4065             int  *status)     /* IO - error status                          */
 4066 /*
 4067   get BINTABLE column keyword values
 4068 */
 4069 {
 4070     LONGLONG trepeat, ttnull;
 4071     
 4072     if (*status > 0)
 4073         return(*status);
 4074 
 4075     ffgbclll(fptr, colnum, ttype, tunit, dtype, &trepeat, tscal, tzero,
 4076              &ttnull, tdisp, status);
 4077 
 4078     if (repeat)
 4079         *repeat = (long) trepeat;
 4080 
 4081     if (tnull)
 4082         *tnull = (long) ttnull;
 4083 
 4084     return(*status);
 4085 }
 4086 /*--------------------------------------------------------------------------*/
 4087 int ffgbclll( fitsfile *fptr,   /* I - FITS file pointer                      */
 4088             int  colnum,      /* I - column number                          */
 4089             char *ttype,      /* O - TTYPEn keyword value                   */
 4090             char *tunit,      /* O - TUNITn keyword value                   */
 4091             char *dtype,      /* O - datatype char: I, J, E, D, etc.        */
 4092             LONGLONG *repeat, /* O - vector column repeat count             */
 4093             double *tscal,    /* O - TSCALn keyword value                   */
 4094             double *tzero,    /* O - TZEROn keyword value                   */
 4095             LONGLONG *tnull,  /* O - TNULLn keyword value integer cols only */
 4096             char *tdisp,      /* O - TDISPn keyword value                   */
 4097             int  *status)     /* IO - error status                          */
 4098 /*
 4099   get BINTABLE column keyword values
 4100 */
 4101 {
 4102     char name[FLEN_KEYWORD], comm[FLEN_COMMENT];
 4103     tcolumn *colptr;
 4104     int tstatus;
 4105 
 4106     if (*status > 0)
 4107         return(*status);
 4108 
 4109     /* reset position to the correct HDU if necessary */
 4110     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 4111         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 4112     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 4113         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 4114             return(*status);
 4115 
 4116     if (colnum < 1 || colnum > (fptr->Fptr)->tfield)
 4117         return(*status = BAD_COL_NUM);
 4118 
 4119     /* get what we can from the column structure */
 4120 
 4121     colptr = (fptr->Fptr)->tableptr;   /* pointer to first column */
 4122     colptr += (colnum -1);     /* offset to correct column */
 4123 
 4124     if (ttype)
 4125         strcpy(ttype, colptr->ttype);
 4126 
 4127     if (dtype)
 4128     {
 4129         if (colptr->tdatatype < 0)  /* add the "P" prefix for */
 4130             strcpy(dtype, "P");     /* variable length columns */
 4131         else
 4132             dtype[0] = 0;
 4133 
 4134         if      (abs(colptr->tdatatype) == TBIT)
 4135             strcat(dtype, "X");
 4136         else if (abs(colptr->tdatatype) == TBYTE)
 4137             strcat(dtype, "B");
 4138         else if (abs(colptr->tdatatype) == TLOGICAL)
 4139             strcat(dtype, "L");
 4140         else if (abs(colptr->tdatatype) == TSTRING)
 4141             strcat(dtype, "A");
 4142         else if (abs(colptr->tdatatype) == TSHORT)
 4143             strcat(dtype, "I");
 4144         else if (abs(colptr->tdatatype) == TLONG)
 4145             strcat(dtype, "J");
 4146         else if (abs(colptr->tdatatype) == TLONGLONG)
 4147             strcat(dtype, "K");
 4148         else if (abs(colptr->tdatatype) == TFLOAT)
 4149             strcat(dtype, "E");
 4150         else if (abs(colptr->tdatatype) == TDOUBLE)
 4151             strcat(dtype, "D");
 4152         else if (abs(colptr->tdatatype) == TCOMPLEX)
 4153             strcat(dtype, "C");
 4154         else if (abs(colptr->tdatatype) == TDBLCOMPLEX)
 4155             strcat(dtype, "M");
 4156     }
 4157 
 4158     if (repeat)
 4159         *repeat = colptr->trepeat;
 4160 
 4161     if (tscal)
 4162         *tscal  = colptr->tscale;
 4163 
 4164     if (tzero)
 4165         *tzero  = colptr->tzero;
 4166 
 4167     if (tnull)
 4168         *tnull  = colptr->tnull;
 4169 
 4170     /* read keywords to get additional parameters */
 4171 
 4172     if (tunit)
 4173     {
 4174         ffkeyn("TUNIT", colnum, name, status);
 4175         tstatus = 0;
 4176         *tunit = '\0';
 4177         ffgkys(fptr, name, tunit, comm, &tstatus);
 4178     }
 4179 
 4180     if (tdisp)
 4181     {
 4182         ffkeyn("TDISP", colnum, name, status);
 4183         tstatus = 0;
 4184         *tdisp = '\0';
 4185         ffgkys(fptr, name, tdisp, comm, &tstatus);
 4186     }
 4187 
 4188     return(*status);
 4189 }
 4190 /*--------------------------------------------------------------------------*/
 4191 int ffghdn(fitsfile *fptr,   /* I - FITS file pointer                      */
 4192             int *chdunum)    /* O - number of the CHDU; 1 = primary array  */
 4193 /*
 4194   Return the number of the Current HDU in the FITS file.  The primary array
 4195   is HDU number 1.  Note that this is one of the few cfitsio routines that
 4196   does not return the error status value as the value of the function.
 4197 */
 4198 {
 4199     *chdunum = (fptr->HDUposition) + 1;
 4200     return(*chdunum);
 4201 }
 4202 /*--------------------------------------------------------------------------*/
 4203 int ffghadll(fitsfile *fptr,     /* I - FITS file pointer                     */
 4204             LONGLONG *headstart, /* O - byte offset to beginning of CHDU      */
 4205             LONGLONG *datastart, /* O - byte offset to beginning of next HDU  */
 4206             LONGLONG *dataend,   /* O - byte offset to beginning of next HDU  */
 4207             int *status)         /* IO - error status     */
 4208 /*
 4209   Return the address (= byte offset) in the FITS file to the beginning of
 4210   the current HDU, the beginning of the data unit, and the end of the data unit.
 4211 */
 4212 {
 4213     if (*status > 0)
 4214         return(*status);
 4215 
 4216     /* reset position to the correct HDU if necessary */
 4217     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 4218     {
 4219         if (ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status) > 0)
 4220             return(*status);
 4221     }
 4222     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 4223     {
 4224         if (ffrdef(fptr, status) > 0)           /* rescan header */
 4225             return(*status);
 4226     }
 4227 
 4228     if (headstart)
 4229         *headstart = (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu];       
 4230 
 4231     if (datastart)
 4232         *datastart = (fptr->Fptr)->datastart;
 4233 
 4234     if (dataend)
 4235         *dataend = (fptr->Fptr)->headstart[((fptr->Fptr)->curhdu) + 1];       
 4236 
 4237     return(*status);
 4238 }
 4239 /*--------------------------------------------------------------------------*/
 4240 int ffghof(fitsfile *fptr,     /* I - FITS file pointer                     */
 4241             OFF_T *headstart,  /* O - byte offset to beginning of CHDU      */
 4242             OFF_T *datastart,  /* O - byte offset to beginning of next HDU  */
 4243             OFF_T *dataend,    /* O - byte offset to beginning of next HDU  */
 4244             int *status)       /* IO - error status     */
 4245 /*
 4246   Return the address (= byte offset) in the FITS file to the beginning of
 4247   the current HDU, the beginning of the data unit, and the end of the data unit.
 4248 */
 4249 {
 4250     if (*status > 0)
 4251         return(*status);
 4252 
 4253     /* reset position to the correct HDU if necessary */
 4254     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 4255     {
 4256         if (ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status) > 0)
 4257             return(*status);
 4258     }
 4259     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 4260     {
 4261         if (ffrdef(fptr, status) > 0)           /* rescan header */
 4262             return(*status);
 4263     }
 4264 
 4265     if (headstart)
 4266         *headstart = (OFF_T) (fptr->Fptr)->headstart[(fptr->Fptr)->curhdu];       
 4267 
 4268     if (datastart)
 4269         *datastart = (OFF_T) (fptr->Fptr)->datastart;
 4270 
 4271     if (dataend)
 4272         *dataend   = (OFF_T) (fptr->Fptr)->headstart[((fptr->Fptr)->curhdu) + 1];       
 4273 
 4274     return(*status);
 4275 }
 4276 /*--------------------------------------------------------------------------*/
 4277 int ffghad(fitsfile *fptr,     /* I - FITS file pointer                     */
 4278             long *headstart,  /* O - byte offset to beginning of CHDU      */
 4279             long *datastart,  /* O - byte offset to beginning of next HDU  */
 4280             long *dataend,    /* O - byte offset to beginning of next HDU  */
 4281             int *status)       /* IO - error status     */
 4282 /*
 4283   Return the address (= byte offset) in the FITS file to the beginning of
 4284   the current HDU, the beginning of the data unit, and the end of the data unit.
 4285 */
 4286 {
 4287     LONGLONG shead, sdata, edata;
 4288 
 4289     if (*status > 0)
 4290         return(*status);
 4291 
 4292     ffghadll(fptr, &shead, &sdata, &edata, status);
 4293 
 4294     if (headstart)
 4295     {
 4296         if (shead > LONG_MAX)
 4297             *status = NUM_OVERFLOW;
 4298         else
 4299             *headstart = (long) shead;
 4300     }
 4301 
 4302     if (datastart)
 4303     {
 4304         if (sdata > LONG_MAX)
 4305             *status = NUM_OVERFLOW;
 4306         else
 4307             *datastart = (long) sdata;
 4308     }
 4309 
 4310     if (dataend)
 4311     {
 4312         if (edata > LONG_MAX)
 4313             *status = NUM_OVERFLOW;
 4314         else
 4315             *dataend = (long) edata;       
 4316     }
 4317 
 4318     return(*status);
 4319 }
 4320 /*--------------------------------------------------------------------------*/
 4321 int ffrhdu(fitsfile *fptr,    /* I - FITS file pointer */
 4322            int *hdutype,      /* O - type of HDU       */
 4323            int *status)       /* IO - error status     */
 4324 /*
 4325   read the required keywords of the CHDU and initialize the corresponding
 4326   structure elements that describe the format of the HDU
 4327 */
 4328 {
 4329     int ii, tstatus;
 4330     char card[FLEN_CARD];
 4331     char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
 4332     char xname[FLEN_VALUE], *xtension, urltype[20];
 4333 
 4334     if (*status > 0)
 4335         return(*status);
 4336 
 4337     if (ffgrec(fptr, 1, card, status) > 0 )  /* get the 80-byte card */
 4338     {
 4339         ffpmsg("Cannot read first keyword in header (ffrhdu).");
 4340         return(*status);
 4341     }
 4342     strncpy(name,card,8);  /* first 8 characters = the keyword name */
 4343     name[8] = '\0';
 4344 
 4345     for (ii=7; ii >= 0; ii--)  /* replace trailing blanks with nulls */
 4346     {
 4347         if (name[ii] == ' ')
 4348             name[ii] = '\0';
 4349         else
 4350             break;
 4351     }
 4352 
 4353     if (ffpsvc(card, value, comm, status) > 0)   /* parse value and comment */
 4354     {
 4355         ffpmsg("Cannot read value of first  keyword in header (ffrhdu):");
 4356         ffpmsg(card);
 4357         return(*status);
 4358     }
 4359 
 4360     if (!strcmp(name, "SIMPLE"))        /* this is the primary array */
 4361     {
 4362 
 4363        ffpinit(fptr, status);           /* initialize the primary array */
 4364 
 4365        if (hdutype != NULL)
 4366            *hdutype = 0;
 4367     }
 4368 
 4369     else if (!strcmp(name, "XTENSION"))   /* this is an XTENSION keyword */
 4370     {
 4371         if (ffc2s(value, xname, status) > 0)  /* get the value string */
 4372         {
 4373             ffpmsg("Bad value string for XTENSION keyword:");
 4374             ffpmsg(value);
 4375             return(*status);
 4376         }
 4377 
 4378         xtension = xname;
 4379         while (*xtension == ' ')  /* ignore any leading spaces in name */
 4380            xtension++;
 4381 
 4382         if (!strcmp(xtension, "TABLE"))
 4383         {
 4384             ffainit(fptr, status);       /* initialize the ASCII table */
 4385             if (hdutype != NULL)
 4386                 *hdutype = 1;
 4387         }
 4388 
 4389         else if (!strcmp(xtension, "BINTABLE") ||
 4390                  !strcmp(xtension, "A3DTABLE") ||
 4391                  !strcmp(xtension, "3DTABLE") )
 4392         {
 4393             ffbinit(fptr, status);       /* initialize the binary table */
 4394             if (hdutype != NULL)
 4395                 *hdutype = 2;
 4396         }
 4397 
 4398         else
 4399         {
 4400             tstatus = 0;
 4401             ffpinit(fptr, &tstatus);       /* probably an IMAGE extension */
 4402 
 4403             if (tstatus == UNKNOWN_EXT && hdutype != NULL)
 4404                 *hdutype = -1;       /* don't recognize this extension type */
 4405             else
 4406             {
 4407                 *status = tstatus;
 4408                 if (hdutype != NULL)
 4409                     *hdutype = 0;
 4410             }
 4411         }
 4412     }
 4413 
 4414     else     /*  not the start of a new extension */
 4415     {
 4416         if (card[0] == 0  ||
 4417             card[0] == 10)     /* some editors append this character to EOF */
 4418         {           
 4419             *status = END_OF_FILE;
 4420         }
 4421         else
 4422         {
 4423           *status = UNKNOWN_REC;  /* found unknown type of record */
 4424           ffpmsg
 4425         ("Extension doesn't start with SIMPLE or XTENSION keyword. (ffrhdu)");
 4426         ffpmsg(card);
 4427         }
 4428     }
 4429 
 4430     /*  compare the starting position of the next HDU (if any) with the size */
 4431     /*  of the whole file to see if this is the last HDU in the file */
 4432 
 4433     if ((fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] < 
 4434         (fptr->Fptr)->logfilesize )
 4435     {
 4436         (fptr->Fptr)->lasthdu = 0;  /* no, not the last HDU */
 4437     }
 4438     else
 4439     {
 4440         (fptr->Fptr)->lasthdu = 1;  /* yes, this is the last HDU */
 4441 
 4442         /* special code for mem:// type files (FITS file in memory) */
 4443         /* Allocate enough memory to hold the entire HDU. */
 4444         /* Without this code, CFITSIO would repeatedly realloc  memory */
 4445         /* to incrementally increase the size of the file by 2880 bytes */
 4446         /* at a time, until it reached the final size */
 4447  
 4448         ffurlt(fptr, urltype, status);
 4449         if (!strcmp(urltype,"mem://") || !strcmp(urltype,"memkeep://"))
 4450         {
 4451             fftrun(fptr, (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1],
 4452                status);
 4453         }
 4454     }
 4455     return(*status);
 4456 }
 4457 /*--------------------------------------------------------------------------*/
 4458 int ffpinit(fitsfile *fptr,      /* I - FITS file pointer */
 4459            int *status)          /* IO - error status     */
 4460 /*
 4461   initialize the parameters defining the structure of the primary array
 4462   or an Image extension 
 4463 */
 4464 {
 4465     int groups, tstatus, simple, bitpix, naxis, extend, nspace;
 4466     int ttype = 0, bytlen = 0, ii, ntilebins;
 4467     long  pcount, gcount;
 4468     LONGLONG naxes[999], npix, blank;
 4469     double bscale, bzero;
 4470     char comm[FLEN_COMMENT];
 4471     tcolumn *colptr;
 4472 
 4473     if (*status > 0)
 4474         return(*status);
 4475 
 4476     /* reset position to the correct HDU if necessary */
 4477     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 4478         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 4479 
 4480     (fptr->Fptr)->hdutype = IMAGE_HDU; /* primary array or IMAGE extension  */
 4481     (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize;  /* set max size */
 4482 
 4483     groups = 0;
 4484     tstatus = *status;
 4485 
 4486     /* get all the descriptive info about this HDU */
 4487     ffgphd(fptr, 999, &simple, &bitpix, &naxis, naxes, &pcount, &gcount, 
 4488            &extend, &bscale, &bzero, &blank, &nspace, status);
 4489 
 4490     if (*status == NOT_IMAGE)
 4491         *status = tstatus;    /* ignore 'unknown extension type' error */
 4492     else if (*status > 0)
 4493         return(*status);
 4494 
 4495     /*
 4496        the logical end of the header is 80 bytes before the current position, 
 4497        minus any trailing blank keywords just before the END keyword.
 4498     */
 4499     (fptr->Fptr)->headend = (fptr->Fptr)->nextkey - (80 * (nspace + 1));
 4500 
 4501     /* the data unit begins at the beginning of the next logical block */
 4502     (fptr->Fptr)->datastart = (((fptr->Fptr)->nextkey - 80) / 2880 + 1)
 4503                               * 2880;
 4504 
 4505     if (naxis > 0 && naxes[0] == 0)  /* test for 'random groups' */
 4506     {
 4507         tstatus = 0;
 4508         ffmaky(fptr, 2, status);         /* reset to beginning of header */
 4509 
 4510         if (ffgkyl(fptr, "GROUPS", &groups, comm, &tstatus))
 4511             groups = 0;          /* GROUPS keyword not found */
 4512     }
 4513 
 4514     if (bitpix == BYTE_IMG)   /* test  bitpix and set the datatype code */
 4515     {
 4516         ttype=TBYTE;
 4517         bytlen=1;
 4518     }
 4519     else if (bitpix == SHORT_IMG)
 4520     {
 4521         ttype=TSHORT;
 4522         bytlen=2;
 4523     }
 4524     else if (bitpix == LONG_IMG)
 4525     {
 4526         ttype=TLONG;
 4527         bytlen=4;
 4528     }
 4529     else if (bitpix == LONGLONG_IMG)
 4530     {
 4531         ttype=TLONGLONG;
 4532         bytlen=8;
 4533     }
 4534     else if (bitpix == FLOAT_IMG)
 4535     {
 4536         ttype=TFLOAT;
 4537         bytlen=4;
 4538     }
 4539     else if (bitpix == DOUBLE_IMG)
 4540     {
 4541         ttype=TDOUBLE;
 4542         bytlen=8;
 4543     }
 4544         
 4545     /*   calculate the size of the primary array  */
 4546     (fptr->Fptr)->imgdim = naxis;
 4547     if (naxis == 0)
 4548     {
 4549         npix = 0;
 4550     }
 4551     else
 4552     {
 4553         if (groups)
 4554         {
 4555             npix = 1;  /* NAXIS1 = 0 is a special flag for 'random groups' */
 4556         }
 4557         else
 4558         {
 4559             npix = naxes[0];
 4560         }
 4561 
 4562         (fptr->Fptr)->imgnaxis[0] = naxes[0];
 4563         for (ii=1; ii < naxis; ii++)
 4564         {
 4565             npix = npix*naxes[ii];   /* calc number of pixels in the array */
 4566             (fptr->Fptr)->imgnaxis[ii] = naxes[ii];
 4567         }
 4568     }
 4569 
 4570     /*
 4571        now we know everything about the array; just fill in the parameters:
 4572        the next HDU begins in the next logical block after the data
 4573     */
 4574 
 4575     (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] =
 4576          (fptr->Fptr)->datastart + 
 4577          ( ((LONGLONG) pcount + npix) * bytlen * gcount + 2879) / 2880 * 2880;
 4578 
 4579     /*
 4580       initialize the fictitious heap starting address (immediately following
 4581       the array data) and a zero length heap.  This is used to find the
 4582       end of the data when checking the fill values in the last block. 
 4583     */
 4584     (fptr->Fptr)->heapstart = (npix + pcount) * bytlen * gcount;
 4585     (fptr->Fptr)->heapsize = 0;
 4586 
 4587     (fptr->Fptr)->compressimg = 0;  /* this is not a compressed image */
 4588 
 4589     if (naxis == 0)
 4590     {
 4591         (fptr->Fptr)->rowlength = 0;    /* rows have zero length */
 4592         (fptr->Fptr)->tfield = 0;       /* table has no fields   */
 4593 
 4594         /* free the tile-compressed image cache, if it exists */
 4595         if ((fptr->Fptr)->tilerow) {
 4596            ntilebins = 
 4597         (((fptr->Fptr)->znaxis[0] - 1) / ((fptr->Fptr)->tilesize[0])) + 1;
 4598 
 4599            for (ii = 0; ii < ntilebins; ii++) {
 4600              if ((fptr->Fptr)->tiledata[ii]) {
 4601            free((fptr->Fptr)->tiledata[ii]);
 4602              }
 4603 
 4604              if ((fptr->Fptr)->tilenullarray[ii]) {
 4605            free((fptr->Fptr)->tilenullarray[ii]);
 4606              }
 4607             }
 4608         
 4609         free((fptr->Fptr)->tileanynull);
 4610         free((fptr->Fptr)->tiletype);      
 4611         free((fptr->Fptr)->tiledatasize);
 4612         free((fptr->Fptr)->tilenullarray);
 4613         free((fptr->Fptr)->tiledata);
 4614         free((fptr->Fptr)->tilerow);
 4615 
 4616         (fptr->Fptr)->tileanynull = 0;
 4617         (fptr->Fptr)->tiletype = 0;    
 4618         (fptr->Fptr)->tiledatasize = 0;
 4619         (fptr->Fptr)->tilenullarray = 0;
 4620         (fptr->Fptr)->tiledata = 0;
 4621         (fptr->Fptr)->tilerow = 0;
 4622         }
 4623 
 4624         if ((fptr->Fptr)->tableptr)
 4625            free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */
 4626 
 4627         (fptr->Fptr)->tableptr = 0;     /* set a null table structure pointer */
 4628         (fptr->Fptr)->numrows = 0;
 4629         (fptr->Fptr)->origrows = 0;
 4630     }
 4631     else
 4632     {
 4633       /*
 4634         The primary array is actually interpreted as a binary table.  There
 4635         are two columns: the first column contains the group parameters if any.
 4636         The second column contains the primary array of data as a single vector
 4637         column element. In the case of 'random grouped' format, each group
 4638         is stored in a separate row of the table.
 4639       */
 4640         /* the number of rows is equal to the number of groups */
 4641         (fptr->Fptr)->numrows = gcount;
 4642         (fptr->Fptr)->origrows = gcount;
 4643 
 4644         (fptr->Fptr)->rowlength = (npix + pcount) * bytlen; /* total size */
 4645         (fptr->Fptr)->tfield = 2;  /* 2 fields: group params and the image */
 4646 
 4647         /* free the tile-compressed image cache, if it exists */
 4648         if ((fptr->Fptr)->tilerow) {
 4649 
 4650            ntilebins = 
 4651         (((fptr->Fptr)->znaxis[0] - 1) / ((fptr->Fptr)->tilesize[0])) + 1;
 4652 
 4653            for (ii = 0; ii < ntilebins; ii++) {
 4654              if ((fptr->Fptr)->tiledata[ii]) {
 4655            free((fptr->Fptr)->tiledata[ii]);
 4656              }
 4657 
 4658              if ((fptr->Fptr)->tilenullarray[ii]) {
 4659            free((fptr->Fptr)->tilenullarray[ii]);
 4660              }
 4661             }
 4662         
 4663         free((fptr->Fptr)->tileanynull);
 4664         free((fptr->Fptr)->tiletype);      
 4665         free((fptr->Fptr)->tiledatasize);
 4666         free((fptr->Fptr)->tilenullarray);
 4667         free((fptr->Fptr)->tiledata);
 4668         free((fptr->Fptr)->tilerow);
 4669 
 4670         (fptr->Fptr)->tileanynull = 0;
 4671         (fptr->Fptr)->tiletype = 0;    
 4672         (fptr->Fptr)->tiledatasize = 0;
 4673         (fptr->Fptr)->tilenullarray = 0;
 4674         (fptr->Fptr)->tiledata = 0;
 4675         (fptr->Fptr)->tilerow = 0;
 4676         }
 4677 
 4678         if ((fptr->Fptr)->tableptr)
 4679            free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */
 4680 
 4681         colptr = (tcolumn *) calloc(2, sizeof(tcolumn) ) ;
 4682 
 4683         if (!colptr)
 4684         {
 4685           ffpmsg
 4686           ("malloc failed to get memory for FITS array descriptors (ffpinit)");
 4687           (fptr->Fptr)->tableptr = 0;  /* set a null table structure pointer */
 4688           return(*status = ARRAY_TOO_BIG);
 4689         }
 4690 
 4691         /* copy the table structure address to the fitsfile structure */
 4692         (fptr->Fptr)->tableptr = colptr; 
 4693 
 4694         /* the first column represents the group parameters, if any */
 4695         colptr->tbcol = 0;
 4696         colptr->tdatatype = ttype;
 4697         colptr->twidth = bytlen;
 4698         colptr->trepeat = (LONGLONG) pcount;
 4699         colptr->tscale = 1.;
 4700         colptr->tzero = 0.;
 4701         colptr->tnull = blank;
 4702 
 4703         colptr++;  /* increment pointer to the second column */
 4704 
 4705         /* the second column represents the image array */
 4706         colptr->tbcol = pcount * bytlen; /* col starts after the group parms */
 4707         colptr->tdatatype = ttype; 
 4708         colptr->twidth = bytlen;
 4709         colptr->trepeat = npix;
 4710         colptr->tscale = bscale;
 4711         colptr->tzero = bzero;
 4712         colptr->tnull = blank;
 4713     }
 4714 
 4715     /* reset next keyword pointer to the start of the header */
 4716     (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu ];
 4717 
 4718     return(*status);
 4719 }
 4720 /*--------------------------------------------------------------------------*/
 4721 int ffainit(fitsfile *fptr,      /* I - FITS file pointer */
 4722             int *status)         /* IO - error status     */
 4723 {
 4724 /*
 4725   initialize the parameters defining the structure of an ASCII table 
 4726 */
 4727     int  ii, nspace, ntilebins;
 4728     long tfield;
 4729     LONGLONG pcount, rowlen, nrows, tbcoln;
 4730     tcolumn *colptr = 0;
 4731     char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
 4732     char message[FLEN_ERRMSG], errmsg[FLEN_ERRMSG];
 4733 
 4734     if (*status > 0)
 4735         return(*status);
 4736 
 4737     /* reset position to the correct HDU if necessary */
 4738     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 4739         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 4740 
 4741     (fptr->Fptr)->hdutype = ASCII_TBL;  /* set that this is an ASCII table */
 4742     (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize;  /* set max size */
 4743 
 4744     /* get table parameters and test that the header is a valid: */
 4745     if (ffgttb(fptr, &rowlen, &nrows, &pcount, &tfield, status) > 0)  
 4746        return(*status);
 4747 
 4748     if (pcount != 0)
 4749     {
 4750        ffpmsg("PCOUNT keyword not equal to 0 in ASCII table (ffainit).");
 4751        snprintf(errmsg, FLEN_ERRMSG,"  PCOUNT = %ld", (long) pcount);
 4752        ffpmsg(errmsg);
 4753        return(*status = BAD_PCOUNT);
 4754     }
 4755 
 4756     (fptr->Fptr)->rowlength = rowlen; /* store length of a row */
 4757     (fptr->Fptr)->tfield = tfield; /* store number of table fields in row */
 4758 
 4759      /* free the tile-compressed image cache, if it exists */
 4760      if ((fptr->Fptr)->tilerow) {
 4761 
 4762            ntilebins = 
 4763         (((fptr->Fptr)->znaxis[0] - 1) / ((fptr->Fptr)->tilesize[0])) + 1;
 4764 
 4765            for (ii = 0; ii < ntilebins; ii++) {
 4766              if ((fptr->Fptr)->tiledata[ii]) {
 4767            free((fptr->Fptr)->tiledata[ii]);
 4768              }
 4769 
 4770              if ((fptr->Fptr)->tilenullarray[ii]) {
 4771            free((fptr->Fptr)->tilenullarray[ii]);
 4772              }
 4773             }
 4774         
 4775         free((fptr->Fptr)->tileanynull);
 4776         free((fptr->Fptr)->tiletype);      
 4777         free((fptr->Fptr)->tiledatasize);
 4778         free((fptr->Fptr)->tilenullarray);
 4779         free((fptr->Fptr)->tiledata);
 4780         free((fptr->Fptr)->tilerow);
 4781 
 4782         (fptr->Fptr)->tileanynull = 0;
 4783         (fptr->Fptr)->tiletype = 0;    
 4784         (fptr->Fptr)->tiledatasize = 0;
 4785         (fptr->Fptr)->tilenullarray = 0;
 4786         (fptr->Fptr)->tiledata = 0;
 4787         (fptr->Fptr)->tilerow = 0;
 4788      }
 4789 
 4790     if ((fptr->Fptr)->tableptr)
 4791        free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */
 4792 
 4793     /* mem for column structures ; space is initialized = 0 */
 4794     if (tfield > 0)
 4795     {
 4796       colptr = (tcolumn *) calloc(tfield, sizeof(tcolumn) );
 4797       if (!colptr)
 4798       {
 4799         ffpmsg
 4800         ("malloc failed to get memory for FITS table descriptors (ffainit)");
 4801         (fptr->Fptr)->tableptr = 0;  /* set a null table structure pointer */
 4802         return(*status = ARRAY_TOO_BIG);
 4803       }
 4804     }
 4805 
 4806     /* copy the table structure address to the fitsfile structure */
 4807     (fptr->Fptr)->tableptr = colptr; 
 4808 
 4809     /*  initialize the table field parameters */
 4810     for (ii = 0; ii < tfield; ii++, colptr++)
 4811     {
 4812         colptr->ttype[0] = '\0';  /* null column name */
 4813         colptr->tscale = 1.;
 4814         colptr->tzero  = 0.;
 4815         colptr->strnull[0] = ASCII_NULL_UNDEFINED;  /* null value undefined */
 4816         colptr->tbcol = -1;          /* initialize to illegal value */
 4817         colptr->tdatatype = -9999;   /* initialize to illegal value */
 4818     }
 4819 
 4820     /*
 4821       Initialize the fictitious heap starting address (immediately following
 4822       the table data) and a zero length heap.  This is used to find the
 4823       end of the table data when checking the fill values in the last block. 
 4824       There is no special data following an ASCII table.
 4825     */
 4826     (fptr->Fptr)->numrows = nrows;
 4827     (fptr->Fptr)->origrows = nrows;
 4828     (fptr->Fptr)->heapstart = rowlen * nrows;
 4829     (fptr->Fptr)->heapsize = 0;
 4830 
 4831     (fptr->Fptr)->compressimg = 0;  /* this is not a compressed image */
 4832 
 4833     /* now search for the table column keywords and the END keyword */
 4834 
 4835     for (nspace = 0, ii = 8; 1; ii++)  /* infinite loop  */
 4836     {
 4837         ffgkyn(fptr, ii, name, value, comm, status);
 4838 
 4839         /* try to ignore minor syntax errors */
 4840         if (*status == NO_QUOTE)
 4841         {
 4842             strcat(value, "'");
 4843             *status = 0;
 4844         }
 4845         else if (*status == BAD_KEYCHAR)
 4846         {
 4847             *status = 0;
 4848         }
 4849 
 4850         if (*status == END_OF_FILE)
 4851         {
 4852             ffpmsg("END keyword not found in ASCII table header (ffainit).");
 4853             return(*status = NO_END);
 4854         }
 4855         else if (*status > 0)
 4856             return(*status);
 4857 
 4858         else if (name[0] == 'T')   /* keyword starts with 'T' ? */
 4859             ffgtbp(fptr, name, value, status); /* test if column keyword */
 4860 
 4861         else if (!FSTRCMP(name, "END"))  /* is this the END keyword? */
 4862             break;
 4863 
 4864         if (!name[0] && !value[0] && !comm[0])  /* a blank keyword? */
 4865             nspace++;
 4866 
 4867         else
 4868             nspace = 0;
 4869     }
 4870 
 4871     /* test that all required keywords were found and have legal values */
 4872     colptr = (fptr->Fptr)->tableptr;
 4873     for (ii = 0; ii < tfield; ii++, colptr++)
 4874     {
 4875         tbcoln = colptr->tbcol;  /* the starting column number (zero based) */
 4876 
 4877         if (colptr->tdatatype == -9999)
 4878         {
 4879             ffkeyn("TFORM", ii+1, name, status);  /* construct keyword name */
 4880             snprintf(message,FLEN_ERRMSG,"Required %s keyword not found (ffainit).", name);
 4881             ffpmsg(message);
 4882             return(*status = NO_TFORM);
 4883         }
 4884 
 4885         else if (tbcoln == -1)
 4886         {
 4887             ffkeyn("TBCOL", ii+1, name, status); /* construct keyword name */
 4888             snprintf(message,FLEN_ERRMSG,"Required %s keyword not found (ffainit).", name);
 4889             ffpmsg(message);
 4890             return(*status = NO_TBCOL);
 4891         }
 4892 
 4893         else if ((fptr->Fptr)->rowlength != 0 && 
 4894                 (tbcoln < 0 || tbcoln >= (fptr->Fptr)->rowlength ) )
 4895         {
 4896             ffkeyn("TBCOL", ii+1, name, status);  /* construct keyword name */
 4897             snprintf(message,FLEN_ERRMSG,"Value of %s keyword out of range: %ld (ffainit).",
 4898             name, (long) tbcoln);
 4899             ffpmsg(message);
 4900             return(*status = BAD_TBCOL);
 4901         }
 4902 
 4903         else if ((fptr->Fptr)->rowlength != 0 && 
 4904                  tbcoln + colptr->twidth > (fptr->Fptr)->rowlength )
 4905         {
 4906             snprintf(message,FLEN_ERRMSG,"Column %d is too wide to fit in table (ffainit)",
 4907             ii+1);
 4908             ffpmsg(message);
 4909             snprintf(message, FLEN_ERRMSG," TFORM = %s and NAXIS1 = %ld",
 4910                     colptr->tform, (long) (fptr->Fptr)->rowlength);
 4911             ffpmsg(message);
 4912             return(*status = COL_TOO_WIDE);
 4913         }
 4914     }
 4915 
 4916     /*
 4917       now we know everything about the table; just fill in the parameters:
 4918       the 'END' record is 80 bytes before the current position, minus
 4919       any trailing blank keywords just before the END keyword.
 4920     */
 4921     (fptr->Fptr)->headend = (fptr->Fptr)->nextkey - (80 * (nspace + 1));
 4922  
 4923     /* the data unit begins at the beginning of the next logical block */
 4924     (fptr->Fptr)->datastart = (((fptr->Fptr)->nextkey - 80) / 2880 + 1) 
 4925                               * 2880;
 4926 
 4927     /* the next HDU begins in the next logical block after the data  */
 4928     (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] =
 4929          (fptr->Fptr)->datastart +
 4930          ( ((LONGLONG)rowlen * nrows + 2879) / 2880 * 2880 );
 4931 
 4932     /* reset next keyword pointer to the start of the header */
 4933     (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu ];
 4934 
 4935     return(*status);
 4936 }
 4937 /*--------------------------------------------------------------------------*/
 4938 int ffbinit(fitsfile *fptr,     /* I - FITS file pointer */
 4939             int *status)        /* IO - error status     */
 4940 {
 4941 /*
 4942   initialize the parameters defining the structure of a binary table 
 4943 */
 4944     int  ii, nspace, ntilebins;
 4945     long tfield;
 4946     LONGLONG pcount, rowlen, nrows, totalwidth;
 4947     tcolumn *colptr = 0;
 4948     char name[FLEN_KEYWORD], value[FLEN_VALUE], comm[FLEN_COMMENT];
 4949     char message[FLEN_ERRMSG];
 4950 
 4951     if (*status > 0)
 4952         return(*status);
 4953 
 4954     /* reset position to the correct HDU if necessary */
 4955     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 4956         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 4957 
 4958     (fptr->Fptr)->hdutype = BINARY_TBL;  /* set that this is a binary table */
 4959     (fptr->Fptr)->headend = (fptr->Fptr)->logfilesize;  /* set max size */
 4960 
 4961     /* get table parameters and test that the header is valid: */
 4962     if (ffgttb(fptr, &rowlen, &nrows, &pcount, &tfield, status) > 0)
 4963        return(*status);
 4964 
 4965     (fptr->Fptr)->rowlength =  rowlen; /* store length of a row */
 4966     (fptr->Fptr)->tfield = tfield; /* store number of table fields in row */
 4967 
 4968      /* free the tile-compressed image cache, if it exists */
 4969      if ((fptr->Fptr)->tilerow) {
 4970 
 4971            ntilebins = 
 4972         (((fptr->Fptr)->znaxis[0] - 1) / ((fptr->Fptr)->tilesize[0])) + 1;
 4973 
 4974            for (ii = 0; ii < ntilebins; ii++) {
 4975              if ((fptr->Fptr)->tiledata[ii]) {
 4976            free((fptr->Fptr)->tiledata[ii]);
 4977              }
 4978 
 4979              if ((fptr->Fptr)->tilenullarray[ii]) {
 4980            free((fptr->Fptr)->tilenullarray[ii]);
 4981              }
 4982             }
 4983         
 4984         free((fptr->Fptr)->tileanynull);
 4985         free((fptr->Fptr)->tiletype);      
 4986         free((fptr->Fptr)->tiledatasize);
 4987         free((fptr->Fptr)->tilenullarray);
 4988         free((fptr->Fptr)->tiledata);
 4989         free((fptr->Fptr)->tilerow);
 4990 
 4991         (fptr->Fptr)->tileanynull = 0;
 4992         (fptr->Fptr)->tiletype = 0;    
 4993         (fptr->Fptr)->tiledatasize = 0;
 4994         (fptr->Fptr)->tilenullarray = 0;
 4995         (fptr->Fptr)->tiledata = 0;
 4996         (fptr->Fptr)->tilerow = 0;
 4997      }
 4998 
 4999     if ((fptr->Fptr)->tableptr)
 5000        free((fptr->Fptr)->tableptr); /* free memory for the old CHDU */
 5001 
 5002     /* mem for column structures ; space is initialized = 0  */
 5003     if (tfield > 0)
 5004     {
 5005       colptr = (tcolumn *) calloc(tfield, sizeof(tcolumn) );
 5006       if (!colptr)
 5007       {
 5008         ffpmsg
 5009         ("malloc failed to get memory for FITS table descriptors (ffbinit)");
 5010         (fptr->Fptr)->tableptr = 0;  /* set a null table structure pointer */
 5011         return(*status = ARRAY_TOO_BIG);
 5012       }
 5013     }
 5014 
 5015     /* copy the table structure address to the fitsfile structure */
 5016     (fptr->Fptr)->tableptr = colptr; 
 5017 
 5018     /* initialize the table field parameters */
 5019     for (ii = 0; ii < tfield; ii++, colptr++)
 5020     {
 5021         colptr->ttype[0] = '\0';  /* null column name */
 5022         colptr->tscale = 1.;
 5023         colptr->tzero  = 0.;
 5024         colptr->tnull  = NULL_UNDEFINED; /* (integer) null value undefined */
 5025         colptr->tdatatype = -9999;   /* initialize to illegal value */
 5026         colptr->trepeat = 1;
 5027         colptr->strnull[0] = '\0'; /* for ASCII string columns (TFORM = rA) */
 5028     }
 5029 
 5030     /*
 5031       Initialize the heap starting address (immediately following
 5032       the table data) and the size of the heap.  This is used to find the
 5033       end of the table data when checking the fill values in the last block. 
 5034     */
 5035     (fptr->Fptr)->numrows = nrows;
 5036     (fptr->Fptr)->origrows = nrows;
 5037     (fptr->Fptr)->heapstart = rowlen * nrows;
 5038     (fptr->Fptr)->heapsize = pcount;
 5039 
 5040     (fptr->Fptr)->compressimg = 0;  /* initialize as not a compressed image */
 5041 
 5042     /* now search for the table column keywords and the END keyword */
 5043 
 5044     for (nspace = 0, ii = 8; 1; ii++)  /* infinite loop  */
 5045     {
 5046         ffgkyn(fptr, ii, name, value, comm, status);
 5047 
 5048         /* try to ignore minor syntax errors */
 5049         if (*status == NO_QUOTE)
 5050         {
 5051             strcat(value, "'");
 5052             *status = 0;
 5053         }
 5054         else if (*status == BAD_KEYCHAR)
 5055         {
 5056             *status = 0;
 5057         }
 5058 
 5059         if (*status == END_OF_FILE)
 5060         {
 5061             ffpmsg("END keyword not found in binary table header (ffbinit).");
 5062             return(*status = NO_END);
 5063         }
 5064         else if (*status > 0)
 5065             return(*status);
 5066 
 5067         else if (name[0] == 'T')   /* keyword starts with 'T' ? */
 5068             ffgtbp(fptr, name, value, status); /* test if column keyword */
 5069 
 5070         else if (!FSTRCMP(name, "ZIMAGE"))
 5071         {
 5072             if (value[0] == 'T')
 5073                 (fptr->Fptr)->compressimg = 1; /* this is a compressed image */
 5074         }
 5075         else if (!FSTRCMP(name, "END"))  /* is this the END keyword? */
 5076             break;
 5077 
 5078 
 5079         if (!name[0] && !value[0] && !comm[0])  /* a blank keyword? */
 5080             nspace++;
 5081 
 5082         else
 5083             nspace = 0; /* reset number of consecutive spaces before END */
 5084     }
 5085 
 5086     /* test that all the required keywords were found and have legal values */
 5087     colptr = (fptr->Fptr)->tableptr;  /* set pointer to first column */
 5088 
 5089     for (ii = 0; ii < tfield; ii++, colptr++)
 5090     {
 5091         if (colptr->tdatatype == -9999)
 5092         {
 5093             ffkeyn("TFORM", ii+1, name, status);  /* construct keyword name */
 5094             snprintf(message,FLEN_ERRMSG,"Required %s keyword not found (ffbinit).", name);
 5095             ffpmsg(message);
 5096             return(*status = NO_TFORM);
 5097         }
 5098     }
 5099 
 5100     /*
 5101       now we know everything about the table; just fill in the parameters:
 5102       the 'END' record is 80 bytes before the current position, minus
 5103       any trailing blank keywords just before the END keyword.
 5104     */
 5105 
 5106     (fptr->Fptr)->headend = (fptr->Fptr)->nextkey - (80 * (nspace + 1));
 5107  
 5108     /* the data unit begins at the beginning of the next logical block */
 5109     (fptr->Fptr)->datastart = (((fptr->Fptr)->nextkey - 80) / 2880 + 1) 
 5110                               * 2880;
 5111 
 5112     /* the next HDU begins in the next logical block after the data  */
 5113     (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu + 1] = 
 5114          (fptr->Fptr)->datastart +
 5115      ( ((fptr->Fptr)->heapstart + (fptr->Fptr)->heapsize + 2879) / 2880 * 2880 );
 5116 
 5117     /* determine the byte offset to the beginning of each column */
 5118     ffgtbc(fptr, &totalwidth, status);
 5119 
 5120     if (totalwidth != rowlen)
 5121     {
 5122         snprintf(message,FLEN_ERRMSG,
 5123         "NAXIS1 = %ld is not equal to the sum of column widths: %ld", 
 5124         (long) rowlen, (long) totalwidth);
 5125         ffpmsg(message);
 5126         *status = BAD_ROW_WIDTH;
 5127     }
 5128 
 5129     /* reset next keyword pointer to the start of the header */
 5130     (fptr->Fptr)->nextkey = (fptr->Fptr)->headstart[ (fptr->Fptr)->curhdu ];
 5131 
 5132     if ( (fptr->Fptr)->compressimg == 1) /*  Is this a compressed image */
 5133         imcomp_get_compressed_image_par(fptr, status);
 5134 
 5135     return(*status);
 5136 }
 5137 /*--------------------------------------------------------------------------*/
 5138 int ffgabc(int tfields,     /* I - number of columns in the table           */
 5139            char **tform,    /* I - value of TFORMn keyword for each column  */
 5140            int space,       /* I - number of spaces to leave between cols   */
 5141            long *rowlen,    /* O - total width of a table row               */
 5142            long *tbcol,     /* O - starting byte in row for each column     */
 5143            int *status)     /* IO - error status                            */
 5144 /*
 5145   calculate the starting byte offset of each column of an ASCII table
 5146   and the total length of a row, in bytes.  The input space value determines
 5147   how many blank spaces to leave between each column (1 is recommended).
 5148 */
 5149 {
 5150     int ii, datacode, decims;
 5151     long width;
 5152 
 5153     if (*status > 0)
 5154         return(*status);
 5155 
 5156     *rowlen=0;
 5157 
 5158     if (tfields <= 0)
 5159         return(*status);
 5160 
 5161     tbcol[0] = 1;
 5162 
 5163     for (ii = 0; ii < tfields; ii++)
 5164     {
 5165         tbcol[ii] = *rowlen + 1;    /* starting byte in row of column */
 5166 
 5167         ffasfm(tform[ii], &datacode, &width, &decims, status);
 5168 
 5169         *rowlen += (width + space);  /* total length of row */
 5170     }
 5171 
 5172     *rowlen -= space;  /*  don't add space after the last field */
 5173 
 5174     return (*status);
 5175 }
 5176 /*--------------------------------------------------------------------------*/
 5177 int ffgtbc(fitsfile *fptr,    /* I - FITS file pointer          */
 5178            LONGLONG *totalwidth,  /* O - total width of a table row */
 5179            int *status)       /* IO - error status              */
 5180 {
 5181 /*
 5182   calculate the starting byte offset of each column of a binary table.
 5183   Use the values of the datatype code and repeat counts in the
 5184   column structure. Return the total length of a row, in bytes.
 5185 */
 5186     int tfields, ii;
 5187     LONGLONG nbytes;
 5188     tcolumn *colptr;
 5189     char message[FLEN_ERRMSG], *cptr;
 5190 
 5191     if (*status > 0)
 5192         return(*status);
 5193 
 5194     /* reset position to the correct HDU if necessary */
 5195     if (fptr->HDUposition != (fptr->Fptr)->curhdu)
 5196         ffmahd(fptr, (fptr->HDUposition) + 1, NULL, status);
 5197     else if ((fptr->Fptr)->datastart == DATA_UNDEFINED)
 5198         if ( ffrdef(fptr, status) > 0)               /* rescan header */
 5199             return(*status);
 5200 
 5201     tfields = (fptr->Fptr)->tfield;
 5202     colptr = (fptr->Fptr)->tableptr;  /* point to first column structure */
 5203 
 5204     *totalwidth = 0;
 5205 
 5206     for (ii = 0; ii < tfields; ii++, colptr++)
 5207     {
 5208         colptr->tbcol = *totalwidth;  /* byte offset in row to this column */
 5209 
 5210         if (colptr->tdatatype == TSTRING)
 5211         {
 5212             nbytes =  colptr->trepeat;   /* one byte per char */
 5213         }
 5214         else if (colptr->tdatatype == TBIT)
 5215         {
 5216             nbytes = ( colptr->trepeat + 7) / 8;
 5217         }
 5218         else if (colptr->tdatatype > 0)
 5219         {
 5220             nbytes =  colptr->trepeat * (colptr->tdatatype / 10);
 5221         }
 5222         else  {
 5223     
 5224       cptr = colptr->tform;
 5225       while (isdigit(*cptr)) cptr++;
 5226     
 5227       if (*cptr == 'P')  
 5228        /* this is a 'P' variable length descriptor (neg. tdatatype) */
 5229             nbytes = colptr->trepeat * 8;
 5230       else if (*cptr == 'Q') 
 5231        /* this is a 'Q' variable length descriptor (neg. tdatatype) */
 5232             nbytes = colptr->trepeat * 16;
 5233 
 5234       else {
 5235         snprintf(message,FLEN_ERRMSG,
 5236         "unknown binary table column type: %s", colptr->tform);
 5237         ffpmsg(message);
 5238         *status = BAD_TFORM;
 5239         return(*status);
 5240       }
 5241     }
 5242 
 5243        *totalwidth = *totalwidth + nbytes;
 5244     }
 5245     return(*status);
 5246 }
 5247 /*--------------------------------------------------------------------------*/
 5248 int ffgtbp(fitsfile *fptr,     /* I - FITS file pointer   */
 5249            char *name,         /* I - name of the keyword */
 5250            char *value,        /* I - value string of the keyword */
 5251            int *status)        /* IO - error status       */
 5252 {
 5253 /*
 5254   Get TaBle Parameter.  The input keyword name begins with the letter T.
 5255   Test if the keyword is one of the table column definition keywords
 5256   of an ASCII or binary table. If so, decode it and update the value 
 5257   in the structure.
 5258 */
 5259     int tstatus, datacode, decimals;
 5260     long width, repeat, nfield, ivalue;
 5261     LONGLONG jjvalue;
 5262     double dvalue;
 5263     char tvalue[FLEN_VALUE], *loc;
 5264     char message[FLEN_ERRMSG];
 5265     tcolumn *