/* @(#)fitsckw.c	17.1.1.1 (ESO-IPG) 01/25/02 17:50:05 */
/*===========================================================================
  Copyright (C) 1995 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.COPYRIGHT (c)  1996  European Southern Observatory
.IDENT     fitsckw.c
.LAUGUAGE  C
.AUTHOR    P.Grosbol   ESO/IPG
.KEYWORDS  FITS, check keyword, classify
.COMMENT   classify a FITS keyword
.VERSION   1.0  1988-Dec-10 : Creation,   PJG 
.VERSION   1.1  1989-Feb-24 : Upgrade for B-tables,   PJG 
.VERSION   1.2  1989-Apr-14 : Omit wrong keywords,   PJG 
.VERSION   1.3  1989-Sep-28 : Correct string type 'C'->'S', PJG 
.VERSION   1.4  1989-Oct-17 : Convert real to int in KEYWORD, PJG 
.VERSION   1.45 1989-Oct-23 : Upgrade for RGROUPS format, PJG 
.VERSION   1.50 1989-Dec-21 : Check FORTRAN formats, PJG 
.VERSION   1.60 1990-Feb-05 : Data format conversion of keyword, PJG 
.VERSION   1.61 1990-Feb-15 : Include exposure time, PJG 
.VERSION   1.7  1990-Feb-26 : Restructure MIDAS desc. decode, PJG 
.VERSION   1.8  1990-Mar-21 : Remove special char. in names, PJG 
.VERSION   1.85 1990-May-23 : Correct error in desc. name check, PJG 
.VERSION   1.87 1990-Oct-24 : Introduce HIERARCH keywords, PJG 
.VERSION   1.9  1990-Nov-11 : New-line at end of comments, PJG 
.VERSION   1.95 1991-Feb-15 : Correct random parm. check, PJG
.VERSION   2.0  1991-Mar-05 : Change structure and externals, PJG 
.VERSION   2.1  1991-Mar-23 : Include MIDASFTP + table NULL, PJG 
.VERSION   2.15 1991-Jun-05 : Correct keyword type error, PJG 
.VERSION   2.20 1991-Jul-12 : Only warning for axis excess, PJG 
.VERSION   2.25 1991-Sep-23 : Add new field types for BINTALBE, PJG 
.VERSION   2.30 1992-Feb-20 : Check for numbers in keywords, PJG 
.VERSION   2.35 1992-Aug-12 : Allow 1<PCOUNT for BINTABLE and UNKNOW, PJG 
.VERSION   2.40 1992-Aug-13 : Include IMAGE extension, PJG 
.VERSION   2.45 1993-Mar-16 : Change TMEND/EXPTIME processing, PJG 
.VERSION   2.50 1993-Apr-01 : Move decoding of MIDAS descriptors, PJG 
.VERSION   2.55 1993-Jul-05 : Save keyword comment in descriptors, PJG 
.VERSION   2.60 1993-Aug-18 : Add error message for hierach-keyword, PJG 
.VERSION   2.65 1993-Sep-13 : Check for null comment string, PJG 
.VERSION   2.70 1993-Oct-12 : Only HIERARCH if defined as one, PJG 
.VERSION   2.75 1993-Oct-26 : Update for new SC/TC + prototypes, PJG 
.VERSION   2.80 1993-Dec-13 : Disable SC error for descriptors, PJG 
.VERSION   2.85 1994-Jan-11 : Check for zero length history, PJG 
.VERSION   2.90 1994-Jun-28 : Get UT from MJD, PJG 
.VERSION   2.95 1994-Sep-04 : Change names of PSCAL,PZERO,PTYPE, PJG 
.VERSION   3.00 1995-Feb-16 : Force GCOUNT>0 for none RG-format, PJG 
.VERSION   3.10 1996-Oct-22 : Change allowed char. and 'fitshkw' call, PJG 
---------------------------------------------------------------------*/
#include   <math.h>
#include   <osparms.h>
#include   <fitsfmt.h>
#include   <fitsdef.h>
#include   <fitskwbb.h>
#include   <fitskwt.h>
#include   <midas_def.h>

static     int         mdcnt;    /* MIDAS descriptor card count      */
static     int         mds;
static     double      tmstart;
static     ADEF        *adef;
static     PDEF        *pdef;
static     TXDEF       *txdef;
static     FDEF        *fdef;

