/*===========================================================================
  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  : writenormfactors.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 <string.h>
#include <stdio.h>
#include <math.h>
#include <flames_midas_def.h>
#include <flames_writenormfactors.h>
#include <flames_uves.h>
#include <flames_newmatrix.h>


flames_err writenormfactors(const cpl_frameset *catname, allflats *myflats)
{

  int32_t nflats=0, ncommon=0, nnormal=0, nnsigma=0;
  int entrynum=0;
  flames_err status=0;
  char filename[CATREC_LEN+1];
  char identifier[CATREC_LEN+1];
  char normalname[CATREC_LEN+1];
  char nsigmaname[CATREC_LEN+1];
  char commoname[CATREC_LEN+1];
  int commid=0;
  int normid=0;
  int nsigid=0;
  int actvals=0;
  int unit=0;
  int null=0;
  int ibuf[4]={0,0,0,0};
  double dbuf[4]={0,0,0,0};
  float lhcuts[4]={0,0,0,0};
  char cbuf[CATREC_LEN+1];
  char cunit[81];
  int32_t ****longarray=0;

  frame_data *fdvecbuf1=0;
  frame_mask *fmvecbuf1=0;
  int32_t *lvecbuf1=0;
  float fbuf1=0;
  float minimum=0;
  float maximum=0;
  int32_t fibreboundssize=0;
  int32_t iorderifibreixend=0;
  int32_t iorderifibreixindex=0;
  int32_t iiorderifibreixend=0;
  int32_t iiorderifibreixindex=0;


  memset(filename, 0, CATREC_LEN+1);
  memset(identifier, 0, CATREC_LEN+1);
  memset(normalname, 0, CATREC_LEN+1);
  memset(nsigmaname, 0, CATREC_LEN+1);
  memset(commoname, 0, CATREC_LEN+1);
  memset(cbuf, 0, CATREC_LEN+1);
  memset(cunit, 0, 81);


  nflats = 0;
  ncommon = 0;
  nnsigma = 0;
  nnormal = 0;
  /* first open the catalog, count the fibre FF frames, the normalisation
     frame(s) and the common 4D frame present */
  entrynum = 0;
  do {
    if ((status = SCCGET(catname, 1, filename, identifier, &entrynum)) != 0) {
      /* error getting catalog entry */
      return flames_midas_error(MAREMMA);
    }
    /* did I get a valid catalog entry? */
    if (filename[0] != ' ') {
      /* is this a int32_t slit FF frame? */
      if(strcmp(identifier, "Cleaned fibre FF                        ") == 0) {
    nflats++;
      }
      /* is this a normalisation frame? */
      if(strcmp(identifier, "Normalisation data for fibre FF         ") == 0) {
    nnormal++;
    strcpy(normalname, filename);
      }
      /* is this a normalisation frame? */
      if(strcmp(identifier, "Normalisation sigmas for fibre FF       ") == 0) {
    nnsigma++;
    strcpy(nsigmaname, filename);
      }
      /* is this a common frame? */
      if(strcmp(identifier, "Common data for fibre FF                ") == 0) {
    ncommon++;
    strcpy(commoname, filename);
      }
    }
  } while (filename[0] != ' ');
  /* did I get at least 1 FF frame name? */
  if (myflats->nflats != nflats) {
    /* I need at least 1 FF frame! */
    return flames_midas_error(MAREMMA);
  }
  /* did I get exactly 1 normalisation frame and common frame name? */
  if (nnormal != 1) {
    /* I need exactly 1 normalisation frame name! */
    return flames_midas_error(MAREMMA);
  }
  if (nnsigma != 1) {
    /* I need exactly 1 normalisation sigmas frame name! */
    return flames_midas_error(MAREMMA);
  }
  if (ncommon != 1) {
    /* I need exactly 1 common frame name! */
    return flames_midas_error(MAREMMA);
  }

  /* open the common frame to get the descriptors */
  if ((status = SCFOPN(commoname, D_I4_FORMAT, 0, F_IMA_TYPE, 
               &commid)) != 0) {
    /* could not open the frame */
    return flames_midas_error(MAREMMA);
  }
  /* read the relevant information from the frame */
  if ((status = SCDRDI(commid, "NFLATS", 1, 1, &actvals, ibuf, 
               &unit, &null)) != 0) {
    /* problems reading NFLATS: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->nflats != ibuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDI(commid, "ROWS", 1, 1, &actvals, ibuf, 
               &unit, &null)) != 0) {
    /* problems reading ROWS: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->subrows != ibuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDI(commid, "COLS", 1, 1, &actvals, ibuf, 
               &unit, &null)) != 0) {
    /* problems reading COLS: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->subcols != ibuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDD(commid, "STARTX", 1, 1, &actvals, 
               dbuf, &unit, &null)) != 0) {
    /* problems reading STEPX: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->substartx != dbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDD(commid, "STARTY", 1, 1, &actvals, 
               dbuf, &unit, &null)) != 0) {
    /* problems reading STEPY: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->substarty != dbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDD(commid, "STEPX", 1, 1, &actvals, 
               dbuf, &unit, &null)) != 0) {
    /* problems reading STEPX: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->substepx != dbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDD(commid, "STEPY", 1, 1, &actvals, 
               dbuf, &unit, &null)) != 0) {
    /* problems reading STEPY: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->substepy != dbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDC(commid, "CHIPCHOICE", 1, 1, 1, &actvals, 
               cbuf, &unit, &null)) != 0) {
    /* problems reading CHIPCHOICE: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->chipchoice != cbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDD(commid, "RON", 1, 1, &actvals, 
               dbuf, &unit, &null)) != 0) {
    /* problems reading RON: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->ron != dbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDD(commid, "GAIN", 1, 1, &actvals, 
               dbuf, &unit, &null)) != 0) {
    /* problems reading GAIN: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->gain != dbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDI(commid, "ORDERLIM", 1, 1, &actvals, 
               ibuf, &unit, &null)) != 0) {
    /* problems reading FIRSTORDER: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->firstorder != ibuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDI(commid, "ORDERLIM", 2, 1, &actvals, 
               ibuf, &unit, &null)) != 0) {
    /* problems reading LASTORDER: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->lastorder != ibuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDI(commid, "TAB_IN_OUT_OSHIFT", 1, 1, &actvals, 
               ibuf, &unit, &null)) != 0) {
    /* problems reading TAB_IN_OUT_OSHIFT: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->tab_io_oshift != ibuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDI(commid, "MAXFIBRES", 1, 1, &actvals, ibuf, 
               &unit, &null)) != 0) {
    /* problems reading COLS: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->maxfibres != ibuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDD(commid, "PIXMAX", 1, 1, &actvals, 
               dbuf, &unit, &null)) != 0) {
    /* problems reading GAIN: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->pixmax != dbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDD(commid, "HALFIBREWIDTH", 1, 1, &actvals, 
               dbuf, &unit, &null)) != 0) {
    /* problems reading GAIN: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->halfibrewidth != dbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDD(commid, "MINFIBREFRAC", 1, 1, &actvals, 
               dbuf, &unit, &null)) != 0) {
    /* problems reading GAIN: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->minfibrefrac != dbuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  if ((status = SCDRDI(commid, "NUMFIBRES", 1, 1, &actvals, ibuf, 
               &unit, &null)) != 0) {
    /* problems reading COLS: complain... */
    return flames_midas_error(MAREMMA);
  }
  if (myflats->numfibres != ibuf[0]) {
    /* mismatch between catalog and descriptors, abort */
    return flames_midas_error(MAREMMA);
  }
  /* build the 4D array to be dumped to disk */
  /* allocate the memory */
  longarray = l4tensor(0, 2, 0, myflats->lastorder-myflats->firstorder, 
               0, myflats->maxfibres-1, 0, myflats->subcols-1);
  fibreboundssize = (myflats->lastorder-myflats->firstorder+1)*
    myflats->maxfibres*myflats->subcols;
  iorderifibreixend = fibreboundssize-1;
  /* fill the 4D array: use memcpy for the fibrebounds, since they are 
     already int32_t data type, run an explicit loop for goodfibres, which
     needs to be cast before copying */
  memcpy(longarray[0][0][0], myflats->lowfibrebounds[0][0], 
     fibreboundssize*sizeof(int32_t));
  memcpy(longarray[1][0][0], myflats->highfibrebounds[0][0], 
     fibreboundssize*sizeof(int32_t));
  lvecbuf1 = longarray[2][0][0];
  fmvecbuf1 = myflats->goodfibres[0][0];
  for (iorderifibreixindex=0; iorderifibreixindex<=iorderifibreixend; 
       iorderifibreixindex++) {
    lvecbuf1[iorderifibreixindex] = (int32_t) fmvecbuf1[iorderifibreixindex];
  }
  /* write the 4D array to file */
  if (SCFPUT(commid, 1, 3*(1+myflats->lastorder-myflats->firstorder)*
         myflats->maxfibres*myflats->subcols, 
         (char *) (longarray[0][0][0])) != 0) {
    /* I could not write this big frame to disk: complain... */
    return(flames_midas_error(MAREMMA));
  }
  /* initialise LHCUTS */
  lvecbuf1 = longarray[0][0][0];
  lhcuts[0] = lhcuts[1] = 0;
  minimum = maximum = (float) lvecbuf1[0];
  iiorderifibreixend = (3*fibreboundssize)-1;
  for (iiorderifibreixindex=1; iiorderifibreixindex<=iiorderifibreixend; 
       iiorderifibreixindex++) {
    fbuf1 = (float)lvecbuf1[iiorderifibreixindex];
    if (fbuf1<minimum) minimum = fbuf1;
    if (fbuf1>maximum) maximum = fbuf1;
  }
  lhcuts[2] = minimum;
  lhcuts[3] = maximum;
  /* free the 4D array */
  free_l4tensor(longarray, 0, 2, 0, myflats->lastorder-myflats->firstorder, 
               0, myflats->maxfibres-1, 0, myflats->subcols-1);
  /* write LHCUTS */
  if (SCDWRR(commid, "LHCUTS", lhcuts, 1, 4, &null) != 0) {
    /* I could not write the descriptor: complain... */
    return flames_midas_error(MAREMMA);
  }
  /* we are indeed writing normalisation data, hence flag this fibre FF set
     as normalised */
  if (SCDWRC(commid, "NORMALISED", 1, "y", 1, 1, &unit) != 0) {
    SCTPUT("Error updating the NORMALISED flag");
    return flames_midas_error(MAREMMA);
  }
  /* close the common frame */
  if ((status = SCFCLO(commid)) != 0) {
    /* error closing common frame: complain */
    return flames_midas_error(MAREMMA);
  }

  /* open the normalisation data frame on disk */
  if (SCFOPN(normalname, FLAMESDATATYPE, 0, F_IMA_TYPE, &normid) != 0) {
    /* could not open the file */
    return flames_midas_error(MAREMMA);
  }
  /* write the 3D array to file */
  if (SCFPUT(normid, 1, 
          (myflats->lastorder-myflats->firstorder+1)*myflats->maxfibres*
          myflats->subcols, 
          (char *) myflats->normfactors[0][0]) != 0) {
    /* I could not write this big frame to disk: complain... */
    return flames_midas_error(MAREMMA);
  }
  /* write the standard descriptors */
  /* initialise LHCUTS, otherwise MIDAS will complain*/
  fdvecbuf1 = myflats->normfactors[0][0];
  lhcuts[0] = lhcuts[1] = 0;
  minimum = maximum = fdvecbuf1[0];
  for (iorderifibreixindex=1; iorderifibreixindex<=iorderifibreixend; 
       iorderifibreixindex++) {
    fbuf1 = (float) fdvecbuf1[iorderifibreixindex];
    if (fbuf1<minimum) minimum = fbuf1;
    if (fbuf1>maximum) maximum = fbuf1;
  }
  lhcuts[2] = minimum;
  lhcuts[3] = maximum;
  /* write the LHCUTS descriptor */
  if ((status = SCDWRR(normid, "LHCUTS", lhcuts, 1, 4, &null)) != 0) {
    /* I could not write the descriptor: complain... */
    return flames_midas_error(MAREMMA);
  }
  /* all right, close normalisation frame */
  if (SCFCLO(normid) != 0) {
    /* problems closing common frame */
    return flames_midas_error(MAREMMA);
  }

  /* create the normalisation sigmas frame on disk */
  if (SCFOPN(nsigmaname, FLAMESDATATYPE, 0, F_IMA_TYPE, &nsigid) != 0) {
    /* could not open the file */
    return flames_midas_error(MAREMMA);
  }
  /* write the 3D array to file */
  if (SCFPUT(nsigid, 1, 
         (myflats->lastorder-myflats->firstorder+1)*myflats->maxfibres*
         myflats->subcols, 
         (char *) myflats->normsigmas[0][0]) != 0) {
    /* I could not write this big frame to disk: complain... */
    return flames_midas_error(MAREMMA);
  }
  /* initialise LHCUTS, otherwise MIDAS will complain*/
  fdvecbuf1 = myflats->normsigmas[0][0];
  lhcuts[0] = lhcuts[1] = 0;
  minimum = maximum = fdvecbuf1[0];
  for (iorderifibreixindex=1; iorderifibreixindex<=iorderifibreixend; 
       iorderifibreixindex++) {
    fbuf1 = (float) fdvecbuf1[iorderifibreixindex];
    if (fbuf1<minimum) minimum = fbuf1;
    if (fbuf1>maximum) maximum = fbuf1;
  }
  lhcuts[2] = minimum;
  lhcuts[3] = maximum;
  /* write the LHCUTS descriptor */
  if ((status = SCDWRR(nsigid, "LHCUTS", lhcuts, 1, 4, &null)) != 0) {
    /* I could not write the descriptor: complain... */
    return flames_midas_error(MAREMMA);
  }
  /* close this frame */
  if ((status = SCFCLO(nsigid)) != 0) {
    /* error closing common frame: complain */
    return flames_midas_error(MAREMMA);
  }

  return NOERR;

}
