/*===========================================================================
  Copyright (C) 1995-2008 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 Massachusetts Ave, Cambridge, 
  MA 02139, USA.
 
  Correspondence 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
===========================================================================*/

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.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.4  1989-Oct-17 : Convert real to int in KEYWORD, PJG 
.VERSION   1.87 1990-Oct-24 : Introduce HIERARCH keywords, PJG 
.VERSION   2.25 1991-Sep-23 : Add new field types for BINTALBE, PJG 
.VERSION   2.35 1992-Aug-12 : Allow 1<PCOUNT for BINTABLE and UNKNOW, 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.80 1993-Dec-13 : Disable SC error for descriptors, PJG 
.VERSION   2.85 1994-Jan-11 : Check for zero length history, 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 
.VERSION   3.15 1996-Nov-22 : Change allowed char., PJG 

 080617		last modif
---------------------------------------------------------------------*/

#include   <math.h>
#include   <osparms.h>
#include   <fitsfmt.h>
#include   <fitsdef.h>
#include   <fitskwb.h>
#include   <fitskwt.h>
#include   <midas_def.h>
#include   <fctext.h>
#include   <errext.h>

#include   <string.h>
#include   <stdlib.h>
#include   <stdio.h>

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

int kwcmp(pk,ps)
char    *pk;
char    *ps;

{
register char  c, cc;



/* pk -> new keyword to identify,
   ps -> stored keywords with specified meaning from KWDEF */


while ((c = *ps++)) 
   {
   cc = *pk++;
   if (c != '#') 
      {
      if (c != cc) return 0;
      }
   else
      {
      if ((cc != ' ') && (cc < '0' || '9' < cc)) return 0;
      }
   }
return 1;		/* names match */
}
/*

*/

#ifdef __STDC__
int fitsckw(int mfd , BFDEF * bfdef , int htype , KWORD * kw , char fmt , 
            char hist, int *delt_flag, int Midas_flag)
#else
int fitsckw(mfd,bfdef,htype,kw,fmt,hist,delt_flag,Midas_flag)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.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   */
int        *delt_flag;          /* OUT:  1 if CDELT found, else 0    */
int        Midas_flag;          /* IN:  Midas flag                   */
#endif


{
char       c, *ps, *pc, line[80];
register char  dfmt, ckw;

int        ktype, n, m, i, err;
int        kwdsize, unit[4];
int        eco, elo, edi;

int  SCTMES(), hdr_tbl_M(), SCDHWL();
float      f;

double     d;

KWDEF      *kwd, ndkw;

TXDEF      *hdr_tbl();


char  *cptr, lastchar;
int   kk;



if (!kw->kw) return (-2);

kwd = bkw; ktype = -1; *delt_flag = 0;
kwdsize = sizeof(KWDEF);

/*
 printf("fitsckw: kw = %s\n",kw->kw); 
*/

ckw = kw->kw[0];
if (ckw == 'H')
   {
   if (strcmp(kw->kw,"HIERARCH") == 0)
      {
      memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
      goto next_step;
      }
   else if (strcmp(kw->kw,"HISTORY ") == 0)
      {
      kwd ++;
      memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
      goto next_step;
      }
   }

if (ckw == ' ')
   {						/* check if all blanks */
   if (strcmp(kw->kw,"        ") == 0)
      {
      kwd += 11;				/* point to COMMENT entry */
      memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
      goto next_step;
      }
   }
else
   {				/* compare with basic keyword list */
   kwd += 2;			/* point to first entry after HISTORY */
   while (kwd->kw) 
      {
      if (ckw < kwd->kw[0]) break;	/* kwd is alphabetically sorted! */

      if (ckw == kwd->kw[0])
         {
         if (kwcmp(kw->kw,kwd->kw)) 
            {
            memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
            goto next_step;
            }
         }

      kwd++;
      }
   }


/* not found - check list for tables   */

if ((htype != IMAGE) && (ckw == 'T'))
   {				/* use 2nd char, all keywords start with 'T' */
   ckw = kw->kw[1];	

   kwd = tkw;				/* go through table keywords */
   while (kwd->kw) 
      {
      if (ckw < kwd->kw[1]) break;      /* kwd is alphabetically sorted! */

      if (ckw == kwd->kw[1])
         {
         if (kwcmp(kw->kw,kwd->kw)) 
            {
            memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
            goto next_step;
            }
         }

      kwd++;
      }
   }


/* 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 : '_';
   }


next_step:
kwd = &ndkw;

if (kwd->group==WDESC && kwd->action==HIERARCH) 
   {
   int  reto;


   if (FCT.PARM[3] == 1)	/* should we ignore ESO.xyz keywords? */
      return ktype;
     
   i = (hist == 'C');
   reto = fitshkw(kw,kwd,i);
   if (reto) 
      {
      (void) sprintf
           (line,"Warning: hierachical keyword not known (retval = %d)",reto);
      SCTMES(M_BLUE_COLOR,line); 
      return 1;
      }
   }

