/*===========================================================================
  Copyright (C) 1996-2011 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      fitswhd.c
.LAUGUAGE   C
.AUTHOR     P.Grosbol   ESO/IPG
.KEYWORDS   FITS header, keywords
.COMMENT    write FITS header
.VERSION    1.0  1988-Dec-11 : Creation,   PJG 
.VERSION    1.1  1989-Jan-17 : Change flag + include Btable,   PJG 
.VERSION    1.2  1989-Feb-14 : Binary-table support,   PJG 
.VERSION    1.3  1989-Jun-12 : Change definition of unit+kunit, PJG 
.VERSION    1.4  1989-Aug-24 : Remove check on I-display format, PJG 
.VERSION    1.5  1989-Nov-06 : Include I*4 and R*8 formats, PJG 
.VERSION    1.6  1990-Feb-02 : Update to new keyword structure, PJG 
.VERSION    1.7  1990-Feb-25 : Check fp-exeption + UNIT desc., PJG
.VERSION    1.8  1990-Nov-07 : Add comment \n + table-disp-format, PJG
.VERSION    1.82 1990-Nov-19 : Correct table-disp-format, PJG
.VERSION    2.0  1991-Mar-07 : Change call-seq. and structures, PJG
.VERSION    2.05 1991-Mar-17 : Include text+fits files, PJG
.VERSION    2.1  1991-Apr-03 : Check size of UNIT desc., PJG
.VERSION    2.15 1991-Jun-03 : Reset bfac,bzero if not needed, PJG
.VERSION    2.20 1991-Sep-24 : Include TNULL for BINTABLEs, PJG
.VERSION    2.25 1992-Mar-19 : Correct CRPIX/CRVAL computation, PJG
.VERSION    2.30 1993-Oct-26 : Update for new ST and prototype, PJG
.VERSION    2.35 1994-Jun-27 : Change fitswkd + include UI2 format, PJG
.VERSION    2.40 1994-Sep-07 : NULL terminate 'cunit' string, PJG
.VERSION    2.45 1996-Nov-12 : Write base-name only for file-name, PJG
.VERSION    2.50 1997-Jan-08 : Check non-ASCII char in Textfiles, PJG
.VERSION    2.55 1997-Jul-30 : Update comment on 'DATE' card, PJG

 110214		last modif
---------------------------------------------------------------------*/

#include   <string.h>
#include   <stdio.h>
#include   <osparms.h>
#include   <computer.h>
#include   <fitsfmt.h>
#include   <fitsdef.h>
#include   <fitskwt.h>
#include   <midas_def.h>
#include <math.h>

#define    MXLB           81         /* max. char. in line buffer    */
#define    FITSREF "NOST 100-2.0: Hanisch,R. et al. 2001, Astron. & Astrophys. 376, 559"
#define    LONGSTR_comnt "OGIP long string convention may be used"

/*

*/

#ifdef __STDC__
int fitswhd(int mfd , int mft , int mff , char * mfn ,
	    char ffmt , char cut , int fht)