#ifdef __STDC__
int fitsckww(int mfd , BFDEF * bfdef , int htype , KWORD * kw , char fmt , char hist)
#else
int fitsckww(mfd,bfdef,htype,kw,fmt,hist)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       classify and store FITS keyword
.RETURN        keyword type - 0:END, -1:not found, -2:error
---------------------------------------------------------------------*/
int        mfd;                 /* IN:  MIDAS file descriptor        */
BFDEF      *bfdef;              /* OUT: Basic FITS definitions       */
int        htype;               /* IN:  type of FITS header          */
KWORD      *kw;                 /* IN:  keyword structure            */
char       fmt;                 /* IN:  file format, No/Orig/Fp      */
char       hist;                /* IN:  history flag  No/Crypt/Yes   */
#endif
{
  char       c, *ps, *pc, line[80], *punit;
  int        ktype, n, m, i, k, found, null, err;
  int        unit[4];
  float      f;
  double     d;
  KWDEF      *kwd, ndkw;
  TXDEF      *hdr_tbl();

  kwd = bkw; found = 0; ktype = -1;
  while (kwd->kw) {               /* compare with basic keyword list */
     if (found=kwcmp(kw->kw,kwd->kw)) {
       oscopy((char *)&ndkw,(char *)kwd,sizeof(KWDEF));
       break;
     }
     kwd++;
   }
  if (!found) {                   /* not found - check other lists   */
     kwd = (KWDEF *) 0;
     switch (htype) {
	case IMAGE  : break;
	case ATABLE :
	case BTABLE : kwd = tkw; break;
     }
     if (kwd)  
	while (kwd->kw) {         /* compare with other lists        */
	  if (found=kwcmp(kw->kw,kwd->kw)) {
	    oscopy((char *)&ndkw,(char *)kwd,sizeof(KWDEF));
	    break;
	  }
           kwd++;
        }
     if (!found) {                /* not found in any list           */
        ndkw.kw = kw->kw;
	ndkw.group = WDESC; ndkw.type = '\0';
        ndkw.fmt = 'N'; ndkw.action = 0;
	ndkw.idx = (kw->fmt=='C') ? -1 : 1;
	ndkw.fac = 1.0; ndkw.unit = (char *) 0; 
        ndkw.desc = kw->kw; pc = kw->kw;  /* convert to legal name  */
        while (c = *pc)
           *pc++ = (('A'<=c && c<='Z') || ('0'<=c && c<='9') ||
                    ('a'<=c && c<='z') || c=='_' || c=='-' || c==' ') ? c : '_';
      }
   }
  kwd = &ndkw;
  if (kwd->group==WDESC && kwd->action==HIERARCH) {
     i = (hist == 'C');
     if (fitshkw(kw,kwd,i)) {
	sprintf(line,"Warning: hierachical keyword not known!");
	SCTPUT(line); return 1;
      }
   }
  if (!(kwd->type))
    switch (kw->fmt) {
       case 'L'  :
       case 'I'  : kwd->type = 'I'; break;
       case 'X'  :
       case 'R'  : kwd->type = 'D'; break;
       case 'C'  :
       case 'S'  : kwd->type = 'S'; break;
       }

  if (kwd->group==WDESC &&               /* skip blank keyword cards */
      kw->fmt=='C' && !(*kw->val.pc) && !(mds && mdcnt)) return 1;

  if (fitstkw(kw,kwd->fmt)) {            /* convert data format      */
     sprintf(line,"Warning: Inconsistent data types [%c-%c] for >%s< !",
                    kwd->fmt,kw->fmt,kw->kw);
            SCTPUT(line); return 1;
  }
  ktype = 1;

  switch (kwd->group) {           /* goto keyword group for action   */
     case NOACT : break;
     case BFCTL :
          if (kw->kno && bfdef->naxis<kw->kno && *(kw->kw)!='P') {
	    SCTPUT("Warnning: axis index larger than dimension!");
	    ktype = -1; break;
          }
          n = kw->kno - 1;
          switch (kwd->action) {
             case BITPIX   : 
                  bfdef->bitpix = kw->val.i;
		  mds = 0; tmstart = -1.0;
                  break;
             case NAXIS    :
                  if (n<0) {
                     bfdef->naxis = kw->val.i;
                     if ((htype==BFITS || htype==RGROUP || htype==IMAGE) &&
			 fmt!='N') bfdef->cflag = 0;
                     if (MXDIM<bfdef->naxis) {
		        SCTPUT("Max. NAXIS exceeded!");
		        return -2;
                     }
		     adef = bfdef->data;
		     pdef = bfdef->parm;
                  }
                  else {
	             if (htype==RGROUP) n--;
                     adef[n].naxis = kw->val.i;
                  }
                  break;
             case CRVAL    :
	          if (htype==RGROUP) n--;
                  adef[n].crval = kw->val.d[0];
                  break;
             case CRPIX    :
	          if (htype==RGROUP) n--;
                  adef[n].crpix = kw->val.d[0];
                  break;
             case CDELT    :
	          if (htype==RGROUP) n--;
                  adef[n].cdelt = kw->val.d[0];
                  break;
             case CTYPE    :
	          if (htype==RGROUP) n--;
		  pc = kw->val.pc; ps = adef[n].ctype; i = MXS;
		  while (--i && (*ps++ = *pc++)); *ps = '\0';
                  break;
             case CROTA    :
	          if (htype==RGROUP) n--;
                  adef[n].crota = kw->val.d[0];
                  break;
             case BSCALE   :
                  bfdef->bscale = kw->val.d[0];
                  bfdef->sflag = bfdef->sflag || (bfdef->bscale != 1.0);
                  break;
             case BZERO    :
                  bfdef->bzero = kw->val.d[0];
                  bfdef->sflag = bfdef->sflag || (bfdef->bzero != 0.0);
                  break;
             case BUNIT    :
		  pc = kw->val.pc; ps = bfdef->bunit; i = MXS;
		  while (--i && (*ps++ = *pc++)); *ps = '\0';
                  break;
             case BLANK    :
                  bfdef->blank = kw->val.i; bfdef->bflag = 1;
                  break;
             case PCOUNT   :
                  bfdef->pcount = kw->val.i;
                  bfdef->kwflag |= 1;
                  if (htype==RGROUP && MXPAR<bfdef->pcount) {
		     SCTPUT("Error: Max. PCOUNT exceeded!");
		     return -2;
                  }
		  if (htype!=RGROUP && htype!=BTABLE && bfdef->pcount!=0)
		    SCTPUT("Warning: PCOUNT not zero!");
                  break;
             case GCOUNT   :
                  bfdef->gcount = kw->val.i;
                  bfdef->kwflag |= 2;
		  if (htype!=RGROUP && bfdef->gcount!=1) {
		     if (bfdef->gcount<1) {
			SCTPUT("Warning: GCOUNT < 1, changed to 1!");
			bfdef->gcount = 1;
		      }
		     else SCTPUT("Warning: GCOUNT greater than one!");
		   }
                  break;
             case RGPTYPE  :
		  pc = kw->val.pc; ps = pdef[n].ptype; i = MXS;
		  while (--i && (*ps++ = *pc++)); *ps = '\0';
                  break;
             case RGPSCAL  :
                  pdef[n].pscal = kw->val.d[0];
                  break;
             case RGPZERO  :
                  pdef[n].pzero = kw->val.d[0];
                  break;
             case EXTNAME  :
		  pc = kw->val.pc; ps = bfdef->extname; i = MXS;
		  while (--i && (*ps++ = *pc++)); *ps = '\0';
                  break;
             case OBJECT   :
		  pc = kw->val.pc; ps = bfdef->ident; i = MXIDNT;
		  while (--i && (*ps++ = *pc++)); *ps = '\0';
                  break;
             case EXTVER   :
                  bfdef->extver = kw->val.i;
                  break;
             case EXTLEVEL :
                  bfdef->extlevel = kw->val.i;
                  break;
             case EXTEND :
                  bfdef->xflag = kw->val.i;
                  break;
             case MIDASFTP :
                  if (!strncmp(kw->val.pc,"IMAGE",5))
		    bfdef->mtype = F_IMA_TYPE;
                  else if (!strncmp(kw->val.pc,"TABLE",5))
		    bfdef->mtype = F_TBL_TYPE;
                  else if (!strncmp(kw->val.pc,"FIT",3)) {
		    bfdef->mtype = F_FIT_TYPE;
		    bfdef->cflag = 1;
		  }
                  break;
             case DATAMIN  :
                  bfdef->dmin = kw->val.d[0];
                  bfdef->mflag |= 1;
	          break;
             case DATAMAX  :
                  bfdef->dmax = kw->val.d[0];
	          bfdef->mflag |= 2;
		  break;
             case END      : 
		  ktype = 0;
		  break;
             default       : 
                  SCTPUT("Warning: Undef. basic action");
          }
          break;
     case TXCTL :
          if (kw->kno && bfdef->extd && txdef->tfields<kw->kno) {
	    SCTPUT("Warning: column index larger than TFIELD!");
	    ktype = -1; break;
	  }
          n = kw->kno - 1;
          switch (kwd->action) {
             case TFIELDS  :
                  bfdef->mtype = F_TBL_TYPE;
                  if (fmt!='N') bfdef->cflag = 0;
                  if (MXF<kw->val.i) {
		     SCTPUT("Error: Max. TFIELDS exceeded!");
		     return -2;
                  }
                  txdef = hdr_tbl();
                  txdef->tfields = kw->val.i;
		  fdef = txdef->col;
                  break;
             case THEAP    :
                  txdef->theap = kw->val.i;
		  break;
             case TBCOL    :
                  fdef[n].tbcol = kw->val.i - 1;
                  break;
             case TFORM    :
		  pc = kw->val.pc; ps = fdef[n].tform; i = MXS;
		  while (--i && (*ps++ = *pc++)); if (i) *ps = '\0';
		  pc = kw->val.pc;
		  if (dcffmt(pc,&fdef[n].trepn,&c,
                                &fdef[n].twdth,&fdef[n].tdfdd))
                      SCTPUT("Error: invalid FORTRAN format\n");
		  fdef[n].tncpf = 1;
		  switch (c) {
		     case 'A' : fdef[n].tdfmt = 'A';
		                sprintf(fdef[n].tform,"A%d",
					fdef[n].trepn*fdef[n].twdth);
				break;
		     case 'I' : fdef[n].tdfmt = 
				     (htype==ATABLE) ? 'I' : 'S';
                                strcpy(fdef[n].tform,"I11");
				break;
		     case 'F' : fdef[n].tdfmt = 'E';
                                strcpy(fdef[n].tform,"E15.5");
                                break;
		     case 'E' : fdef[n].tdfmt = 'E';
                                strcpy(fdef[n].tform,"E15.5");
                                break;
		     case 'D' : fdef[n].tdfmt = 'D';
                                strcpy(fdef[n].tform,"E15.5");
                                break;
		     case 'J' : fdef[n].tdfmt = 'I';
                                strcpy(fdef[n].tform,"I11");
                                break;
		     case 'L' : fdef[n].tdfmt = 'L';
		                sprintf(fdef[n].tform,"A%d",fdef[n].trepn);
                                break;
		     case 'B' : fdef[n].tdfmt = 'B';
                                strcpy(fdef[n].tform,"I4");
                                break;
		     case 'X' : fdef[n].tdfmt = 'X';
                                strcpy(fdef[n].tform,"I4");
                                break;
		     case 'C' : fdef[n].tdfmt = 'C';
                                fdef[n].tncpf = 2;
                                strcpy(fdef[n].tform,"E15.5");
                                break;
		     case 'M' : fdef[n].tdfmt = 'M';
                                fdef[n].tncpf = 2;
                                strcpy(fdef[n].tform,"E15.5");
                                break;
		     case 'P' : fdef[n].tdfmt = 'P';
                                fdef[n].tncpf = 2;
                                strcpy(fdef[n].tform,"I11");
                                break;
		     default  : fdef[n].tdfmt = '\0'; break;
		  }
                  break;
             case TTYPE    :
		  pc = kw->val.pc; ps = fdef[n].ttype; i = MXS;
		  while (--i && (*ps++ = *pc++)); *ps = '\0';
                  break;
             case TUNIT    :
		  pc = kw->val.pc; ps = fdef[n].tunit; i = MXS;
		  while (--i && (*ps++ = *pc++)); *ps = '\0';
                  break;
             case TSCAL    :
                  fdef[n].tscal = kw->val.d[0];
		  if (fdef[n].tscal!=1.0) fdef[n].sflag = 1;
                  break;
             case TZERO    :
                  fdef[n].tzero = kw->val.d[0];
		  if (fdef[n].tzero!=0.0) fdef[n].sflag = 1;
                  break;
	     case TNULL    :
                  if (htype==ATABLE && kw->fmt=='S') {
		    fdef[n].nflag = 1;
		    pc = kw->val.pc; ps = fdef[n].tnull; i = MXS;
		    while (--i && (*ps++ = *pc++)); *ps = '\0';
		  }
		  else if (htype==BTABLE && kw->fmt=='I') {
		    fdef[n].nflag = 1;
		    fdef[n].tnnul = kw->val.i;
		  }
                  break;
	     case TDISP    :
		  pc = kw->val.pc; ps = fdef[n].tdisp; i = MXS;
		  while (--i && (*ps++ = *pc++)); *ps = '\0';
                  break;
             default       : 
                  SCTPUT("Warning: Undef. table action!");
          }
          break;
     case WDESC :                       /* store keyword in descriptor */
          if (fmt=='N') break;          /* skip if NO file option      */
          switch (kwd->action) {        /* special actions             */
	     case TMSTART  : 
	            kw->val.d[0] /= 3600;
		    tmstart = kw->val.d[0]; break;
             case TMEND    : 
	            if (tmstart<0.0) kw->val.d[0] = 0;
		    else {
		       kw->val.d[0] -= 3600*tmstart;
		       if (kw->val.d[0]<0.0) kw->val.d[0] += 86400.0;
		     }
		    break;
             case TEXTFILE :
	            bfdef->tflag = 1;
                    if (text_open(kw->val.pc,WRITE)) {
		       sprintf(line,"Warning: cannot create textfile <%s>",
			       kw->val.pc);
		       SCTPUT(line);
		     }
		    else return ktype;
		    break;
             case MJDOBS   :
                    if (mfd < 0) break;        
	            err = SCDRDD(mfd,"O_TIME",5,1,&i,&d,unit,&i);
		    if (d==0.0) {
		       d = 24.0*fmod(kw->val.d[0],1.0);
		       err = SCDWRD(mfd,"O_TIME",&d,5,1,unit);
		     }
                    break;
             default       :
                    break;
          }
          if (bfdef->tflag && !strcmp(kw->kw,"COMMENT ")) {
	    text_put(kw->pcom);
	    return ktype; 
	  }
          if (hist=='N' && kwd->fmt=='C') break;     /* skip HIST+COMM */
          if (!(*kwd->desc)) break;     /* no associated descriptor    */
          if (0<=mfd) {                 /* MIDAS file exists           */
                                        /* check for MIDAS descriptors */
	     if (kwd->fmt=='C' && !strcmp(kw->kw,"HISTORY ")) {
		if (kwcmp(kw->val.pc,"ESO-DESCRIPTORS START")) {
		   mds = 1; mdcnt = 0; break;
		 }
		if (mds) {              /* decode MIDAS descriptors    */
		   if (kwcmp(kw->val.pc,"ESO-DESCRIPTORS END")) mds = 0;
		   else fitsrmd(mfd,kw,&mdcnt);
		   break;
		 }
	      }

	     n = 1; i = 0;
	     SCECNT("PUT",&n,&i,&i);    /* disable SC-error handling   */

	     switch (kwd->type) {       /* save value in MIDAS desc.   */
		case 'S' :
		     if (!kw->val.pc) break;
		     i = strlen(kw->val.pc);
		     if (kwd->idx<1) {
		       if (i<72 || kw->val.pc[71]!='\\') {
			 strcat(kw->val.pc,"\n"); i++;
		       }
		       else { kw->val.pc[71] = '\0'; i = 72; }
		     }
		     err = SCDWRC(mfd,kwd->desc,1,kw->val.pc,kwd->idx,i,unit);
		     break;
		case 'I' :
		     err = SCDWRI(mfd,kwd->desc,&kw->val.i,kwd->idx,1,unit);
		     break;
		case 'R' :
		     f = kw->val.d[0];
		     err = SCDWRR(mfd,kwd->desc,&f,kwd->idx,1,unit);
		     break;
		case 'D' :
		     err = SCDWRD(mfd,kwd->desc,kw->val.d,kwd->idx,1,unit);
		     break;
		   }

	     n = 1; i = 0;
	     SCECNT("PUT",&i,&n,&n);    /* enable SC-error handling     */

	     if (kw->pcom && 0<kwd->idx) {
		n = strlen(kw->pcom);
		if (0<n) SCDWRH(mfd,kwd->desc,kw->pcom,-1,n);
	      }
	     if (err!=ERR_NORMAL) {
	       sprintf(line,"Warning: <%s> of type <%c> - not stored!",
		       kwd->desc,kwd->type);
	       SCTPUT(line);
	     }
	  }
	  else mdb_put(kw,kwd);          /* no MIDAS file - buffer KW   */
          break;
     default    : SCTPUT("Warning: Undef. keyword group!");
  }

  if (!bfdef->cflag)              /* check if data file can be created */
     switch (htype) {
        case BFITS  : if (kwd->action==NAXIS && kw->kno==bfdef->naxis) 
                          bfdef->cflag = 1;
             break;
	case IMAGE  :
        case RGROUP : if ((bfdef->kwflag & 3) == 3) bfdef->cflag = 1;
             break;
        case ATABLE :
	     n = 1;
	     for (i=0; i<txdef->tfields; i++)
		 n = n && 0<=fdef[i].tbcol && fdef[i].tdfmt;
	     bfdef->cflag = (n) ? 1 : 0;
             break;
        case BTABLE :
	     n = 1;
	     for (i=0; i<txdef->tfields; i++)
		 n = n && fdef[i].tdfmt;
	     bfdef->cflag = (n) ? 1 : 0;
             break;
	default     : bfdef->cflag = -1;
     }

  return ktype;
}