/*===========================================================================
  Copyright (C) 2001 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
===========================================================================*/
/* Program  : writeframe.c                                                 */
/* Author   : G. Mulas  -  ITAL_FLAMES Consortium                          */
/* Date     :                                                              */
/*                                                                         */
/* Purpose  : Missing                                                      */
/*                                                                         */
/*                                                                         */
/* Input:  see interface                                                   */ 
/*                                                                      */
/* Output:                                                              */
/*                                                                         */
/* DRS Functions called:                                                   */
/* none                                                                    */ 
/*                                                                         */ 
/* Pseudocode:                                                             */
/* Missing                                                                 */ 
/*                                                                         */ 
/* Version  :                                                              */
/* Last modification date: 2002/08/05                                      */
/* Who     When        Why                Where                            */
/* AMo     02-08-05   Add header         header                            */
/*-------------------------------------------------------------------------*/

#ifdef HAVE_CONFIG_H
#  include <config.h>
#endif

#include <stdlib.h>
#include <ctype.h>
#include <string.h>
#include <stdio.h>
#include <math.h>
#include <flames_midas_def.h>
#include <flames_uves.h>
#include <flames_stripfitsext.h>
#include <flames_writeframe.h>
#include <flames_newmatrix.h>


flames_err writeframe(flames_frame *myframe, char *framename, char *templatefile)
{
  char basename[CATREC_LEN+1];
  char filename[CATREC_LEN+1];
  int dataid=0;
  int sigmaid=0;
  int badid=0;
  int templateid=0;
  char cdummy[CATREC_LEN+1];
  char ident[73];
  char cunit[3][17];
  int npix[2]={0,0};
  double start[2]={0,0};
  double step[2]={0,0};
  float lhcuts[4]={0,0,0,0};
  int unit=0;
  frame_data minimum=0;
  frame_data maximum=0;
  int maxfibres=0;
  int naxis=0;
  int nflats=0;
  int status=0;

  frame_data *fdvecbuf1=0;
  int32_t iyixend=0;
  int32_t iyixindex=0;


  memset(basename, '\0', CATREC_LEN+1);
  memset(filename, '\0', CATREC_LEN+1);
  memset(cdummy, '\0', CATREC_LEN+1);
  memset(ident, '\0', 73);
  memset(cunit[0], '\0', 51);

  iyixend = (myframe->subrows*myframe->subcols)-1;

  /* find out whether the framename includes the .fits extension or not */
  if ((status = stripfitsext(framename, basename)) != NOERR) {
    /* problems stripping extension */
    return(MAREMMA);
  }

  /* create the actual data file */
  sprintf(filename,"%s.fits",basename);
  /* create the normalised data frame on disk */
  if ((status = SCFCRE(filename, FLAMESDATATYPE, F_O_MODE, F_IMA_TYPE, 
               myframe->subrows*myframe->subcols, &dataid))
      != 0) {
    /* could not create the data file */
    return(MAREMMA);
  }

  /* have I got a template to copy the descriptors from? */
  if (strlen(templatefile) > 0) {
    /* it seems I do: open it */
    if ((status = SCFOPN(templatefile, FLAMESDATATYPE, 0, F_IMA_TYPE, 
             &templateid)) != 0) {
      /* I could not open the template, wrong file name? */
      return(MAREMMA);
    }
    /* copy the descriptors to the data file */
    if ((status = SCDCOP(templateid, dataid, 1)) != 0) {
      /* I could not copy the descriptors */
      return(MAREMMA);
    }
    /* close the template file */
    if ((status = SCFCLO(templateid)) != 0) {
      /* I could not close the template file */
      return(MAREMMA);
    }
  }
  else {
    /* no template available, create and write standard descriptors */
    memset(ident, ' ', 72);
    naxis = 2;
    npix[0] = (int) myframe->subcols;
    npix[1] = (int) myframe->subrows;
    start[0] = myframe->substartx;
    start[1] = myframe->substarty;
    step[0] = myframe->substepx;
    step[1] = myframe->substepy;
    memset(cunit[0], ' ', 16);
    strncpy(cunit[1], "PIXEL           ", 16);
    strncpy(cunit[2], "PIXEL           ", 16);
    lhcuts[0] = 0;
    lhcuts[1] = 0;
    if ((status = SCDWRC(dataid, "IDENT", 1, ident, 1, 72, &unit)) != 0) {
      /* error writing descriptor */
      return(MAREMMA);
    }
    if ((status = SCDWRI(dataid, "NAXIS", &naxis, 1, 1, &unit)) != 0) {
      /* error writing descriptor */
      return(MAREMMA);
    }
    if (SCDWRI(dataid, "NPIX", npix, 1, 2, &unit)) 
    {
      /* error writing descriptor */
     return MAREMMA;
    }    
    if ((status = SCDWRD(dataid, "START", start, 1, 2, &unit)) != 0) {
      /* error writing descriptor */
      return(MAREMMA);
    }
    if ((status = SCDWRD(dataid, "STEP", step, 1, 2, &unit)) != 0) {
      /* error writing descriptor */
      return(MAREMMA);
    }
    if ((status = SCDWRC(dataid, "CUNIT", 16, (char*) cunit, 1, 3, &unit)) 
    != 0) {
      /* error writing descriptor */
      return(MAREMMA);
    }
    if ((status = SCDWRR(dataid, "LHCUTS", lhcuts, 1, 2, &unit)) != 0) {
      /* error writing descriptor */
      return(MAREMMA);
    }
  }

  /* There is one descriptor I want to fill differently anyway */
  /* find maximum and minimum in frame */
  fdvecbuf1 = myframe->frame_array[0];
  minimum = maximum = fdvecbuf1[0];
  for (iyixindex=1; iyixindex<=iyixend; iyixindex++) {
    if (fdvecbuf1[iyixindex]>maximum) maximum = fdvecbuf1[iyixindex];
    if (fdvecbuf1[iyixindex]<minimum) minimum = fdvecbuf1[iyixindex];
  }
  lhcuts[0] = lhcuts[1] = 0;
  lhcuts[2] = (float) minimum;
  lhcuts[3] = (float) maximum;
  if ((status = SCDWRR(dataid, "LHCUTS", lhcuts, 1, 4, &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }

  /* write the scalars in descriptors */
  maxfibres = myframe->maxfibres;
  if ((status = SCDWRI(dataid, "MAXFIBRES", &maxfibres, 1, 1, &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }
  if ((status = SCDWRC(dataid, "CHIPCHOICE", 1, &myframe->chipchoice, 1, 1, 
               &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }
  if ((status = SCDWRD(dataid, "RON", &myframe->ron, 1, 1, &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }
  if ((status = SCDWRD(dataid, "GAIN", &myframe->gain, 1, 1, &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }
  nflats = (int) myframe->nflats;
  if ((status = SCDWRI(dataid, "NFLATS", &nflats, 1, 1, &unit)) 
      != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }
  if (myframe->nflats > 0) {
    if ((status = SCDWRD(dataid, "YSHIFT", myframe->yshift, 1, 
             myframe->nflats, &unit)) != 0) {
      /* error writing descriptor */
      return(MAREMMA);
    }
  }
  if ((status = SCDWRI(dataid, "ORDERLIM", &myframe->firstorder, 1, 1, 
               &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }
  if ((status = SCDWRI(dataid, "ORDERLIM", &myframe->lastorder, 2, 1, 
               &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }

  if ((status = SCDWRI(dataid, "TAB_IN_OUT_OSHIFT", &myframe->tab_io_oshift, 
               1, 1, &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }

  /* write the data frame itself */
  if ((status = SCFPUT(dataid, 1, myframe->subrows*myframe->subcols, 
               (char *) myframe->frame_array[0])) != 0) {
    /* writing failed */
    return(MAREMMA);
  }

  /* create the sigma file name */
  sprintf(filename,"%s_sigma.fits",basename);
  /* create the sigma frame on disk */
  if ((status = SCFCRE(filename, FLAMESDATATYPE, F_O_MODE, F_IMA_TYPE, 
               myframe->subrows*myframe->subcols, &sigmaid))
      != 0) {
    /* could not create the data file */
    return(MAREMMA);
  }

  /* copy the descriptors from the data file */
  if ((status = SCDCOP(dataid, sigmaid, 1)) != 0) {
    /* I could not copy the descriptors */
    return(MAREMMA);
  }

  /* There is one descriptor I want to fill differently anyway */
  /* find maximum and minimum in sigma */
  fdvecbuf1 = myframe->frame_sigma[0];
  minimum = maximum = fdvecbuf1[0];
  for (iyixindex=1; iyixindex<=iyixend; iyixindex++) {
    if (fdvecbuf1[iyixindex]>maximum) maximum = fdvecbuf1[iyixindex];
    if (fdvecbuf1[iyixindex]<minimum) minimum = fdvecbuf1[iyixindex];
  }
  lhcuts[0] = lhcuts[1] = 0;
  lhcuts[2] = (float) minimum;
  lhcuts[3] = (float) maximum;
  if ((status = SCDWRR(sigmaid, "LHCUTS", lhcuts, 1, 4, &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }

  /* write the sigma file name as a descriptor of the data file */
  if ((status = SCDWRC(dataid, "SIGMAFRAME", 1, filename, 1, 80, 
               &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }

  /* write the sigma frame itself */
  if ((status = SCFPUT(sigmaid, 1, myframe->subrows*myframe->subcols, 
               (char *) myframe->frame_sigma[0])) != 0) {
    /* writing failed */
    return(MAREMMA);
  }

  /* close the sigma file */
  if ((status = SCFCLO(sigmaid)) != 0) {
    /* error closing file */
    return(MAREMMA);
  }

  /* create the badpixel file name */
  sprintf(filename,"%s_mask.fits",basename);
  /* create the sigma frame on disk */
  if ((status = SCFCRE(filename, FLAMESMASKTYPE, F_O_MODE, F_IMA_TYPE, 
               myframe->subrows*myframe->subcols, &badid))
      != 0) {
    /* could not create the bad pixel file */
    return(MAREMMA);
  }

  /* copy the descriptors from the data file */
  if ((status = SCDCOP(dataid, badid, 1)) != 0) {
    /* I could not copy the descriptors */
    return(MAREMMA);
  }

  /* There is one descriptor I want to fill differently anyway */
  /* put maximum and minimum of badpixel */
  lhcuts[0] = lhcuts[1] = 0;
  lhcuts[2] = 0;
  lhcuts[3] = 1;
  if ((status = SCDWRR(badid, "LHCUTS", lhcuts, 1, 4, &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }

  /* write the  file name as a descriptor of the data file */
  if ((status = SCDWRC(dataid, "BADPXFRAME", 1, filename, 1, 80, 
               &unit)) != 0) {
    /* error writing descriptor */
    return(MAREMMA);
  }

  /* write the bad pixel frame itself */
  if ((status = SCFPUT(badid, 1, myframe->subrows*myframe->subcols, 
               (char *) myframe->badpixel[0])) != 0) {
    /* writing failed */
    return(MAREMMA);
  }

  /* close the sigma file */
  if ((status = SCFCLO(badid)) != 0) {
    /* error closing file */
    return(MAREMMA);
  }

  /* close the data file */
  if ((status = SCFCLO(dataid)) != 0) {
    /* error closing file */
    return(MAREMMA);
  }

  /* the end */
  return(NOERR);

}