#else
int fitswhd(mfd,mft,mff,mfn,ffmt,cut,fht)
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE       write FITS header
.RETURN        return status  0:OK, -1:error
---------------------------------------------------------------------*/
int           mfd;             /* IN: MIDAS file number              */
int           mft;             /* IN: MIDAS file type                */
int           mff;             /* IN: MIDAS file data format         */
char          *mfn;            /* IN: MIDAS file name                */
char          ffmt;            /* IN: FITS file format               */
char          cut;             /* IN: cut flag for FITS file         */
int           fht;             /* IN: FITS header type               */
#endif
{
char        line[MXLB], comfits[48];
char        *pc, fc, type, helptext[48];
char        cunit[MXS], *hkw[1];	 /* extname[MXS] was here ... */

int         i, nc, nbp, nv, null, bscal_flag;
int         fr, fw, fm, nn, dne, dnbpe;
int         naxis, nax[MXDIM];
int         cunitext, unit[4], fits_info[2];
int         datminmax_flag, cdmatrix;

double      crval, crpix, cdelt, crota;

FDEF        *fd;
SDEF        *sdef;
TXDEF       *tdef;





hkw[0] = "";
datminmax_flag = 0;
unit[0] = cdmatrix = 0;

/* get FITS switches:
  header version for single, real keywords in fits_info[0]
  CONTINUE flag in fits_info[1]  */

(void) SCKRDI("AUX_MODE",10,2,&i,fits_info,unit,unit);

switch (fht)
   {               /* write header depending on type     */
   case BFITS :                     /* Prime Image header         */
   case IMAGE :                     /* Extension Image header         */
      switch (mff) 
         {               /* check what format to write */
         case D_I1_FORMAT  : nbp = 8; break;
         case D_I2_FORMAT  : nbp = 16; break;
         case D_UI2_FORMAT : nbp = 16; break;
         case D_I4_FORMAT  : nbp = 32; break;
         case D_R4_FORMAT  : nbp = (ffmt=='B') ? 32 : -32; break;
         case D_R8_FORMAT  : nbp = -64; break;
         default           : SCTPUT("Error: Unknown data format");
                             return -1;
         }
      if (fht == BFITS)
         fitswkl("SIMPLE",hkw,0,-1,1,"Standard FITS format: NOST 100-2.0");
      else
         fitswks("XTENSION",hkw,0,-1,"IMAGE","FITS Image Extension");
      fitswki("BITPIX",hkw,0,-1,nbp,"No. of bits per pixel");
      if (SCDRDI(mfd,"NAXIS",1,1,&nv,&naxis,unit,&null) != ERR_NORMAL)
         {
         i = 1;
         goto bad_descr;
         }
      if (naxis > 0) 
         {
         fitswki("NAXIS",hkw,0,-1,naxis,"No. of axes in image");
         if (SCDRDI(mfd,"NPIX",1,MXDIM,&nv,nax,unit,&null) != ERR_NORMAL)
            {
            i = 2;
            goto bad_descr; 
            }
         for (i=0; i<naxis; i++) 
	    fitswki("NAXIS",hkw,0,i+1,nax[i],"No. of pixels");
         }
      else
         fitswki("NAXIS",hkw,0,-1,naxis,"Empty Prime data matrix");

      if (fht == BFITS)
         {
         fitswkl("EXTEND",hkw,0,-1,1,"FITS extension may be present");

         nv = SCDRDC(mfd,"COMMENT",1,1,40,&nv,comfits,unit,&null);
         if (nv != ERR_NORMAL)
            fitswkc("COMMENT", FITSREF);
         else
            {
            if (strncmp(comfits,"NOST 100-2.0: Hanisch,R.",24) != 0)
               fitswkc("COMMENT", FITSREF);
            }

         nv = SCDRDC(mfd,"LONGSTRN",1,1,20,&nv,comfits,unit,&null);
         if ((nv != ERR_NORMAL) && (fits_info[1] == 1))
            fitswks("LONGSTRN",hkw,0,-1,"OGIP 1.0",LONGSTR_comnt);
         fitswkc("","");
         }
      else
         {
         fitswki("PCOUNT",hkw,0,-1,0,"Parameter count always 0");
         fitswki("GCOUNT",hkw,0,-1,1,"Group count always 1");
         }
      fitswkc("","");

      sdef = fitsbdf(mfd,mff,mfn,&bscal_flag);

      if ((SCDFND(mfd,"CUNIT",&type,&dne,&dnbpe) == ERR_NORMAL) &&
          (type == 'C')) 
         {
	 dne = 16/dnbpe;
         cunitext = 1;
         }
      else
         cunitext = 0;

      if (naxis > 0)
         {
         char  cd_name[6];
         double  cdmat, cdx, cdy, cdrotang[2], cdrota;
 
         nv = 0;
         (void) SCDRDH(mfd,"STEP",1,47,&nv,helptext,&null);
         if ((nv > 0) && (strncmp(helptext,"computed from CD",16) == 0))
            (void) strcpy(helptext,"Coord. incr. per pixel (from CD matrix)");
         else
            (void) strcpy(helptext,"Coord. incr. per pixel (original value)");

         (void) SCKRDI("MID$MODE",6,1,&nv,&cdmatrix,unit,&null);
         if (cdmatrix == 2)
            {			/* we have to update also the CDi_j matrix */
            nv = get_cdelt(mfd,&cdx,&cdy,cdrotang);
            if (nv != 0)
               {		/* write default CDi_j matrix */
               cdmat = 1.0;
               (void) SCDWRD(mfd,"CD1_1",&cdmat,1,1,unit);
               (void) SCDWRD(mfd,"CD2_2",&cdmat,1,1,unit);
               cdrota = 0.0;
               }
            else
               {		/* get overall rotation angle */
               cdrota = (cdrotang[0] + cdrotang[1])/2;
               }
            }
         for (i=1; i<=naxis; i++) 
            {				/* define axes         */
            if (SCDRDD(mfd,"STEP",i,1,&nv,&cdelt,unit,&null) != ERR_NORMAL)
               {
               i = 3;
               goto bad_descr;
               }
            if ((cdmatrix == 2) && (i < 3))
               {				/* modify CDi_i */
               sprintf(cd_name,"CD%d_%d",i,i);
               (void) SCDRDD(mfd,cd_name,1,1,&nv,&cdmat,unit,&null); 
               cdmat = cdelt * cos(cdrota);
               (void) SCDWRD(mfd,cd_name,&cdmat,1,1,unit);
               }
            if (SCDRDD(mfd,"START",i,1,&nv,&crval,unit,&null) != ERR_NORMAL)
               {
               i = 4;
               goto bad_descr;
               }
            if (SCDRDD(mfd,"REFPIX",i,1,&nv,&crpix,unit,&null) != ERR_NORMAL) 
               crpix = 1.0;
            else
               crval += (crpix-1.0) * cdelt;
            fitswkd("CRPIX",hkw,0,i,crpix,"","Reference pixel");
            fitswkd("CRVAL",hkw,0,i,crval,
		    "","Coordinate at reference pixel");
            fitswkd("CDELT",hkw,0,i,cdelt,"",helptext);
            if (!SCDRDD(mfd,"ROTA",i,1,&nv,&crota,unit,&null)) 
               {
               if ((nv == 1) && (crota != 0.0)) 
                  fitswkd("CROTA",hkw,0,i,crota,"","Rotation angle of axis");
               }
	    if (cunitext == 1)
               {
	       SCDRDC(mfd,"CUNIT",dnbpe,i*dne+1,dne,&nv,cunit,unit,&null);
	       cunit[MXS-1] = '\0';
	       fitswks("CTYPE",hkw,0,i,cunit,"Units of coordinate");
	       }
            }

	 if (cunitext == 1)
            {
	    SCDRDC(mfd,"CUNIT",dnbpe,1,dne,&nv,cunit,unit,&null);
	    cunit[MXS-1] = '\0';
	    fitswks("BUNIT",hkw,0,-1,cunit,"Units of data values");
	    }
         if (nbp==32 && mff==D_R4_FORMAT)
            {					  /* scaling data       */
            fitswkd("BSCALE",hkw,0,-1,sdef->bfac,"",
	         	"Scaling factor: r = f*i + z");
            fitswkd("BZERO",hkw,0,-1,sdef->boff,"",
	      "Zero offset: r = f*i + z");
	    }
         else if (nbp==16 && mff==D_UI2_FORMAT)
            {					/* UI2 scaling  */
	    sdef->bfac = 1.0;
	    sdef->boff = 32768.0;
            fitswkd("BSCALE",hkw,0,-1,sdef->bfac,"",
		     "Scaling factor: r = f*i + z");
            fitswkd("BZERO",hkw,0,-1,sdef->boff,"",
		     "Zero offset: r = f*i + z");
            }
	 else 
            {                 /* NO scaling - reset bfac and boff */
	    sdef->bfac = 1.0;
	    sdef->boff = 0.0;
	    }
	 if (bscal_flag == 0)
            {
            fitswkd("DATAMAX",hkw,0,-1,sdef->dmax,"","Maximum data value");
	    fitswkd("DATAMIN",hkw,0,-1,sdef->dmin,"","Minimum data value");
            datminmax_flag = 1;		/* mark that we wrote them */
            }
         fitswkc("","");
         }
      break;

   case ATABLE :                        /* Table Extension header  */
      tdef = fitstbl(mfd,ffmt,cut);
      if (ffmt=='B')
         fitswks("XTENSION",hkw,0,-1,"TABLE","FITS ASCII Table Extension");
      else
         fitswks("XTENSION",hkw,0,-1,"BINTABLE","FITS Binary Table Extension");

      fitswki("BITPIX",hkw,0,-1,8,"8-bits character format");
      fitswki("NAXIS",hkw,0,-1,2,"Tables are 2-D char. array");
      fitswki("NAXIS",hkw,0,1,tdef->mxrow,"Characters in a row");
      fitswki("NAXIS",hkw,0,2,tdef->nrow,"No. of rows in table"); 
      fitswki("PCOUNT",hkw,0,-1,0,"Parameter count always 0");
      fitswki("GCOUNT",hkw,0,-1,1,"Group count always 1");
      fitswki("TFIELDS",hkw,0,-1,tdef->tfields,"No. of columns in table");
      fitswkc("","");

/* that would lead to 2 FITS keywords EXTNAME = ...
      if (SCDGETC(mfd,"EXTNAME",1,16,&nv,extname) == ERR_NORMAL)
         fitswks("EXTNAME",hkw,0,-1,extname,"Name of Extension");
*/
      fd = tdef->col; nc = 1;
      if (ffmt=='B')				/* ASCII Table keywords */
         {
         for (i=1; i<=tdef->tfields; i++, fd++) 
            {
            fitswki("TBCOL",hkw,0,i,nc,"Start column of field");
            nc += fd->twdth;
            fitswks("TFORM",hkw,0,i,fd->tform,"Format of field");
            fitswks("TDISP",hkw,0,i,fd->tdisp,"Display format of field");
            dcffmt(fd->tform,&fr,&fc,&fw,&fm);
            switch (fc) 
               {				/* convert F77 to C format  */
               case 'I' : sprintf(fd->tform,"%%%dd",fw); break;
               case 'F' : sprintf(fd->tform,"%%%d.%df",fw,fm); break;
               case 'E' : sprintf(fd->tform,"%%%d.%dE",fw,fm); break;
               case 'D' : sprintf(fd->tform,"%%%d.%dE",fw,fm); break;
               }
            fitswks("TTYPE",hkw,0,i,fd->ttype,"Field label");
            fitswks("TNULL",hkw,0,i," ","Null field is blank");
            fitswks("TUNIT",hkw,0,i,fd->tunit,"Physical unit of field");
            }
         }
      else                             /* Binary Table Keywords */
         {
	 for (i=1; i<=tdef->tfields; i++, fd++) 
            {
            switch (fd->tdfmt) 
               {				/* convert format code */
               case 'I' : sprintf(fd->tform,"%dJ",fd->trepn); break;
               case 'S' : sprintf(fd->tform,"%dI",fd->trepn); break;
               case 'B' : sprintf(fd->tform,"%dB",fd->trepn); break;
               case 'L' : sprintf(fd->tform,"%dL",fd->trepn); break;
               case 'X' : sprintf(fd->tform,"%dX",fd->trepn); break;
               case 'A' : sprintf(fd->tform,"%dA",fd->trepn); break;
               case 'E' : sprintf(fd->tform,"%dE",fd->trepn); break;
               case 'D' : sprintf(fd->tform,"%dD",fd->trepn); break;
               }
            fitswks("TFORM",hkw,0,i,fd->tform,"Format of field");
            fitswks("TDISP",hkw,0,i,fd->tdisp,"Display format of field");
            fitswks("TTYPE",hkw,0,i,fd->ttype,"Field label");
            fitswks("TUNIT",hkw,0,i,fd->tunit,"Physical unit of field");
	    if (fd->tdfmt=='I' || fd->tdfmt=='S' || fd->tdfmt=='B')
	       fitswki("TNULL",hkw,0,i,fd->tnnul,"Null value for interger");
            }
         }
      fitswkc("","");
      break;

   case BFITSE :                        /* Empty Prime header      */
      fitswkl("SIMPLE",hkw,0,-1,1,"Standard FITS format: NOST 100-2.0");
      fitswki("BITPIX",hkw,0,-1,8,"No. of bits per pixel");
      fitswki("NAXIS",hkw,0,-1,0,"Empty Prime data matrix");
      if (mft!=F_FIT_TYPE)
         fitswkl("EXTEND",hkw,0,-1,1,"FITS extension may be present");

      /* write FITS reference comment only once ... */
         nv = SCDRDC(mfd,"COMMENT",1,1,40,&nv,comfits,unit,&null);
         if (nv != ERR_NORMAL)
            fitswkc("COMMENT", FITSREF);
         else
            {
            if (strncmp(comfits,"NOST 100-2.0: Hanisch,R.",24) != 0)
               fitswkc("COMMENT", FITSREF);
            }

         nv = SCDRDC(mfd,"LONGSTRN",1,1,20,&nv,comfits,unit,&null);
         if ((nv != ERR_NORMAL) && (fits_info[1] == 1))
            fitswks("LONGSTRN",hkw,0,-1,"OGIP 1.0",LONGSTR_comnt);

      fitswkc("","");
      break;

   default         :
      SCTPUT("Error: Unsupported FITS header type");
      return -1;
   }

fitswks("ORIGIN",hkw,0,-1,"ESO-MIDAS","Written by MIDAS");
fitswks("DATE",hkw,0,-1,fitsdate((long)0)," [UTC] Date of writing");

if (mft==F_ASC_TYPE) 
   {
   fitswks("TEXTFILE",hkw,0,-1,mfn,"Name of text file");
   fitswkc("","");
   i = 0;
   do 
      {
      nn = text_get(line);
      if (nn<0) i -= nn;
      fitswkc("COMMENT",line);
      } while (nn);

   fitswkc("","");
   if (i) 
      {
      (void) sprintf(line,
	      "Warning: %d non-ASCII char's changed to SPACE in TEXTfile",-i);
      SCTPUT(line);
      }
   }

if (fht!=BFITSE || mft==F_FIT_TYPE) 
   {						/* write other keywords  */
   pc = ((pc = strrchr(mfn,'/')) || (pc=strrchr(mfn,']'))) ? pc+1 : mfn;
   fitswks("FILENAME",hkw,0,-1,pc,"Original file base-name");
   switch (mft) 
      {
      case F_IMA_TYPE : 
         if (naxis > 0)
            pc = "IMAGE";
         else
            pc = "";				/* image with NAXIS = 0 */
         break;
      case F_TBL_TYPE : pc = "TABLE"; break;
      case F_FIT_TYPE : pc = "FIT"; break;
      default         : pc = "";
      }

   if (*pc) 
      {
      fitswks("MIDASFTP",hkw,0,-1,pc,"MIDAS File Type");
      fitswkc("","");
      }

   fitswdb(mfd,datminmax_flag,fits_info);	/* write MIDAS descriptors */
   }

fitswkc("END","");
dbfill(' ');
return 0;


bad_descr:
if (i == 1)
   (void) strcpy(cunit,"NAXIS");
else if (i == 2)
   (void) strcpy(cunit,"NPIX");
else if (i == 4)
   (void) strcpy(cunit,"START");
else 
   (void) strcpy(cunit,"STEP");

(void) sprintf(line,
       "Error writing FITS header: descr. %s missing in input frame...",cunit);
SCTPUT(line);
return (-2);
}