if (!(kwd->type))
   {
   switch (kw->fmt) 
      {
      case 'L'  : kwd->type = 'L'; break;
      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;

dfmt = kwd->fmt;
if ((kw->fmt != dfmt) && (dfmt != 'H') && (dfmt != 'N') && (dfmt != '\0'))
   {
   if (fitstkw(kw,kwd->fmt)) 
      {					/* convert data format      */
      (void) sprintf(line,"Warning: Inconsistent data types [%c-%c] for >%s< !",
              kwd->fmt,kw->fmt,kw->kw);
      SCTMES(M_BLUE_COLOR,line);
      return 1;
      }
   }

ktype = 1;
switch (kwd->group) 
   {				/* goto keyword group for action   */
   case NOACT : break;


   case BFCTL :			/* basic FITS control */
    if (kw->kno && bfdef->naxis<kw->kno && *(kw->kw)!='P') 
       {
       sprintf(line,"Warning: keyword %s - axis-index > NAXIS (= %d)",kw->kw,bfdef->naxis);
       SCTMES(M_BLUE_COLOR,line);
       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;
           adef = bfdef->data;

           if (MIDAS_MXDIM < bfdef->naxis) 
              {
              if (MXDIM < bfdef->naxis)
                 {
	         char txt[48];

                 (void) sprintf(txt,"NAXIS = %d, Max. NAXIS (%d) exceeded!",
                                kw->val.i,MXDIM);
	         SCTMES(M_RED_COLOR,txt);
	         return -2;
                 }

              if (ext_NAXIS == 0)
                 {
                 for (i=MIDAS_MXDIM; i<MXDIM; i++)	/* init also the rest */
                    {
                    adef[i].naxis = 0;
                    adef[i].crval = 1.0;
                    adef[i].crpix = 1.0;
                    adef[i].cdelt = 1.0;
                    adef[i].crota = 0.0;
                    adef[i].ctype[0] = '\0';
                    }
                 ext_NAXIS = 1;			/* set switch */
                 }
              }
	   pdef = bfdef->parm;
           bfdef->crflag = 0;			/* indicate no CROTA there */
           }
        else 
           {
           if (htype==RGROUP) n--;
           adef[n].naxis = kw->val.i;
           }
        break;

       case CRVAL    :
	if (htype==RGROUP) n--;
        if (n<0) 
           SCTPUT("superfluous CRVAL ... not stored");
        else
           adef[n].crval = kw->val.d[0];
        break;

       case CRPIX    :
	if (htype==RGROUP) n--;
        if (n<0) 
           SCTPUT("superfluous CRPIX ... not stored");
        else
           adef[n].crpix = kw->val.d[0];
        break;

       case CDELT    :
        if (htype==RGROUP) n--;
        if (n<0) 
           SCTPUT("superfluous CDELT ... not stored");
        else
           adef[n].cdelt = kw->val.d[0];
        *delt_flag = 1;
        break;

       case CTYPE    :
	if (htype==RGROUP) n--;
        if (n<0) 
           SCTPUT("superfluous CTYPE ... not stored");
        else
           {
           pc = kw->val.pc; ps = adef[n].ctype; i = MXS;
	   while (--i && (*ps++ = *pc++)); *ps = '\0';
           }
        break;

       case CROTA    :
	if (htype==RGROUP) n--;
        if (n<0) 
           SCTPUT("superfluous CROTA ... not stored");
        else
           {
           bfdef->crflag = 1;
           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';
        if (*bfdef->bunit == '\0')
           {
           memset((void *)bfdef->bunit,32,(size_t)16);
           *(bfdef->bunit + 16) = '\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)
           SCTMES(M_BLUE_COLOR,"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) 
              {
	      SCTMES(M_BLUE_COLOR,"Warning: GCOUNT < 1, changed to 1");
	      bfdef->gcount = 1;
	      }
	   else 
              SCTMES(M_BLUE_COLOR,"Warning: GCOUNT > 1");
	   }
        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';
        ps = bfdef->extname;
        for (i=0; i<16; i++)
           {				/* cut off trailing blanks */
           if (*ps == ' ')
              {
              *ps = '\0';
              break;
              }
           ps ++;
           }
        break;

       case OBJECT   :
	pc = kw->val.pc; ps = bfdef->ident; i = MXIDNT;
	while (--i && (*ps++ = *pc++)); *ps = '\0';
        if (*bfdef->ident == '\0')
           {
           memset((void *)bfdef->ident,32,(size_t)71);
           *(bfdef->ident + 72) = '\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       : 
        SCTMES(M_BLUE_COLOR,"Warning: Undef. basic action");
       }
    break;			/* end - case BFCTL */


   case TXCTL :
    if (kw->kno && bfdef->extd && txdef->tfields<kw->kno) 
       {
       SCTMES(M_BLUE_COLOR,"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) 
           {
	   SCTMES(M_RED_COLOR,"Error: Max. TFIELDS exceeded");
	   return -2;
           }
        if (Midas_flag == 0)
           txdef = hdr_tbl(kw->val.i);
        else
           {
           m = hdr_tbl_M(bfdef,kw->val.i);
           if (m != 0) return (-9);

           txdef = (TXDEF *)bfdef->extd;
           }
	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))
           SCTMES(M_RED_COLOR,"Error: invalid FORTRAN format");
	fdef[n].tncpf = 1;
	switch (c) 
           {
	   case 'A' :
            fdef[n].tdfmt = 'A';
	    (void) sprintf(fdef[n].tform,"A%d",fdef[n].trepn*fdef[n].twdth);
	    break;
	   case 'I' :
            fdef[n].tdfmt = (htype==ATABLE) ? 'I' : 'S';
            (void) strcpy(fdef[n].tform,"I11");
	    break;
	   case 'F' :
            fdef[n].tdfmt = 'E';
            (void) strcpy(fdef[n].tform,"E15.5");
            break;
	   case 'E' :
            fdef[n].tdfmt = 'E';
            (void) strcpy(fdef[n].tform,"E15.5");
            break;
	   case 'D' :
            fdef[n].tdfmt = 'D';
            (void) strcpy(fdef[n].tform,"E15.5");
            break;
	   case 'J' :
            fdef[n].tdfmt = 'I';
            (void) strcpy(fdef[n].tform,"I11");
            break;
	   case 'L' :
            fdef[n].tdfmt = 'L';
	    (void) 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       : 
        SCTMES(M_BLUE_COLOR,"Warning: Undefined table action");
       }
    break;			/* end - case TXCTL */


   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)) 
           {
	   (void) sprintf(line,"Warning: cannot create textfile <%s>",
			  kw->val.pc);
           SCTMES(M_BLUE_COLOR,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;
       }

    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 */

       /* *** instead of: n = 1; i = 0; SCECNT("PUT",&n,&i,&i); *** */
       eco = ERRO_CONT; elo = ERRO_LOG; edi = ERRO_DISP;
       ERRO_CONT = 1;	/* disable SC-error handling   */
       ERRO_LOG = ERRO_DISP = 0;
       err = ERR_NORMAL;
           
       if (kwd->fmt=='C' && !strncmp(kw->kw,"HISTORY ",8)) 
          {
	  if (mds == 0)
             {
             if (strncmp(kw->val.pc,"ESO-DESCRIPTORS START",21) == 0)
                {
	        mds = 1; mdcnt = 0;
                ERRO_CONT = eco; ERRO_LOG = elo; ERRO_DISP = edi;
                break;
	        }
	     }
	  else
             {              /* decode MIDAS descriptors    */
	     if (strncmp(kw->val.pc,"ESO-DESCRIPTORS END",19) == 0)
                mds = 0;
	     else 
                {
                err = fitsrmd(mfd,kw,&mdcnt);
                if (err != ERR_NORMAL) 
                   {
                   char   badname[MXMDN];
                   void  fitsrmdbad();

                   fitsrmdbad(badname);
                   (void) sprintf(line,"bad ESO descriptor %s",badname);
                   SCTMES(M_BLUE_COLOR,line);
                   }
                }
             ERRO_CONT = eco; ERRO_LOG = elo; ERRO_DISP = edi;
	     break;
	     }
	  }

       switch (kwd->type) 
          {				/* save value in MIDAS desc.   */
	  case 'S' :
	   if (!kw->val.pc) break;
	   i = (int) strlen(kw->val.pc);
	   if (i <1 )
              {
	      (void) strcat(kw->val.pc," \n"); 
              i = 1;
	      }
           else
              {
              if (kwd->idx<1) 
                 {
		 if (i<72 || kw->val.pc[71]!='\\') 
                    {
		    (void) strcat(kw->val.pc,"\n"); i++;
		    }
		 else
                    {
                    kw->val.pc[71] = '\0'; i = 72; 
                    }
		 }
	      }

            if (strcmp(kwd->desc,"CONTINUE") == 0) 
               mdb_cont(mfd,2,kwd->desc,kw->val.pc);
 
            else
               {
               cptr = kw->val.pc;
               kk = (int)strlen(cptr) - 1;        /* index of last char. */
               lastchar = *(cptr+kk);
               if (lastchar == '&')
                  mdb_cont(mfd,1,kwd->desc,kw->val.pc);
               else
                  {
                  if ((strcmp(kwd->desc,"HISTORY") != 0) &&
                      (strcmp(kwd->desc,"COMMENT") != 0))
	             err = xSCDHWC(mfd,kwd->desc,1,kw->val.pc,kwd->idx,
                                      i,unit,kw->pcom);
                  else
	             err = SCDHWC(mfd,kwd->desc,1,kw->val.pc,kwd->idx,
                                     i,unit,kw->pcom);
                  }
               }
	   break;
	  case 'L' :
	    err = SCDHWL(mfd,kwd->desc,&kw->val.i,kwd->idx,
			 1,unit,kw->pcom);
	   break;
	  case 'I' :
           if (strncmp(kwd->desc,"O_",2) != 0)
	      err = xSCDHWI(mfd,kwd->desc,&kw->val.i,kwd->idx,
                                      1,unit,kw->pcom);
           else
	      err = SCDHWI(mfd,kwd->desc,&kw->val.i,kwd->idx,
                                     1,unit,kw->pcom);
	   break;
	  case 'R' :
	   f = kw->val.d[0];
           if (strncmp(kwd->desc,"O_",2) != 0)
	      err = xSCDHWR(mfd,kwd->desc,&f,kwd->idx,
                                      1,unit,kw->pcom);
           else
	      err = SCDHWR(mfd,kwd->desc,&f,kwd->idx,
                                     1,unit,kw->pcom);
	   break;
          case 'D' :
           if (strncmp(kwd->desc,"O_",2) != 0)
	      err = xSCDHWD(mfd,kwd->desc,kw->val.d,kwd->idx,
                                      1,unit,kw->pcom);
           else
	      err = SCDHWD(mfd,kwd->desc,kw->val.d,kwd->idx,
                                     1,unit,kw->pcom);
	   break;

          default :			/* everything else is bad type... */
           err = 999;
	  }

       ERRO_CONT = eco;		/* reset directly */
       ERRO_LOG = elo;
       ERRO_DISP = edi;		/* instead of SCECNT("PUT",...) */

       if (err!=ERR_NORMAL) 
          {
          if (err == 999)
	     (void) sprintf(line,"Warning: <%s> of invalid type - not stored",
	   	    kwd->desc);
          else
	     (void) sprintf(line,"Warning: <%s> of type <%c> - not stored",
	   	    kwd->desc,kwd->type);
          SCTMES(M_BLUE_COLOR,line);
	  }
       }

    else
       mdb_put(kw,kwd);          /* no MIDAS file - buffer KW   */
    break;			/* end - case WDESC */


   default    : 
    SCTMES(M_BLUE_COLOR,"Warning: Undefined 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;
}
/*

*/

#ifdef __STDC__
int fitsXckw(int mfd , BFDEF * bfdef , int htype , KWORD * kw)
#else
int fitsXckw(mfd,bfdef,htype,kw)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.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            */
#endif



/*
in this routine we have Midas_flag == -2
which means we just need some basic FITS keywords
all other keywords are ignored 
*/




{
char        *ps, *pc;
register char  ckw;

int        ktype, n, i, kwdsize;
int   SCTMES();

KWDEF      *kwd, ndkw;

TXDEF      *hdr_tbl();





/*
 printf("fitsXckw: kw = %s\n",kw->kw); 
*/


if (!kw->kw) return (-2);

kwd = bkw; ktype = -1; 
kwdsize = sizeof(KWDEF);


ckw = kw->kw[0];
if ((ckw == 'H') || (ckw == ' ')) return ktype;

   				/* compare with basic keyword list */
kwd += 2;			/* point to first entry after HISTORY */
while (kwd->kw) 
   {
   if (ckw < kwd->kw[0]) break;	/* kwd is alphabetically sorted! */

   if (ckw == kwd->kw[0])
      {
      if (kwcmp(kw->kw,kwd->kw)) 
         {
         memcpy((char *)&ndkw,(char *)kwd,(size_t)kwdsize);
         goto next_step;
         }
      }
   kwd++;
   }

return ktype;		/* not found - so we don't have to care! */




next_step:
kwd = &ndkw;

if (kwd->group != BFCTL) return ktype;


ktype = 1;		/* BFCTL: basic FITS control */
if (kw->kno && bfdef->naxis<kw->kno && *(kw->kw)!='P') return ktype;

n = kw->kno - 1;
switch (kwd->action) 
   {
  case BITPIX   : 
   bfdef->bitpix = kw->val.i;
   mds = 0; 
   break;

  case NAXIS    :
   if (n<0) 
      {
      bfdef->naxis = kw->val.i;
      adef = bfdef->data;

      if (MIDAS_MXDIM < bfdef->naxis) 
         {
         if (MXDIM < bfdef->naxis)
            {
	    char txt[48];

            (void) sprintf(txt,"NAXIS = %d, Max. NAXIS (%d) exceeded!",
                                kw->val.i,MXDIM);
	    SCTMES(M_RED_COLOR,txt);
	    return -2;
            }

         if (ext_NAXIS == 0)
            {
            for (i=MIDAS_MXDIM; i<MXDIM; i++)	/* init also the rest */
               {
               adef[i].naxis = 0;
               adef[i].crval = 1.0;
               adef[i].crpix = 1.0;
               adef[i].cdelt = 1.0;
               adef[i].crota = 0.0;
               adef[i].ctype[0] = '\0';
               }
            ext_NAXIS = 1;			/* set switch */
            }
         }
      pdef = bfdef->parm;
      bfdef->crflag = 0;			/* indicate no CROTA there */
      }
   else 
      {
      if (htype==RGROUP) n--;
      adef[n].naxis = kw->val.i;
      }
   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 PCOUNT   :
   bfdef->pcount = kw->val.i;
   bfdef->kwflag |= 1;
   break;

  case GCOUNT   :
   bfdef->gcount = kw->val.i;
   bfdef->kwflag |= 2;
   if (htype!=RGROUP && bfdef->gcount!=1) 
      {
      if (bfdef->gcount<1) bfdef->gcount = 1;
      }
   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 END      : 
   ktype = 0;
   break;

  default       : 
   ;
   }


return ktype;
}

