/*                                                                           *
 *   This file is part of the ESO X-shooter Pipeline                         *
 *   Copyright (C) 2006 European Southern Observatory                        *
 *                                                                           *
 *   This library 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, 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA    *
 *                                                                           */

/*
 * $Author: amodigli $
 * $Date: 2013-04-17 09:07:36 $
 * $Revision: 1.224 $
 * $Name: not supported by cvs2svn $
 */

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

/*---------------------------------------------------------------------------*/
/**
 * @defgroup xsh_dfs  DFS related functions
 * @ingroup xsh_tools
 *
 */
/*---------------------------------------------------------------------------*/


/*----------------------------------------------------------------------------
  Includes
  ----------------------------------------------------------------------------*/

#include <xsh_dfs.h>
#include <xsh_pfits.h>
#include <xsh_pfits_qc.h>
#include <xsh_data_pre.h>
#include <xsh_data_pre_3d.h>
#include <xsh_error.h>
#include <xsh_msg.h>
#include <cpl.h>
#include <stdio.h>
#include <string.h>
#include <strings.h>
#include <time.h>
#include <math.h>
#include <assert.h>
#include <ctype.h>
#include <errno.h>
#include <xsh_paf_save.h>
#include <xsh_utils_table.h>
#include <xsh_utils_image.h>
#include <xsh_utils.h>
#include <xsh_data_spectrum.h>
#include <irplib_sdp_spectrum.h>

/*----------------------------------------------------------------------------
  Function prototypes
  ----------------------------------------------------------------------------*/

static cpl_frame *xsh_find_frame (cpl_frameset * frames,
				  const char *tags[]);


/**@{*/

cpl_error_code
xsh_dfs_fix_key_start_end(cpl_frameset* set, cpl_propertylist* head)
{

  cpl_frameset* raws=NULL;
  raws=cpl_frameset_new();
  xsh_dfs_extract_raw_frames(set,raws);
  check( xsh_pfits_combine_headers(head,raws));

  xsh_free_frameset(&raws);
 cleanup:
  return cpl_error_get_code();

}

 /**
    @brief    Check if an input parameter has been changed by the user
    @param    p input parameter
    @return  if has not changed 0, else 1;
 */
int 
xsh_parameter_get_default_flag(const cpl_parameter* p) {
   int flag_gasgano=0;
   int flag_norm=0;
   int flag=0;
   cpl_type type =0;

   flag_norm = (cpl_parameter_get_default_flag(p) == 0) ? 1 : 0; 
   type=cpl_parameter_get_type(p);

   switch(type) {
      case CPL_TYPE_BOOL:
         flag_gasgano = (cpl_parameter_get_default_bool(p) ==
                 cpl_parameter_get_bool(p)) ? 1:0;
         break;
      case CPL_TYPE_INT:
         flag_gasgano = (cpl_parameter_get_default_int(p) == 
                 cpl_parameter_get_int(p)) ? 1:0;
         break;
      case CPL_TYPE_DOUBLE:
         flag_gasgano = (cpl_parameter_get_default_double(p) == 
                 cpl_parameter_get_double(p)) ? 1:0;
         break;
      case CPL_TYPE_STRING:
         flag_gasgano = (cpl_parameter_get_default_string(p) == 
                 cpl_parameter_get_string(p)) ? 1:0;
         break;

      default:
         xsh_msg_error("type not supported");
   }

   flag = (flag_gasgano && flag_norm) ? 0 : 1;
 
   return flag;
}

static cpl_error_code
xsh_clean_header(cpl_propertylist* header)
{
    cpl_propertylist_erase_regexp(header, "^(COMMENT|CHECKSUM|DATASUM)$",0);
    return cpl_error_get_code();
}

 /**
    @brief    Validate model cfg
    @param    mod model cfg frame
    @param    set input frameset
    @return   a new allocated frameset filled by frame tables.
 */
cpl_error_code 
xsh_validate_model_cfg(cpl_frame* mod, cpl_frameset* set) {

  const char* mod_name=NULL;
  const char* raw_name=NULL;
  cpl_frame* raw_frame=0;
  cpl_propertylist* mod_header=NULL;
  //cpl_propertylist* raw_header=NULL;
  double mod_mjd=0;
  double raw_mjd=0;

  raw_frame=cpl_frameset_get_frame(set,0);

  mod_name=cpl_frame_get_filename(mod);
  mod_header=cpl_propertylist_load(mod_name,0);
  mod_mjd=xsh_pfits_get_mjdobs(mod_header);

  raw_name=cpl_frame_get_filename(raw_frame);
  //raw_header=cpl_propertylist_load(mod_name,0);
  check(raw_mjd=xsh_pfits_get_mjdobs(mod_header));

  if(raw_mjd < mod_mjd) {

    xsh_msg_warning("Raw frame %s has MJD-OBS  prior than model cfg frame %s",
		    raw_name,mod_name);
    xsh_msg_warning("The user should use a model cfg frame corresponding to a more recent period");
  }

 cleanup:
   return cpl_error_get_code();

 }

 /**
    @brief    Extract frameset sub set containing only table frames
    @param    set input frameset
    @return   a new allocated frameset filled by frame tables.
 */
 cpl_frameset* 
 xsh_frameset_ext_table_frames(cpl_frameset* set) {
   cpl_frameset* result=NULL;
   int nset=0;
   int i=0;
   cpl_frame* frm=NULL;
   cpl_propertylist* plist=NULL;
   const char* name=NULL;
   int naxis=0;
 
   check(nset=cpl_frameset_get_size(set));
   result=cpl_frameset_new();
   for(i=0;i<nset;i++) {
     check(frm=cpl_frameset_get_frame(set,i));
     check(name=cpl_frame_get_filename(frm));
     check(plist=cpl_propertylist_load(name,0));
     check(naxis=xsh_pfits_get_naxis(plist));
     if(naxis==0) {
       check(cpl_frameset_insert(result,cpl_frame_duplicate(frm)));
     }
     xsh_free_propertylist(&plist);
   }
 
  cleanup:
 
   return result;
 }
 
/*----------------------------------------------------------------------------*/
/**
 * @brief
 *   Check if all SOF files exist
 *
 * @param frameset The input set-of-frames
 *
 * @return 1 if not all files exist, 0 if they all exist.
 *
 */
/*----------------------------------------------------------------------------*/
int xsh_dfs_files_dont_exist(cpl_frameset *frameset)
{
    const char *func = "dfs_files_dont_exist";
    cpl_frame  *frame;


    if (frameset == NULL) {
        cpl_error_set(func, CPL_ERROR_NULL_INPUT);
        return 1;
    }

    if (cpl_frameset_is_empty(frameset)) {
        return 0;
    }

    cpl_frameset_iterator* it = cpl_frameset_iterator_new(frameset);
    frame = cpl_frameset_iterator_get(it);
    while (frame) {
        if (access(cpl_frame_get_filename(frame), F_OK)) {
            cpl_msg_error(func, "File %s (%s) was not found", 
                          cpl_frame_get_filename(frame), 
                          cpl_frame_get_tag(frame));
            cpl_error_set(func, CPL_ERROR_FILE_NOT_FOUND);
        }
        cpl_frameset_iterator_advance(it, 1);
        frame = cpl_frameset_iterator_get(it);
    }
    cpl_frameset_iterator_delete(it);

    if (cpl_error_get_code())
        return 1;

    return 0;
}

/**
   @brief    Extract frameset sub set containing only table frames
   @param    set input frameset
   @return   a new allocated frameset filled by frame tables.
*/
cpl_frameset*
xsh_frameset_ext_image_frames(cpl_frameset* set) {
  cpl_frameset* result=NULL;
  int nset=0;
  int i=0;
  cpl_frame* frm=NULL;
  cpl_propertylist* plist=NULL;
  const char* name=NULL;
  int naxis=0;

  check(nset=cpl_frameset_get_size(set));
  result=cpl_frameset_new();
  for(i=0;i<nset;i++) {
    check(frm=cpl_frameset_get_frame(set,i));
    check(name=cpl_frame_get_filename(frm));
    check(plist=cpl_propertylist_load(name,0));
    check(naxis=xsh_pfits_get_naxis(plist));
    if(naxis==2) {
      check(cpl_frameset_insert(result,cpl_frame_duplicate(frm)));
    }
    xsh_free_propertylist(&plist);
  }

 cleanup:

  return result;
}

/**
 @brief extract DRL specific frames from frameset
 @param    set input frameset
 @return frameset containing DRL specific frames
 */
cpl_frameset*
xsh_frameset_drl_frames(cpl_frameset* set) {
  cpl_frameset* result=NULL;
  int nset=0;
  int i=0;
  cpl_frame* frm=NULL;
  cpl_propertylist* plist=NULL;
  const char* name=NULL;
  int naxis=0;

  check(nset=cpl_frameset_get_size(set));
  result=cpl_frameset_new();
  for(i=0;i<nset;i++) {
    check(frm=cpl_frameset_get_frame(set,i));
    check(name=cpl_frame_get_filename(frm));
    check(plist=cpl_propertylist_load(name,0));
    check(naxis=xsh_pfits_get_naxis(plist));
    if(naxis==0) {
      check(cpl_frameset_insert(result,cpl_frame_duplicate(frm)));
    }
    xsh_free_propertylist(&plist);
  }

 cleanup:

  return result;
}
/**
   @brief    Make sure input frames is an even number (eventually removes the last from the input list)
   @param    raws input value
   @param    instrument arm setting
   @return   cpl_error_code
*/
cpl_error_code
xsh_ensure_raws_input_offset_recipe_is_proper(cpl_frameset** raws,
					      xsh_instrument* instrument)
{
  int nraws=0;
  cpl_frameset* obj=NULL;
  cpl_frameset* sky=NULL;
  const char * obj_tag=NULL;
  const char * sky_tag=NULL;
  int nobj=0;
  int nsky=0;
  int i=0;
  int ndif=0;
  cpl_frame* frm=NULL;

  check(nraws=cpl_frameset_get_size(*raws));

  assure(nraws>=2, CPL_ERROR_ILLEGAL_INPUT, "Too few input frames. At least one OBJ and a SKY frame are required" );

  if(xsh_instrument_get_mode(instrument) == XSH_MODE_IFU) {
      obj_tag = XSH_GET_TAG_FROM_ARM( XSH_OBJECT_IFU_OFFSET,instrument);
  } else {
	  obj_tag = XSH_GET_TAG_FROM_ARM( XSH_OBJECT_SLIT_OFFSET,instrument);
  }

  check(obj=xsh_frameset_extract(*raws,obj_tag));
  nobj=cpl_frameset_get_size(obj);
  if(nobj==0) {
     if(xsh_instrument_get_mode(instrument) == XSH_MODE_IFU) {
        obj_tag = XSH_GET_TAG_FROM_ARM( XSH_STD_FLUX_IFU_OFFSET,instrument);
     } else {
        obj_tag = XSH_GET_TAG_FROM_ARM( XSH_STD_FLUX_SLIT_OFFSET,instrument);
     }
     xsh_free_frameset(&obj);
     check(obj=xsh_frameset_extract(*raws,obj_tag));
     nobj=cpl_frameset_get_size(obj);
  }

  if(xsh_instrument_get_mode(instrument) == XSH_MODE_IFU) {
      sky_tag = XSH_GET_TAG_FROM_ARM( XSH_SKY_IFU,instrument);
  } else {
	  sky_tag = XSH_GET_TAG_FROM_ARM( XSH_SKY_SLIT,instrument);
  }
  xsh_free_frameset(&sky);
  check(sky=xsh_frameset_extract(*raws,sky_tag));


 
  nsky=cpl_frameset_get_size(sky);

  assure(nobj>0, CPL_ERROR_ILLEGAL_INPUT,
		  "Too few input obj frames. At least a OBJ frame is required" );

  assure(nsky>0, CPL_ERROR_ILLEGAL_INPUT,
		  "Too few input sky frames. At least a SKY frame is required" );

  if(nobj>nsky) {
    xsh_msg("case nobj> nsky");
     ndif=nobj-nsky;
     for(i=0;i<ndif;i++) {
        check(frm=cpl_frameset_get_frame(obj,nobj-i-1));
        check(cpl_frameset_erase_frame(obj,frm));
     }
  } else if(nsky>nobj) {
     xsh_msg("case nsky> nobj");
     ndif=nsky-nobj;
     for(i=0;i<ndif;i++) {
        check(frm=cpl_frameset_get_frame(sky,nsky-i-1));
        check(cpl_frameset_erase_frame(sky,frm));
     }
  } else {
     ndif=nsky-nobj;
  xsh_free_frameset(&obj);
  xsh_free_frameset(&sky);
  return CPL_ERROR_NONE;

  }
  xsh_free_frameset(raws);
  check(*raws=cpl_frameset_duplicate(obj));
  check(xsh_frameset_merge(*raws,sky));

 cleanup:
  xsh_free_frameset(&obj);
  xsh_free_frameset(&sky);

  return cpl_error_get_code();

}


/**
   @brief    Computes offsety
   @param    plist propertylist
   @return   offsety
*/

static double
xsh_get_offsety(cpl_propertylist* plist)
{

   double offsety=0;
   double ra_off=0;
   double dec_off=0;
   double posang=0;

   if(cpl_propertylist_has(plist,XSH_NOD_CUMULATIVE_OFFSETY)) {
      offsety=xsh_pfits_get_cumoffsety(plist);
   } else {
      ra_off=xsh_pfits_get_ra_cumoffset(plist);
      dec_off=xsh_pfits_get_dec_cumoffset(plist);
      posang = xsh_pfits_get_posang(plist);
      posang = posang/180.0* M_PI;
/*
  shift_pix = xsh_round_double((cos(-posang)*dec_off+
  sin(-posang)*ra_off)/bin_space);
*/
      offsety=(cos(-posang)*dec_off+
               sin(-posang)*ra_off);
      xsh_msg("ra_off=%f,dec_off=%f,offsety=%f,posang=%f",
              ra_off,dec_off,offsety,posang);
   }

   return offsety;

}

/**
   @brief    Extract frames that has same cumoffy as offset 
   @param    raws input value
   @param    offset offset value
   @return   frameset with matching frames
*/

cpl_frameset*
xsh_frameset_extract_offsety_matches(cpl_frameset* raws,const double offset)
{
   cpl_frame* frm=NULL;
   cpl_frameset* result=NULL;
   cpl_propertylist* plist=NULL;
   double offsety=0;
   const char* name=NULL;
   int nraw=0;
   int i=0;
 
   XSH_ASSURE_NOT_NULL_MSG(raws,"null input frameset");
   nraw=cpl_frameset_get_size(raws);
   result=cpl_frameset_new();
   for(i=0;i<nraw;i++) {
      frm=cpl_frameset_get_frame(raws,i);
      name=cpl_frame_get_filename(frm);
      plist=cpl_propertylist_load(name,0);
      offsety=xsh_get_offsety(plist);
       
      if(fabs(offsety-offset)<1.E-8) {
         cpl_frameset_insert(result,cpl_frame_duplicate(frm));
      }
      xsh_free_propertylist(&plist);
   }

 cleanup:
      xsh_free_propertylist(&plist);

  return result;

}



/**
   @brief    Extract frames that has different cumoffy than offset 
   @param    raws input value
   @param    offset offset value
   @return   frameset with not matching frames
*/

cpl_frameset*
xsh_frameset_extract_offsety_mismatches(cpl_frameset* raws,const double offset)
{
   cpl_frame* frm=NULL;
   cpl_frameset* result=NULL;
   cpl_propertylist* plist=NULL;
   double offsety=0;
   const char* name=NULL;
   int nraw=0;
   int i=0;

   double ra_off=0;
   double dec_off=0;
   double posang=0;
 
   XSH_ASSURE_NOT_NULL_MSG(raws,"null input frameset");
   nraw=cpl_frameset_get_size(raws);
   result=cpl_frameset_new();
   for(i=0;i<nraw;i++) {
      frm=cpl_frameset_get_frame(raws,i);
      name=cpl_frame_get_filename(frm);
      plist=cpl_propertylist_load(name,0);
      if(cpl_propertylist_has(plist,XSH_NOD_CUMULATIVE_OFFSETY)) {
         offsety=xsh_pfits_get_cumoffsety(plist);
      } else {
         ra_off=xsh_pfits_get_ra_cumoffset(plist);
         dec_off=xsh_pfits_get_dec_cumoffset(plist);
         posang = xsh_pfits_get_posang(plist);
         posang = posang/180.0* M_PI;
/*
         shift_pix = xsh_round_double((cos(-posang)*dec_off+
                                       sin(-posang)*ra_off)/bin_space);
*/
         offsety=(cos(-posang)*dec_off+
                  sin(-posang)*ra_off);
         xsh_msg("ra_off=%f,dec_off=%f,offsety=%f,posang=%f",
                 ra_off,dec_off,offsety,posang);
      }
      if(offsety!=offset) {
         cpl_frameset_insert(result,cpl_frame_duplicate(frm));
      }
      xsh_free_propertylist(&plist);
   }

 cleanup:
      xsh_free_propertylist(&plist);

  return result;

}

/**
   @brief    Make sure input frames is composed by nod a-b sequence 
   @param    raws input value
   @param    offset vector with different offset values
   @return   frameset with a-b sequence frames
*/
cpl_frameset*
xsh_extract_nod_pairs(cpl_frameset* raws, 
                      cpl_vector* offset)
{
  int nraws=0;
  cpl_frameset* set_a=NULL;
  cpl_frameset* set_b=NULL;
  cpl_frameset* result=NULL;
  cpl_propertylist* plist=NULL;
  double offsety_a=0;


  int na=0;
  int nb=0;
  int i=0;
  int j=0;
  int k=0;
  cpl_frame* frm_a=NULL;
  cpl_frame* frm_b=NULL;
  cpl_frame* frm_tmp=NULL;
  double mjd_obs_a=0;
  double mjd_obs_b=0;
  double mjd_obs_tmp=0;
  const char* name=NULL;
  int noff=0;
  double mjd_obs_ref=-999999.;
   XSH_ASSURE_NOT_NULL_MSG(raws,"null input frameset");

  check(nraws=cpl_frameset_get_size(raws));
  xsh_msg("nraws=%d",nraws);
  assure(nraws>=2, CPL_ERROR_ILLEGAL_INPUT,
		  "Too few input frames. At least two NOD positions are required" );

  noff=cpl_vector_get_size(offset);
  result=cpl_frameset_new();
  for(i=0;i<noff;i++) {
     offsety_a=cpl_vector_get(offset,i);
     xsh_msg("offsety_a=%f",offsety_a);
     xsh_free_frameset(&set_a);
     xsh_free_frameset(&set_b);
     check(set_a=xsh_frameset_extract_offsety_matches(raws,offsety_a));
     check(set_b=xsh_frameset_extract_offsety_mismatches(raws,offsety_a));
  
     na=cpl_frameset_get_size(set_a);
     nb=cpl_frameset_get_size(set_b);
     xsh_msg("na=%d nb=%d",na,nb);
     for(k=0;k<na;k++) {
    
        check(frm_a=cpl_frameset_get_frame(set_a,k));
        check(name=cpl_frame_get_filename(frm_a));
        check(plist=cpl_propertylist_load(name,0));
        check(mjd_obs_a=xsh_pfits_get_mjdobs(plist));
        xsh_free_propertylist(&plist);


       /* get the closest in mjd-obs */
        mjd_obs_b=mjd_obs_ref;
        for(j=0;j<nb;j++) {

           check(frm_tmp=cpl_frameset_get_frame(set_b,j));
           check(name=cpl_frame_get_filename(frm_tmp));
           check(plist=cpl_propertylist_load(name,0));
           check(mjd_obs_tmp=xsh_pfits_get_mjdobs(plist));

           if(fabs(mjd_obs_tmp-mjd_obs_a) < fabs(mjd_obs_b-mjd_obs_a)) {
              mjd_obs_b=mjd_obs_tmp;
              frm_b=frm_tmp;
           }
        }


        cpl_frameset_erase_frame(raws,frm_a);

/*
        xsh_msg("before");
        xsh_frameset_dump(raws);
        xsh_msg("after");
        xsh_frameset_dump(raws);
        */
        cpl_frameset_erase_frame(raws,frm_b);
        cpl_frameset_insert(result,cpl_frame_duplicate(frm_a));
        cpl_frameset_insert(result,cpl_frame_duplicate(frm_b));
        xsh_free_frameset(&set_a);
        xsh_free_frameset(&set_b);
        check(set_a=xsh_frameset_extract_offsety_matches(raws,offsety_a));
        check(set_b=xsh_frameset_extract_offsety_mismatches(raws,offsety_a));
        na=cpl_frameset_get_size(set_a);
        nb=cpl_frameset_get_size(set_b);

        xsh_msg("check again na=%d nb=%d",na,nb);

     }
     xsh_msg("ok0 i=%d",i);

  }

 cleanup:
  xsh_free_frameset(&set_a);
  xsh_free_frameset(&set_b);
  xsh_free_propertylist(&plist);


  return result;

}




/**
   @brief    Make sure input frames is composed by obj-sky pairs
   @param    raws input value
   @param    instrument arm
   @return   cpl_error_code
*/
cpl_frameset*
xsh_extract_obj_and_sky_pairs(cpl_frameset* raws, xsh_instrument* instrument)
{
  int nraws=0;
  cpl_frameset* obj=NULL;
  cpl_frameset* sky=NULL;
  cpl_frameset* result=NULL;
  cpl_propertylist* plist=NULL;

  const char * obj_tag=NULL;
  const char * sky_tag=NULL;
  int nobj=0;
  int nsky=0;
  int i=0;
  int j=0;
  cpl_frame* frm_obj=NULL;
  cpl_frame* frm_sky=NULL;
  cpl_frame* frm_tmp=NULL;
  double mjdobs_obj=0;
  double mjdobs_sky=0;
  double mjdobs_tmp=0;
  const char* name=NULL;

  check(nraws=cpl_frameset_get_size(raws));
  xsh_msg("nraws=%d",nraws);
  assure(nraws>=2, CPL_ERROR_ILLEGAL_INPUT,
		  "Too few input frames. At least one OBJ and a SKY frame are required");
  if(xsh_instrument_get_mode(instrument) == XSH_MODE_IFU) {
      obj_tag = XSH_GET_TAG_FROM_ARM( XSH_OBJECT_IFU_OFFSET,instrument);
      sky_tag = XSH_GET_TAG_FROM_ARM( XSH_SKY_IFU,instrument);
  } else {
	  obj_tag = XSH_GET_TAG_FROM_ARM( XSH_OBJECT_SLIT_OFFSET,instrument);
	  sky_tag = XSH_GET_TAG_FROM_ARM( XSH_SKY_SLIT,instrument);
  }

  check(obj=xsh_frameset_extract(raws,obj_tag));
  check(sky=xsh_frameset_extract(raws,sky_tag));

  nobj=cpl_frameset_get_size(obj);
  nsky=cpl_frameset_get_size(sky);

  assure(nobj>0, CPL_ERROR_ILLEGAL_INPUT,
		  "Too few input obj frames. At least a OBJ frame is required" );

  assure(nsky>0, CPL_ERROR_ILLEGAL_INPUT,
		  "Too few input sky frames. At least a SKY frame is required" );

  result=cpl_frameset_new();
  for(i=0;i<nobj;i++) {
    check(frm_obj=cpl_frameset_get_frame(obj,i));
    check(name=cpl_frame_get_filename(frm_obj));
    check(plist=cpl_propertylist_load(name,0));
    check(mjdobs_obj=xsh_pfits_get_mjdobs(plist));
    xsh_free_propertylist(&plist);


    check(frm_sky=cpl_frameset_get_frame(sky,0));
    check(name=cpl_frame_get_filename(frm_sky));
    check(plist=cpl_propertylist_load(name,0));
    check(mjdobs_sky=xsh_pfits_get_mjdobs(plist));
    xsh_free_propertylist(&plist);
    cpl_frameset_insert(result,cpl_frame_duplicate(frm_obj));

    for(j=1;j<nsky;j++) {
      check(frm_tmp=cpl_frameset_get_frame(sky,j));
      check(name=cpl_frame_get_filename(frm_tmp));
      check(plist=cpl_propertylist_load(name,0));
      check(mjdobs_tmp=xsh_pfits_get_mjdobs(plist));

      if(fabs(mjdobs_tmp-mjdobs_obj) < fabs(mjdobs_sky-mjdobs_obj)) {
        mjdobs_sky=mjdobs_tmp;
        frm_sky=frm_tmp;
      }
    }
    cpl_frameset_insert(result,cpl_frame_duplicate(frm_sky));
  }


 cleanup:
  xsh_free_frameset(&obj);
  xsh_free_frameset(&sky);
  xsh_free_propertylist(&plist);

  return result;

}

/**
   @brief    Make sure input frames is an even number
   (eventually removes the last from the input list)
   @param    raws input value
   @return   cpl_error_code
*/
cpl_frame*
xsh_ensure_raws_number_is_even(cpl_frameset* raws)
{
  int nraws=0;
  cpl_frame* rejected=NULL;
  cpl_frame* frame1=NULL;  
  cpl_frame* frame2=NULL;
  cpl_frame* frameN=NULL;
  cpl_propertylist* plist1=NULL;
  cpl_propertylist* plist2=NULL;
  cpl_propertylist* plistN=NULL;
  const char* name1=NULL;
  const char* name2=NULL;
  const char* nameN=NULL;
  double yshift1=0;
  double yshift2=0;
  double yshiftN=0;

  //rejected=cpl_frameset_new();
  check(nraws=cpl_frameset_get_size(raws));
  if ( (nraws % 2) != 0 ) {
     xsh_msg_warning("odd number of frames: nraws=%d",nraws);
     check(frame1=cpl_frameset_get_frame(raws,0));
     check(frame2=cpl_frameset_get_frame(raws,1));
     check(frameN=cpl_frameset_get_frame(raws,nraws-1));
     check(name1=cpl_frame_get_filename(frame1));
     check(name2=cpl_frame_get_filename(frame2));
     check(nameN=cpl_frame_get_filename(frameN));
     check(plist1=cpl_propertylist_load(name1,0));
     check(plist2=cpl_propertylist_load(name2,0));
     check(plistN=cpl_propertylist_load(nameN,0));
     check(yshift1=xsh_get_offsety(plist1));
     check(yshift2=xsh_get_offsety(plist2));
     check(yshiftN=xsh_get_offsety(plistN));
     /*
     xsh_msg("yshift1=%g",yshift1);
     xsh_msg("yshift2=%g",yshift2);
     xsh_msg("yshiftN=%g",yshiftN);
     */
    if(yshift1 == yshiftN) {
       xsh_msg_warning("yshift(Frame1)==yshift(FrameN)");
       if ( fabs(yshift1-yshift2) <= DBL_MIN ) {
          xsh_msg_warning("yshift(Frame1)==yshift(Frame2)");
          xsh_msg_warning("Remove last from list. Frame %s",
                          cpl_frame_get_filename(frameN));
          cpl_frameset_erase_frame(raws,frameN);
          rejected=frameN;
       } else {
          xsh_msg_warning("yshift(Frame1)!=yshift(Frame2)");
          xsh_msg_warning("Remove first from list. Frame %s",
                          cpl_frame_get_filename(frame1));
          cpl_frameset_erase_frame(raws,frame1);
          rejected=frame1;
       }
    } else {
       xsh_msg_warning("yshift(Frame1)!=yshift(FrameN)");
       if (fabs(yshift1 - yshift2) <= DBL_MIN) {
         xsh_msg_warning("yshift(Frame1)==yshift(Frame2)");
         xsh_msg_warning("Remove first from list. Frame %s",
                          cpl_frame_get_filename(frame1));
          cpl_frameset_erase_frame(raws,frame1);
          rejected=frame1;
      } else {
         xsh_msg_warning("yshift(Frame1)!=yshift(Frame2)");
         xsh_msg_warning("Remove last from list. Frame %s",
                          cpl_frame_get_filename(frameN));
          cpl_frameset_erase_frame(raws,frameN);
          rejected=frameN;
      }
    }
  }

 cleanup:
  xsh_free_propertylist(&plist1);
  xsh_free_propertylist(&plist2);
  xsh_free_propertylist(&plistN);

  return rejected;

}
/**
   @brief    Check if an error has happened and returns error kind and location
   @param    val input value
   @return   0 if no error is detected,-1 else
*/
int 
xsh_print_rec_status(const int val) {
   if(cpl_error_get_code() != CPL_ERROR_NONE) {
      xsh_msg_error("Recipe status at %d",val);
      xsh_msg_error("%s",(const char*) cpl_error_get_message());
      xsh_msg_error("%s",(const char*) cpl_error_get_where());
      return -1;
   }
   return 0;
}


/**
   @brief    Define a frame characteristics
   @param    fname frame filename
   @param    tag   frame tag
   @param    type  frame type
   @param    group frame group
   @param    level frame level
   @param    frame output frame
   @return   0 if no error is detected,-1 else
*/

void
xsh_frame_config(const char* fname, 
                 const char* tag, 
                 cpl_frame_type type, 
                 cpl_frame_group group, 
                 cpl_frame_level level, 
                 cpl_frame** frame)
{

  check(cpl_frame_set_filename(*frame,fname));
  check(cpl_frame_set_tag(*frame,tag));
  check(cpl_frame_set_type(*frame,type));
  check(cpl_frame_set_group(*frame,group));
  check(cpl_frame_set_level(*frame,level));

  cleanup:

  return;

}
/**
   @brief    Creates a frame with given characteristics
   @param    fname frame filename
   @param    tag   frame tag
   @param    type  frame type
   @param    group frame group
   @param    level frame level

   @return   0 if no error is detected,-1 else
*/
cpl_frame* 
xsh_frame_product(const char* fname, const char* tag, cpl_frame_type type, 
                  cpl_frame_group group,cpl_frame_level level)
{
  cpl_frame* frame=NULL;
  check(frame=cpl_frame_new());

  check(xsh_frame_config(fname,tag,type,group,level,&frame));

  return frame;

 cleanup:
    xsh_free_frame(&frame);

    return NULL;
}
/*-------------------------------------------------------------------------*/
/**
  @name     xsh_file_exists
  @memo     Find if a given file name corresponds to an existing file.
  @param    filename    Name of the file to look up.
  @return   int 1 if file exists, 0 if not
  @doc

  Find out if the given character string corresponds to a file that
  can be stat()'ed.
 */
/*--------------------------------------------------------------------------*/


int xsh_file_exists(const char * filename)
{
  int exists=0;
  FILE* fo=NULL;
  if ((fo=fopen(filename,"r"))==NULL) {
     exists=0;
   } else {
     exists=1;
   }
  if(fo != NULL ) {
     fclose(fo);
  }
   return exists;
}

/*---------------------------------------------------------------------------*/
/** 
 * @brief  Extract frames with given tag from frameset
 * @param  frames      frame set
 * @param  tag         to search for
 * @return newly allocated, possibly empty, frameset, or NULL on error
 */
/*---------------------------------------------------------------------------*/
cpl_frameset *
xsh_frameset_extract(const cpl_frameset *frames,
                       const char *tag)
{
   cpl_frameset *subset = NULL;
   const cpl_frame *f;



   assure( frames != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null frameset" );
   assure( tag    != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null tag" );
    
   subset = cpl_frameset_new();

   for (f = cpl_frameset_find_const(frames, tag);
        f != NULL;
        f = cpl_frameset_find_const(frames, NULL)) {

      cpl_frameset_insert(subset, cpl_frame_duplicate(f));
   }
  cleanup:
   return subset;
}

/**
   @brief    Extracts raw frames 
   @param    set1     The input frameset that is extended
   @param    set2     The input frameset that is merged to set1
   @return   CPL_ERROR_NONE iff ok
*/
/*----------------------------------------------------------------------------*/
cpl_error_code
xsh_frameset_merge(cpl_frameset * set1, cpl_frameset* set2)
{

   cpl_frame* frm_tmp=NULL;
   cpl_frame* frm_dup=NULL;

   passure(set1 != NULL, "Wrong input set");
  
   cpl_frameset_iterator* it = cpl_frameset_iterator_new(set2);
   frm_tmp = cpl_frameset_iterator_get(it);

   while (frm_tmp != NULL)
   {
      frm_dup=cpl_frame_duplicate(frm_tmp);
      cpl_frameset_insert(set1,frm_dup);
      cpl_frameset_iterator_advance(it, 1);
      frm_tmp = cpl_frameset_iterator_get(it);

   }
   cpl_frameset_iterator_delete(it);
  cleanup:
   return cpl_error_get_code();
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Set the group as RAW or CALIB in a frameset and return the 
   instrument detected
   @param    set     the input frameset
   @return an instrument structure which contains arm, mode and lamp
*/
/*---------------------------------------------------------------------------*/
xsh_instrument* xsh_dfs_set_groups (cpl_frameset * set)
{
  cpl_frame * cur_frame = NULL;
  xsh_instrument* instrument = NULL;
  int i;
  int nfrm;
  /* Check entries */
  assure (set != NULL, CPL_ERROR_NULL_INPUT, "Null frame set");
  assure (!cpl_frameset_is_empty(set),CPL_ERROR_ILLEGAL_INPUT,
	  "Empty frame set");
		  
  /* allocate instrument structure */
  instrument = xsh_instrument_new();
  nfrm=cpl_frameset_get_size(set);
  /* Loop on frames */
  for (i = 0; i<nfrm; i++) {
    const char *tag = NULL;
    cur_frame=cpl_frameset_get_frame(set,i);
    check(tag = cpl_frame_get_tag (cur_frame));

    /* SET GROUP */
    /* Initialize group to none */
    check(cpl_frame_set_group (cur_frame, CPL_FRAME_GROUP_NONE));

    /* RAW frames */
    if (XSH_IS_RAW (tag)) {
      check(cpl_frame_set_group (cur_frame, CPL_FRAME_GROUP_RAW));
    }
    /* CALIB frames */
    else if (XSH_IS_CALIB (tag)) {
      check(cpl_frame_set_group (cur_frame, CPL_FRAME_GROUP_CALIB));
    }
    /* UNRECOGNIZED frames */
    else {
      xsh_msg_error("Unrecognized frame tag '%s'",tag);
      check(cpl_error_set(cpl_func,CPL_ERROR_ILLEGAL_INPUT ));
      //assure(0,CPL_ERROR_ILLEGAL_INPUT, 
      //     "Unrecognized frame tag: %s", tag);
    }
    /* we have validate the tag frame like an XSH tag */
    
    /* CHECK INSTRUMENT */
   check_msg(xsh_instrument_parse_tag(instrument,tag),
	      "invalid tag %s in file %s",
	      tag, cpl_frame_get_filename (cur_frame));
  }
  /* validate arm */
  assure(xsh_instrument_get_arm(instrument)!=XSH_ARM_UNDEFINED,
         CPL_ERROR_TYPE_MISMATCH,"Arm is undefined");
  xsh_instrument_get_config( instrument ) ;
  xsh_msg( "Arm %s, Mode %s Nb Orders %d, min: %d, max: %d",
	   xsh_instrument_arm_tostring(instrument),
           xsh_instrument_mode_tostring( instrument),
	   instrument->config->orders, instrument->config->order_min,
	   instrument->config->order_max ) ;
 cleanup:
  if (cpl_error_get_code () != CPL_ERROR_NONE){
    xsh_instrument_free(&instrument);
    instrument = NULL;
  }
  return instrument;
}
/*---------------------------------------------------------------------------*/
/**
   @brief    split input sof in groups: raw and calib
   @param    input the input set of files
   @param    raws the raws file of the input set of files
   @return   cpl error code
*/
/*---------------------------------------------------------------------------*/
cpl_error_code
xsh_dfs_extract_raw_frames (cpl_frameset * input, cpl_frameset * raws)
{
  cpl_frame *cur_frame = NULL;
  int i=0;
  int nfrm=0;
  /* Loop on frames */
  nfrm=cpl_frameset_get_size(input);
  for (i=0; i < nfrm; i++) {
      cur_frame=cpl_frameset_get_frame(input,i);
    /* RAW frames */
    if (cpl_frame_get_group (cur_frame) == CPL_FRAME_GROUP_RAW) {
      cpl_frameset_insert (raws, cpl_frame_duplicate(cur_frame));
    }
  }

return cpl_error_get_code();

}
/*---------------------------------------------------------------------------*/
/**
   @brief    split input sof in groups: raw and calib
   @param    input the input set of files
   @param    calib the calib files of the input set of files
   @return   cpl error code
*/
/*---------------------------------------------------------------------------*/
cpl_error_code
xsh_dfs_extract_calib_frames (cpl_frameset * input, cpl_frameset * calib)
{
  cpl_frame *cur_frame = NULL;
  int i;
  int nfrm;
  /* Loop on frames */
  nfrm=cpl_frameset_get_size(input);

  for (i = 0; i< nfrm; i++) {
    cur_frame=cpl_frameset_get_frame(input,i);
    /* RAW frames */
    if (cpl_frame_get_group (cur_frame) == CPL_FRAME_GROUP_CALIB) {
      cpl_frameset_insert (calib, cpl_frame_duplicate(cur_frame));
    }
  }

return cpl_error_get_code();

}

/*---------------------------------------------------------------------------*/
/**
   @brief    split input sof in groups: raw and calib
   @param    input the input set of files
   @param    pros  the product files of the input set of files
   @return   cpl error code
*/
/*---------------------------------------------------------------------------*/
cpl_error_code
xsh_dfs_extract_pro_frames (cpl_frameset * input, cpl_frameset * pros)
{
  cpl_frame *cur_frame = NULL;
  int i=0;
  int nfrm=0;
  XSH_ASSURE_NOT_NULL_MSG(pros,"Null pros frameset. Alllocated it outside!");
  /* Loop on frames */
  nfrm=cpl_frameset_get_size(input);
  for (i=0;i<nfrm; i++) {
      cur_frame=cpl_frameset_get_frame(input,i);
    /* PRO frames */
    if (cpl_frame_get_group (cur_frame) == CPL_FRAME_GROUP_PRODUCT) {
      cpl_frameset_insert (pros, cpl_frame_duplicate(cur_frame));
    }
  }
  cleanup:
  return cpl_error_get_code();

}

/*---------------------------------------------------------------------------*/
/**
   @brief    split input sof in groups: raw and calib
   @param    input the input set of files
   @param    raws the raws file of the input set of files
   @param    calib the calib files of the input set of files
*/
/*---------------------------------------------------------------------------*/
void
xsh_dfs_split_in_group (cpl_frameset * input, cpl_frameset * raws,
			cpl_frameset * calib)
{
  cpl_frame *cur_frame = NULL;
  int i=0;
  int nfrm=0;
  /* Loop on frames */
  nfrm=cpl_frameset_get_size(input);

  for (i = 0; i < nfrm; i++) {
      cur_frame=cpl_frameset_get_frame(input,i);
    /* RAW frames */
    if (cpl_frame_get_group (cur_frame) == CPL_FRAME_GROUP_RAW) {
      //xsh_dfs_check_nan(cur_frame);
      cpl_frameset_insert (raws, cpl_frame_duplicate(cur_frame));
    }
    /* CALIB frames */
    else if (cpl_frame_get_group (cur_frame) == CPL_FRAME_GROUP_CALIB) {
      cpl_frameset_insert (calib, cpl_frame_duplicate(cur_frame));
    }
    /* UNRECOGNIZED frames */
    else {
      xsh_msg_error ("Unrecognized group for frame %s",
		     cpl_frame_get_filename (cur_frame));
    }
  }
}


/*---------------------------------------------------------------------------*/
/**
   @brief Extracts QTH and D2 frames from input frameset
   @param input the input set of files
   @param qth frameset with QTH frames
   @param d2 frameset with D2 frames
   @return void
*/
/*---------------------------------------------------------------------------*/
void 
xsh_dfs_split_qth_d2(cpl_frameset * input, 
		     cpl_frameset** qth,
		     cpl_frameset** d2)
{
  cpl_frame* cur_frame = NULL;
  cpl_frame* temp =NULL;
  int i=0;
  int nfrm=0;
  /* check parameters input */
  XSH_ASSURE_NOT_NULL( input);
  XSH_ASSURE_NOT_NULL( qth);
  XSH_ASSURE_NOT_NULL( d2);

  /* create frameset */
  XSH_NEW_FRAMESET( *qth);
  XSH_NEW_FRAMESET( *d2);

  nfrm=cpl_frameset_get_size(input);
  /* Loop on frames */
  for (i = 0; i < nfrm; i++) {
    const char* tag = NULL;
    cur_frame=cpl_frameset_get_frame(input,i);
    check(tag = cpl_frame_get_tag(cur_frame));
    /* ON frames */
    if ( strstr(tag,"D2") != NULL) {
      check(temp = cpl_frame_duplicate(cur_frame)); 
      check(cpl_frameset_insert(*d2, temp));
    }
    /* OFF frames */
    else if ( strstr(tag, "QTH") != NULL) {
      check(temp = cpl_frame_duplicate(cur_frame));
      check(cpl_frameset_insert(*qth, temp));
    }
    /* UNRECOGNIZED frames */
    else {
      xsh_msg_error ("Invalid tag %s for frame %s",tag,
        cpl_frame_get_filename (cur_frame));
    }
  }

  cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE){
      xsh_free_frame(&temp);
      xsh_free_frameset(d2);
      xsh_free_frameset(qth);
    }
    return;
}
/*---------------------------------------------------------------------------*/
/**
   @brief split input RAW NIR sof in ON and OFF
   @param[in] input the input RAW NIR set of files
   @param[out] on   the on files of the input set of files
   @param[out] off  the off files of the input set of files
*/
/*---------------------------------------------------------------------------*/
void xsh_dfs_split_nir(cpl_frameset * input, cpl_frameset** on,
  cpl_frameset** off)
{
  cpl_frame* cur_frame = NULL;
  cpl_frame* temp =NULL;
  int i=0;
  int nfrm=0;
  /* check parameters input */
  XSH_ASSURE_NOT_NULL(input);
  XSH_ASSURE_NOT_NULL(on);
  XSH_ASSURE_NOT_NULL(off);

  /* create frameset */
  XSH_NEW_FRAMESET(*on);
  XSH_NEW_FRAMESET(*off);
  nfrm=cpl_frameset_get_size(input);
  /* Loop on frames */
  for (i = 0; i< nfrm ; i++) {
    const char* tag = NULL;
    cur_frame = cpl_frameset_get_frame(input,i);
    check(tag = cpl_frame_get_tag(cur_frame));
    /* ON frames */
    if ( strstr(tag,"ON") != NULL) {
      check(temp = cpl_frame_duplicate(cur_frame)); 
      check(cpl_frameset_insert(*on, temp));
    }
    /* OFF frames */
    else if ( strstr(tag, "OFF") != NULL) {
      check(temp = cpl_frame_duplicate(cur_frame));
      check(cpl_frameset_insert(*off, temp));
    }
    /* UNRECOGNIZED frames */
    else {
      xsh_msg_error ("Invalid tag %s for frame %s",tag,
        cpl_frame_get_filename (cur_frame));
    }
  }

  cleanup:
    if (cpl_error_get_code() != CPL_ERROR_NONE){
      xsh_free_frame(&temp);
      xsh_free_frameset(on);
      xsh_free_frameset(off);
    }
    return;
}

/*---------------------------------------------------------------------------*/
/**
   @brief split input RAW offset sof in OBJECT_... and SKY_... framesets
   @param[in] input input frameset
   @param[in] object_tag  The OBJECT Tag
   @param[in] sky_tag The SKY Tag
   @param[out] object the object files of the input set of files
   @param[out] sky the sky files of the input set of files

   @return Number of OBJECT frames (equal nb of SKY frames)
*/
/*---------------------------------------------------------------------------*/
int 
xsh_dfs_split_offset(cpl_frameset * input, 
		     const char * object_tag,
		     const char * sky_tag,
		     cpl_frameset ** object,
		     cpl_frameset ** sky)
{
  cpl_frame* cur_frame = NULL;
  cpl_frame* temp =NULL;
  int nobj = 0, nsky = 0 ;
  int i=0;
  int nfrm=0;
  /* check parameters input */
  XSH_ASSURE_NOT_NULL(input);
  XSH_ASSURE_NOT_NULL(object);
  XSH_ASSURE_NOT_NULL(sky);

  /* create frameset */
  *object=cpl_frameset_new();
  *sky=cpl_frameset_new();
  nfrm=cpl_frameset_get_size(input);
  /* Loop on frames */
  for (i = 0; i < nfrm; i++ ) {
    const char* tag = NULL;
    cur_frame=cpl_frameset_get_frame(input,i);

    check(tag = cpl_frame_get_tag(cur_frame));
    /* OBJECT frames */
    xsh_msg_dbg_medium( "Tag: %s", tag ) ;

    if ( strstr(tag, object_tag) != NULL) {
      check(temp = cpl_frame_duplicate(cur_frame)); 
      check(cpl_frameset_insert(*object, temp));
      nobj++ ;
    }
    /* OFF frames */
    else if ( strstr(tag, sky_tag) != NULL) {
      check(temp = cpl_frame_duplicate(cur_frame));
      check(cpl_frameset_insert(*sky, temp));
      nsky++ ;
    }
    /* UNRECOGNIZED frames */
    else {
      xsh_msg_error ("Invalid tag %s for frame %s",tag,
        cpl_frame_get_filename (cur_frame));
    }

  }

  xsh_msg_dbg_medium( "Nobj: %d, Nsky: %d", nobj, nsky ) ;
  XSH_ASSURE_NOT_ILLEGAL( nobj == nsky ) ;

  cleanup:

    if (cpl_error_get_code() != CPL_ERROR_NONE){
       xsh_print_rec_status(0);
      xsh_free_frame(&temp);
      return 0 ;
    }
    return nobj ;
}



/*---------------------------------------------------------------------------*/
/**
  @brief creates tag value based on tag prefix or uses frame tag
  @param pcatg_prefix tag prefix
  @param frame product frame
*/

static const char* 
xsh_create_final_tag(const char* pcatg_prefix, xsh_instrument* inst, 
                     const cpl_frame* frame)
{


   const char* pro_catg=NULL;
  /* set the procatg */
  if(pcatg_prefix==NULL) {
     pro_catg = cpl_frame_get_tag (frame);
  } else {
     pro_catg=xsh_stringcat_any(pcatg_prefix,"_",
    		 xsh_instrument_arm_tostring(inst),"" ) ;
  }
 
  return pro_catg;
}
/*---------------------------------------------------------------------------*/
/**
  @brief
    creates file name based on tag prefix
  @param prefix tag prefix
*/
static char* 
xsh_create_final_name(const char* final_prefix)
{
   char* final_name=NULL;
   time_t now ;
   char* date = NULL ;
   if ( xsh_time_stamp_get() ) {
      time( &now ) ;
      date = xsh_sdate_utc( &now ) ;
      final_name = xsh_stringcat_any( XSH_PRODUCT_PREFIX,
                                      final_prefix, "_", date, ".fits", "" ) ;
   } else if ( strstr( final_prefix, ".fits" ) == NULL ) {
      final_name=xsh_stringcat_any(XSH_PRODUCT_PREFIX,final_prefix,".fits","");
   } else {
      final_name=xsh_stringcat_any(XSH_PRODUCT_PREFIX,final_prefix, "" );
   }

   XSH_FREE(date);

   return final_name;
}

/*---------------------------------------------------------------------------*/
/**
  @brief
    check if the tag is in the tag list
  @param tag
    the tag to check
  @param tag_list
    the list of tags
  @param size size of list
  @return
    TRUE if the tag is find else false
*/
/*---------------------------------------------------------------------------*/
static bool 
xsh_dfs_tag_check( const char* tag, const char* tag_list[], int size)
{
  int i;

  for( i=0; i< size; i++){
    if ( strstr( tag, tag_list[i])!=NULL){
      return true;
    }
  }
  return false;  
}

/*---------------------------------------------------------------------------*/
/**
  @brief 
    filter the frameset with the given tag list
  @param set [IN/OUT] 
    The input set of frames
  @param tags 
    the filtered tag list
  @param size size of list
  @return void
*/
/*---------------------------------------------------------------------------*/
void 
xsh_dfs_filter( cpl_frameset * set, const char* tags[], int size){
  cpl_frame *cur_frame = NULL;

  XSH_ASSURE_NOT_NULL( set);
  XSH_ASSURE_NOT_NULL( tags);
  XSH_ASSURE_NOT_ILLEGAL( size > 0);

  /* Loop on frames */
  cpl_frameset_iterator* it = cpl_frameset_iterator_new(set);
  cur_frame = cpl_frameset_iterator_get(it);

  while(cur_frame != NULL){
    const char* ftag = NULL;

    check( ftag = cpl_frame_get_tag( cur_frame));
    if (!xsh_dfs_tag_check( ftag, tags, size)){
      cpl_frame *del_frame = NULL;
      
      del_frame = cur_frame;
      cpl_frameset_iterator_advance(it, 1);
      cur_frame = cpl_frameset_iterator_get(it);

      check( cpl_frameset_erase_frame( set, del_frame));
    }
    else{
      cpl_frameset_iterator_advance(it, 1);
      cur_frame = cpl_frameset_iterator_get(it);
    }  
  }
  cpl_frameset_iterator_delete(it);

  cleanup:
    return;
}   

/*---------------------------------------------------------------------------*/
/**
   @brief    Extracts pre frames from a frameset 
   @param    frameset the set of files
   @param    prefix the pre frame prefix 

   @return   the frameset with pre frames
*/
/*---------------------------------------------------------------------------*/
cpl_frameset *
xsh_frameset_extract_pre(cpl_frameset * frameset, const char* prefix)
{
   cpl_frameset* set=NULL;
   cpl_frame* current=NULL;
   cpl_frame* found=NULL;
   int sz=0;
   int i=0;
   char tag[256];
   char name[256];

   check(sz=cpl_frameset_get_size(frameset));
 
   check(set=cpl_frameset_new());
   for(i=0;i<sz;i++) {
    check( current = cpl_frameset_get_frame(frameset, i));
    sprintf(name, "%s_PRE_%d.fits", prefix, i);
    sprintf(tag, "%s_PRE_%d", prefix, i);

    if(xsh_file_exists(name) == 1) {
       check(found=cpl_frame_duplicate(current));
       check( cpl_frame_set_filename(found, name) );
       cpl_frameset_insert(set,found);
    }

   }
  cleanup:

   return set;

}

/*---------------------------------------------------------------------------*/
/**
   @brief    find the bad pixel map in a set of files
   @param    set the set of files
   @return   the bad pixel map or NULL if not found
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_bpmap (cpl_frameset * set)
{
  cpl_frame *cur_frame = NULL;
  int i=0;
  int nfrm=0;

  nfrm=cpl_frameset_get_size(set);
  /* Loop on frames */
  for (i = 0; i < nfrm; i++) {
    cur_frame = cpl_frameset_get_frame(set,i);
    if (strstr (cpl_frame_get_tag (cur_frame), "BADPIXEL_MAP")) {
      return cur_frame;
    }
  }
  return NULL;
}


/*---------------------------------------------------------------------------*/
/**
 *    @brief    find the master bad pixel map in a set of files
 *    @param    set the set of files
 *    @return   the bad pixel map or NULL if not found
 */
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_master_bpmap (cpl_frameset * set)
{
  cpl_frame *cur_frame = NULL;
  int i=0;
  int nfrm=0;

  nfrm=cpl_frameset_get_size(set);
  /* Loop on frames */
  for (i = 0; i < nfrm; i++) {
      cur_frame=cpl_frameset_get_frame(set,i);
    if (strstr (cpl_frame_get_tag (cur_frame), XSH_MASTER_BP_MAP)) {
      return cur_frame;
    }
  }
  return NULL;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    find the off frame in set of files
   @param    set the set of files
   @return   the off frame or NULL if not found
*/
/*---------------------------------------------------------------------------*/
cpl_frame * xsh_find_off(cpl_frameset* set)
{
  cpl_frame *cur_frame = NULL;
  int i=0;
  int nfrm=0;

  nfrm=cpl_frameset_get_size(set);
  /* Loop on frames */
  for (i=0;i<nfrm; i++) {
      cur_frame=cpl_frameset_get_frame(set,i);
    if (strstr (cpl_frame_get_tag (cur_frame), "OFF")) {
      return cur_frame;
    }
  }
  return NULL;
}

/*---------------------------------------------------------------------------*/
/**
   @brief    find the on frame in set of files
   @param    set the set of files
   @return   the on frame or NULL if not found
*/
/*---------------------------------------------------------------------------*/
cpl_frame * xsh_find_on(cpl_frameset* set)
{
  cpl_frame *cur_frame = NULL;
  int i=0;
  int nfrm=0;
  nfrm=cpl_frameset_get_size(set);
  /* Loop on frames */
  for (i = 0; i< nfrm; i++) {
      cur_frame=cpl_frameset_get_frame(set,i);
    if (strstr (cpl_frame_get_tag (cur_frame), "ON")) {
      return cur_frame;
    }
  }
  return NULL;
}
/*---------------------------------------------------------------------------*/
/**
   @brief find the flat set of files in the input SOF and detect the mode of
   instrument. This function assure that all flat files have the same tag
   @param raws set of file where we want to do the search
   @param flat frameset contains only flat
*/
/*---------------------------------------------------------------------------*/
void
xsh_dfs_find_flat(cpl_frameset* raws,cpl_frameset* flat)
{
  cpl_frame *cur_frame = NULL;
  const char* tag = NULL;
  int i=0;
  int nfrm=0;

  /* check input */
  assure (raws != NULL, CPL_ERROR_NULL_INPUT, "Null frameset");
  assure (flat != NULL, CPL_ERROR_NULL_INPUT, "Null frameset");
  
  /* init */
  nfrm=cpl_frameset_get_size(raws);
  /* Loop on frames */
  for (i = 0; i < nfrm; i++)
    {
      cur_frame=cpl_frameset_get_frame(raws,i);
      tag = cpl_frame_get_tag (cur_frame);
      if (strstr(tag,"FLAT")!=NULL)
	cpl_frameset_insert (flat, cur_frame);
    }
  
 cleanup:
  return;
  
}

/*---------------------------------------------------------------------------*/
/**
   @brief    Get unique product filename
   @param    context                 The current context, or NULL
   @param    caller_id               Name of calling module
   @param    pro_catg                The PROduct CATeGory
   @return   Newly allocated unique filename.

   This function can be used to avoid overwriting existing files. It computes
   the filename depending on the current context (position in the call-tree).

   If this turns out not to be a problem, one could simply use pro_catg.fits
   as the filename.

*/
/*---------------------------------------------------------------------------*/
char *
xsh_unique_filename (const char *context, const char *caller_id,
		     const char *pro_catg)
{
  if (context != NULL) {
    //fixme: if context contains '.' replace it with '-'
    return xsh_stringcat_6 (context, "-", caller_id, "-", pro_catg, ".fits");
  }
  else {
    return xsh_stringcat_4 (caller_id, "-", pro_catg, ".fits");
  }
}


/** 
 * Save product
 * 
 * @param frame Product Frame
 * @param frameset Input Frameset
 * @param parameters Parameters list
 * @param recipe_id Recipe Identification String
 * @param instrument Instrument structure
 * @param final_prefix Final file name
 * @param type of frame (image/imagelist/table)
 */
void xsh_add_product(cpl_frame *frame, 
                     cpl_frameset * frameset,
		     const cpl_parameterlist * parameters,
		     const char *recipe_id,
		     xsh_instrument* instrument,
		     const char *final_prefix ,
		     const char* type)
{
  cpl_propertylist *primary_header = NULL;
  cpl_propertylist *tbl_header = NULL;
  int extension=0;
  const char *pro_catg = NULL;
  cpl_frame* product_frame = NULL;

  cpl_table *table = NULL ;
  cpl_image *image = NULL ;
  cpl_imagelist *imagelist = NULL ;


  const char *fname = NULL;
  char *final_name = NULL ;
  char* date = NULL ;
  /* char *paf_name = NULL ; */

  /* Check input parameters */
  XSH_ASSURE_NOT_NULL(frame);
  XSH_ASSURE_NOT_NULL(frameset);
  XSH_ASSURE_NOT_NULL(parameters);
  XSH_ASSURE_NOT_NULL(recipe_id);
  XSH_ASSURE_NOT_NULL(instrument);
  XSH_ASSURE_NOT_NULL(final_prefix);
 
  check(pro_catg = cpl_frame_get_tag (frame));
  XSH_ASSURE_NOT_NULL(pro_catg);
  
  /* Load header and imagelist of bpmap frame */
  check(fname = cpl_frame_get_filename( frame ));
  check(primary_header = cpl_propertylist_load( fname, 0 ));

  if(strcmp(type,"imagelist") == 0) {
    check(imagelist = cpl_imagelist_load( fname, CPL_TYPE_FLOAT, 0 ));
  } else if(strcmp(type,"image") == 0) {
    check(image = cpl_image_load( fname, CPL_TYPE_FLOAT, 0,0 ));
  } else if(strcmp(type,"table") == 0) {
    check(table = cpl_table_load( fname, 1,0 ));
  } else {
    xsh_msg_error("Frame type %s not supported",type);
  }
  xsh_clean_header(primary_header);
  /* update header */
  check( cpl_frame_set_group( frame, CPL_FRAME_GROUP_PRODUCT)); 
  check_msg (cpl_dfs_setup_product_header ( primary_header,
					    frame,frameset,parameters,
					    recipe_id,
					    instrument->pipeline_id,
					    instrument->dictionary,NULL),
	     "Problem in the product DFS-compliance");

  /* Create final name */
  final_name=xsh_create_final_name(final_prefix);

  xsh_msg_dbg_low( "Final product name: %s", final_name ) ;



  /* Now save file with updated header */
  if(strcmp(type,"imagelist") == 0) {
    cpl_imagelist_save(imagelist, final_name, CPL_BPP_IEEE_FLOAT, 
		       primary_header,CPL_IO_DEFAULT ) ;
  } else if(strcmp(type,"image") == 0) {
    cpl_image_save(image, final_name, CPL_BPP_IEEE_FLOAT, 
		   primary_header,CPL_IO_DEFAULT ) ;
  } else if(strcmp(type,"table") == 0) {
    check(cpl_table_save( table, primary_header, tbl_header,
			  final_name, extension ));
  }




  /*
    Save PAF
  
  paf_name = xsh_stringcat_any( final_prefix, ".paf", (void*)NULL ) ;
  XSH_ASSURE_NOT_NULL( paf_name ) ;
  check_msg( xsh_paf_save( instrument, recipe_id,
			   primary_header, paf_name, pro_catg ),
	     "Cant save PAF file" ) ;

  */


  /* Create product frame */
  if(strcmp(type,"imagelist") == 0) {
  check(product_frame=xsh_frame_product(final_name,pro_catg,
					CPL_FRAME_TYPE_IMAGE,
					CPL_FRAME_GROUP_PRODUCT,
					CPL_FRAME_LEVEL_FINAL));
  } else if(strcmp(type,"image") == 0) {
  check(product_frame=xsh_frame_product(final_name,pro_catg,
					CPL_FRAME_TYPE_IMAGE,
					CPL_FRAME_GROUP_PRODUCT,
					CPL_FRAME_LEVEL_FINAL));
  } else if(strcmp(type,"table") == 0) {
  check(product_frame=xsh_frame_product(final_name,pro_catg,
					CPL_FRAME_TYPE_TABLE,
					CPL_FRAME_GROUP_PRODUCT,
					CPL_FRAME_LEVEL_FINAL));

  }

  check(cpl_frameset_insert(frameset, product_frame));
  xsh_add_product_file(final_name);
 cleanup:
  XSH_FREE(date);  
  xsh_free_propertylist(&primary_header);
  xsh_free_image( &image ) ;
  xsh_free_imagelist( &imagelist ) ;
  xsh_free_table( &table ) ;
  XSH_FREE( final_name ) ;
  /* XSH_FREE( paf_name ) ; */
  return;
}

/** 
 * Save vector product
 * 
 * @param frame Product Frame
 * @param frameset Input Frameset
 * @param parameters Parameters list
 * @param recipe_id Recipe Identification String
 * @param instr Instrument structure
 */
void 
xsh_add_product_vector( cpl_frame *frame, 
			  cpl_frameset *frameset,
			  const cpl_parameterlist *parameters,
			  const char *recipe_id,
			  xsh_instrument* instrument,
			  const char * final_prefix)
{

  cpl_vector *vect = NULL;
  cpl_propertylist *primary_header = NULL;
  const char *pro_catg = "";
  cpl_frame* product_frame = NULL;
  const char *fname = NULL;
  char *final_name = NULL ;
  /* time_t now ; */
  char* date = NULL ;
  /* char *paf_name = NULL ; */

  /* Check input parameters */
  XSH_ASSURE_NOT_NULL(frame);
  XSH_ASSURE_NOT_NULL(frameset);
  XSH_ASSURE_NOT_NULL(parameters);
  XSH_ASSURE_NOT_NULL(recipe_id);
  XSH_ASSURE_NOT_NULL(instrument);
  XSH_ASSURE_NOT_NULL(final_prefix);
 
  check(pro_catg = cpl_frame_get_tag (frame));
  XSH_ASSURE_NOT_NULL(pro_catg);
  
  /* Load header and image of bpmap frame */
  check( fname = cpl_frame_get_filename( frame));
  check( primary_header = cpl_propertylist_load( fname, 0));
  check( vect = cpl_vector_load( fname, 0));
  xsh_clean_header(primary_header);
  /* update header */
  check( cpl_frame_set_group( frame, CPL_FRAME_GROUP_PRODUCT));
  check_msg (cpl_dfs_setup_product_header ( primary_header,
					    frame,frameset,parameters,
					    recipe_id,
					    instrument->pipeline_id,
					    instrument->dictionary,NULL),
	     "Problem in the product DFS-compliance");

  /* Create final name */
  final_name=xsh_create_final_name(final_prefix);
  xsh_msg_dbg_low( "Final product name: %s", final_name ) ;

  /* Now save file with updated header */
  check( cpl_vector_save( vect, final_name, XSH_PRE_QUAL_BPP,
    primary_header,  CPL_IO_CREATE));
 
  /* Create product frame */
  check(product_frame=xsh_frame_product(final_name,pro_catg,
					CPL_FRAME_TYPE_IMAGE,
					CPL_FRAME_GROUP_PRODUCT,
					CPL_FRAME_LEVEL_FINAL));

  check(cpl_frameset_insert(frameset, product_frame));
  xsh_add_product_file(final_name);

 cleanup:
    if (cpl_error_get_code () != CPL_ERROR_NONE) {
      xsh_free_frame( &product_frame);
      product_frame = NULL;
    }
    XSH_FREE(date);  
    xsh_free_propertylist(&primary_header);
    xsh_free_vector( &vect) ;
    XSH_FREE( final_name);  
    return;
}

/**
 * @internal
 * @brief Calculates a value for EXPTIME from the list of used frames.
 *
 * The EXPTIME value is simply the sum of EXPTIME values from individual frames.
 *
 * @param usedframes  The list of used frames to check.
 * @param arm  The instrument arm being used.
 * @return A value to use for EXPTIME or NAN it could not be computed. If an
 *      error occurred in addition then an error code will be set that can be
 *      checked with @c cpl_error_get_code.
 */
static double xsh_calculate_exptime(const cpl_frameset *usedframes,
                                    XSH_ARM arm)
{
    cpl_propertylist* keywords = NULL;
    cpl_frameset_iterator* iter = NULL;
    double total = 0;

    iter = cpl_frameset_iterator_new(usedframes);
    const cpl_frame* frame = cpl_frameset_iterator_get_const(iter);
    while (frame != NULL) {
        if (cpl_frame_get_group(frame) == CPL_FRAME_GROUP_RAW) {
            /* Load the primary header keywords from the raw frame. */
            const char* filename;
            check(filename = cpl_frame_get_filename(frame));
            check(keywords = cpl_propertylist_load(filename, 0));
            /* Extract the EXPTIME keyword and add it to the sum. */
            double exptime, dit;
            int ndit, nditskip;
            switch (arm) {
                case XSH_ARM_NIR:
                    check(dit = cpl_propertylist_get_double(keywords, XSH_DET_DIT));
                    check(ndit = cpl_propertylist_get_int(keywords, XSH_DET_NDIT));
                    check(nditskip = cpl_propertylist_get_int(keywords,
                                                              XSH_DET_NDITSKIP));
                    if (nditskip == 0) {
                        exptime = dit * ndit;
                    } else {
                        xsh_msg_warning("Found '%s' with a non zero value. Do not know how"
                                        " to handle this case so will not set '%s'. This keyword must"
                                        " be set manually.", XSH_DET_NDITSKIP, XSH_EXPTIME);
                        goto cleanup;
                    }
                    break;
                default:
                    check(exptime = cpl_propertylist_get_double(keywords, XSH_EXPTIME));
                    break;
            }
            /* PIPE-8857: Make sure that we are only counting DPR.TYPE=OBJECT frames */
            const char* dpr_type = cpl_propertylist_get_string(keywords, XSH_DPR_TYPE) ;
//            xsh_msg_warning("I'm looking at the EXPTIME from type '%s'", dpr_type) ;
            int dpr_is_not_obj = strcmp(dpr_type, "OBJECT") ;
            int dpr_is_not_stdtell = strcmp(dpr_type, "STD,TELLURIC") ;
            xsh_msg_warning("dpr_is_not_obj is %d", dpr_is_not_obj) ;
            xsh_msg_warning("dpr_is_not_stdtell is %d", dpr_is_not_stdtell) ;
            if (!dpr_is_not_obj || !dpr_is_not_stdtell) {
//            xsh_msg_warning("I'm skipping a file for EXPTIME because it's not OBJECT (%s)", dpr_type);
//        } else {
//            xsh_msg_warning("Allowing file for EXPTIME calculation");
                total += exptime;
                xsh_msg_warning("Added %f to (T)EXPTIME", exptime) ;
            }
            cpl_propertylist_delete(keywords);
            keywords = NULL;
        }
        /* Increment the iterator to the next frame. */
        cpl_errorstate status = cpl_errorstate_get();
        cpl_frameset_iterator_advance(iter, 1);
        if (cpl_error_get_code() == CPL_ERROR_ACCESS_OUT_OF_RANGE) {
            cpl_errorstate_set(status);
        }
        frame = cpl_frameset_iterator_get_const(iter);
    }

    cpl_frameset_iterator_delete(iter);
    cpl_propertylist_delete(keywords);
//  xsh_msg_warning("EXPTIME/TEXPTIME total: %f", total);
    return total;

    cleanup:
    /* Enter this cleanup section if an error occurs. */
    cpl_frameset_iterator_delete(iter);
    cpl_propertylist_delete(keywords);
    return NAN;
}

/** 
 * Save spectrum product
 * 
 * @param frame Product Frame
 * @param frameset Input Frameset
 * @param parameters Parameters list
 * @param recipe_id Recipe Identification String
 * @param instr Instrument structure
 * @param result_frame If not NULL this will be filled with a duplicate of the
 *                     final product frame. The caller takes ownership of the
 *                     new frame and must delete it with @c cpl_frame_delete().
 */
void 
xsh_add_product_spectrum( cpl_frame *frame,
                          cpl_frameset *frameset,
                          const cpl_parameterlist *parameters,
                          const char *recipe_id,
                          xsh_instrument* instr,
                          cpl_frame ** result_frame)
{

  const char *pro_catg = "";
  xsh_spectrum *spectrum = NULL;
  cpl_frame *product_frame = NULL;
  char product_id[256];
  char* product_name = NULL;
  /* char* paf_name = NULL; */
  time_t now ;
  char* date = NULL;

  /* Check entries */
  XSH_ASSURE_NOT_NULL( frame);
  XSH_ASSURE_NOT_NULL( frameset);
  XSH_ASSURE_NOT_NULL( parameters);
  XSH_ASSURE_NOT_NULL( recipe_id);
  XSH_ASSURE_NOT_NULL( instr);
 
  check( pro_catg = cpl_frame_get_tag (frame));

  assure( pro_catg != NULL, CPL_ERROR_NULL_INPUT,
    "Frame tag has not been set");

  /* Load PRE */
  check( spectrum = xsh_spectrum_load( frame));
  xsh_clean_header(spectrum->flux_header);
  /* update header */
  cpl_frame_set_group( frame, CPL_FRAME_GROUP_PRODUCT);
  check( cpl_dfs_setup_product_header( spectrum->flux_header,
    frame, frameset, parameters, recipe_id, instr->pipeline_id,
				       instr->dictionary, NULL));

  if(
     strstr(recipe_id,"xsh_respon") != NULL ||
     strstr(recipe_id,"xsh_scired") != NULL ||
     strstr(recipe_id,"xsh_util_ifu") != NULL ) {
    xsh_dfs_fix_key_start_end(frameset,spectrum->flux_header);
  }

    /* PIPE-8857 - compute a TEXPTIME for MERGE1D and MERGE2D products */
//  cpl_error_code error = CPL_ERROR_NONE;
//  cpl_errorstate prestate;
//  prestate = cpl_errorstate_get();
    double exptime = xsh_calculate_exptime(frameset,
                                           xsh_instrument_get_arm(instr));
    if (! isnan(exptime) && exptime > 0.) {
//        xsh_msg_warning("I am attempting a TEXPTIME of %f", exptime) ;
        cpl_propertylist_append_double(spectrum->flux_header, "TEXPTIME", exptime) ;
//  } else if (! cpl_errorstate_is_equal(prestate)) {
//      error = cpl_error_get_code();
    }


  /* Save product */
  if (xsh_time_stamp_get() ){
    time( &now );
    date = xsh_sdate_utc(&now);
    sprintf( product_id, "%s%s_%s", XSH_PRODUCT_PREFIX,
      pro_catg, date);
  }
  else {
    sprintf( product_id, "%s%s", XSH_PRODUCT_PREFIX, 
      pro_catg);
  }
  product_name = xsh_stringcat_any( product_id, ".fits", (void*)NULL);
  xsh_msg_warning("For product %s", product_name) ;
  check( product_frame = xsh_spectrum_save(spectrum, product_name,pro_catg));

  /* Save PAF 
  paf_name = xsh_stringcat_any( product_id, ".paf", (void*)NULL);
  XSH_ASSURE_NOT_NULL( paf_name);
  check_msg( xsh_paf_save( instr, recipe_id,
			   spectrum->flux_header, paf_name,
			   pro_catg ),
    "Cant save PAF file" ) ;
  */

  /* Add the new frame into the frameset */
  cpl_frame_set_type( product_frame, CPL_FRAME_TYPE_IMAGE);
  cpl_frame_set_group( product_frame, CPL_FRAME_GROUP_PRODUCT);
  cpl_frame_set_level( product_frame, CPL_FRAME_LEVEL_FINAL);
  cpl_frame_set_tag( product_frame, pro_catg);
  cpl_frameset_insert( frameset, product_frame);
  xsh_add_product_file(product_name);

  if (result_frame != NULL) {
    *result_frame = cpl_frame_duplicate(product_frame);
  }

  cleanup:
    if (cpl_error_get_code () != CPL_ERROR_NONE) {
      xsh_free_frame( &product_frame);
      product_frame = NULL;
    }
    XSH_FREE( date);
    xsh_spectrum_free( &spectrum);
    XSH_FREE( product_name);
    /* XSH_FREE( paf_name); */
    return;
}
/**
 * Save spectrum product
 *
 * @param frame Product Frame
 * @param frameset Input Frameset
 * @param parameters Parameters list
 * @param recipe_id Recipe Identification String
 * @param instr Instrument structure
 * @param result_frame If not NULL this will be filled with a duplicate of the
 *                     final product frame. The caller takes ownership of the
 *                     new frame and must delete it with @c cpl_frame_delete().
 */
void
xsh_add_product_orders_spectrum( cpl_frame *frame,
                          cpl_frameset *frameset,
                          const cpl_parameterlist *parameters,
                          const char *recipe_id,
                          xsh_instrument* instr,
                          cpl_frame ** result_frame)
{

  const char *pro_catg = "";
  //xsh_spectrum *spectrum = NULL;
  cpl_frame *product_frame = NULL;
  char product_id[256];
  char* product_name = NULL;
  /* char* paf_name = NULL; */
  time_t now ;
  char cmd[256];
  char* date = NULL;
  cpl_vector* vec_data=NULL;
  cpl_vector* vec_errs=NULL;
  cpl_vector* vec_qual=NULL;
  const char *name_s = NULL;
  cpl_propertylist* h_data=NULL;
  cpl_propertylist* h_errs=NULL;
  cpl_propertylist* h_qual=NULL;
  char *final_name = NULL ;
  /* Check entries */
  XSH_ASSURE_NOT_NULL( frame);
  XSH_ASSURE_NOT_NULL( frameset);
  XSH_ASSURE_NOT_NULL( parameters);
  XSH_ASSURE_NOT_NULL( recipe_id);
  XSH_ASSURE_NOT_NULL( instr);

  check( pro_catg = cpl_frame_get_tag (frame));

  assure( pro_catg != NULL, CPL_ERROR_NULL_INPUT,
    "Frame tag has not been set");

  /* set the procatg */
  pro_catg=xsh_create_final_tag(result_frame,instr,frame);

  /* Define product name */
   if (xsh_time_stamp_get() ){
     time( &now );
     date = xsh_sdate_utc(&now);
     sprintf( product_id, "%s%s_%s", XSH_PRODUCT_PREFIX,
       pro_catg, date);
   }
   else {
     sprintf( product_id, "%s%s", XSH_PRODUCT_PREFIX,
       pro_catg);
   }

   product_name = xsh_stringcat_any( product_id, ".fits", (void*)NULL);
   final_name=xsh_create_final_name(pro_catg);
   xsh_msg( "Final product name: %s", final_name ) ;
   name_s=cpl_frame_get_filename(frame);
   int next=cpl_frame_get_nextensions(frame);

   if(strcmp(name_s,final_name) == 0) {
      sprintf(cmd,"mv  %s tmp_spc.fits",name_s);
      system(cmd);
      name_s="tmp_spc.fits";
      xsh_add_temporary_file("tmp_spc.fits");
    }
 
  cpl_propertylist* primary_header;
  check( primary_header = cpl_propertylist_load( name_s, 0));
  if(
     strstr(recipe_id,"xsh_respon") != NULL ||
     strstr(recipe_id,"xsh_scired") != NULL ||
     strstr(recipe_id,"xsh_util_ifu") != NULL ) {
    xsh_msg("Fix key");
    //exit(0);
    xsh_dfs_fix_key_start_end(frameset,primary_header);
  }

    /* PIPE-8857 - compute a TEXPTIME for MERGE1D and MERGE2D products */
//  cpl_error_code error = CPL_ERROR_NONE;
//  cpl_errorstate prestate;
//  prestate = cpl_errorstate_get();
    double exptime = xsh_calculate_exptime(frameset,
                                           xsh_instrument_get_arm(instr));
    if (! isnan(exptime) && exptime > 0.) {
//        xsh_msg_warning("I am attempting a TEXPTIME of %f", exptime) ;
        cpl_propertylist_append_double(primary_header, "TEXPTIME", exptime) ;
//  } else if (! cpl_errorstate_is_equal(prestate)) {
//      error = cpl_error_get_code();
    }

  /* Now save file with updated header */
   xsh_pfits_set_pcatg(primary_header,pro_catg);
   xsh_plist_set_extra_keys(primary_header,"IMAGE","DATA","RMSE",
                "FLUX","ERRS","QUAL",0);
   xsh_clean_header(primary_header);

  //int norders = (next+1)/3;

  for(int i=0;i<next;i+=3) {
     vec_data=cpl_vector_load(name_s,i);
     vec_errs=cpl_vector_load(name_s,i+1);
     vec_qual=cpl_vector_load(name_s,i+2);

     check(h_data=cpl_propertylist_load(name_s,i));
     check(h_errs=cpl_propertylist_load(name_s,i+1));
     check(h_qual=cpl_propertylist_load(name_s,i+2));

     if(i==0) {
       /*
       //xsh_clean_header(h_data);
         cpl_frame_set_group( frame, CPL_FRAME_GROUP_PRODUCT);
         cpl_dfs_setup_product_header( h_data,frame,frameset,parameters,
				       recipe_id,instr->pipeline_id,
				       instr->dictionary,NULL);
       */
         cpl_dfs_setup_product_header(primary_header,frame, frameset, parameters,
                                      recipe_id, instr->pipeline_id,
                                      instr->dictionary, NULL);

         cpl_vector_save(vec_data,product_name,XSH_SPECTRUM_DATA_BPP,primary_header,CPL_IO_DEFAULT);
         cpl_vector_save(vec_errs,product_name,XSH_SPECTRUM_ERRS_BPP,h_errs,CPL_IO_EXTEND);
         cpl_vector_save(vec_qual,product_name,XSH_SPECTRUM_QUAL_BPP,h_qual,CPL_IO_EXTEND);

     } else{

         cpl_vector_save(vec_data,product_name,XSH_SPECTRUM_DATA_BPP,h_data,CPL_IO_EXTEND);
         cpl_vector_save(vec_errs,product_name,XSH_SPECTRUM_ERRS_BPP,h_errs,CPL_IO_EXTEND);
         cpl_vector_save(vec_qual,product_name,XSH_SPECTRUM_QUAL_BPP,h_qual,CPL_IO_EXTEND);

     }
     XSH_FREE(final_name);
     xsh_free_vector(&vec_data);
     xsh_free_vector(&vec_errs);
     xsh_free_vector(&vec_qual);
     xsh_free_propertylist(&h_data);
     xsh_free_propertylist(&h_errs);
     xsh_free_propertylist(&h_qual);

  }

  /* Add the new frame into the frameset */
  product_frame=cpl_frame_new();

  cpl_frame_set_type( product_frame, CPL_FRAME_TYPE_IMAGE);
  cpl_frame_set_group( product_frame, CPL_FRAME_GROUP_PRODUCT);
  cpl_frame_set_level( product_frame, CPL_FRAME_LEVEL_FINAL);
  cpl_frame_set_tag( product_frame, pro_catg);
  cpl_frame_set_filename( product_frame, product_name);

  cpl_frameset_insert( frameset, product_frame);
  xsh_add_product_file(product_name);

  if (result_frame != NULL) {
    *result_frame = cpl_frame_duplicate(product_frame);
  }

  cleanup:
    if (cpl_error_get_code () != CPL_ERROR_NONE) {
      xsh_free_frame( &product_frame);
      product_frame = NULL;
    }
    xsh_free_propertylist(&primary_header);
    XSH_FREE( date);
    XSH_FREE( product_name);

    return;
}
/*---------------------------------------------------------------------------*/
/**
  @brief 
    Add DFS keywords to a product frame
  @param frame The product frame
  @param frameset The recipe frameset.
  @param parameters The recipe parameter list
  @param recipe_id The recipe name
  @param instr The instrument settings  

   Mandatory DFS keywords are added by 
   calling @c cpl_dfs_setup_product_header()

   The function performs the following steps
   - Load primary header, infer product type,
   - Load product,
   - Modify primary header by adding DFS keywords,
   - Save product using the new header,
   - Insert the new frame into the frameset.

  @note
    A new frame is created and inserted into the frameset.
    The provided @em product_frame must still be deallocated.

*/
/*---------------------------------------------------------------------------*/
void 
xsh_add_product_pre (cpl_frame * frame, 
		     cpl_frameset * frameset,
		     const cpl_parameterlist *parameters, 
		     const char *recipe_id,
		     xsh_instrument* instr)
{
  const char *pro_catg = "";
  xsh_pre* product_pre = NULL;
  cpl_frame* product_frame = NULL;
  char product_id[256];
  char* product_name = NULL;
  /* char* paf_name = NULL; */
  time_t now ;
  char* date = NULL;
  cpl_propertylist* plist=NULL;
  //char arcfile[256];
  //bool arcfile_found=false;

  /* Check entries */
  XSH_ASSURE_NOT_NULL( frame);
  XSH_ASSURE_NOT_NULL( frameset);
  XSH_ASSURE_NOT_NULL( parameters);
  XSH_ASSURE_NOT_NULL( recipe_id);
  XSH_ASSURE_NOT_NULL( instr);
 
  check( pro_catg = cpl_frame_get_tag (frame));

  assure( pro_catg != NULL, CPL_ERROR_NULL_INPUT,
    "Frame tag has not been set");

  /* Load PRE */
  check( product_pre = xsh_pre_load( frame,instr));
  /*
  if(cpl_propertylist_has(product_pre->data_header,"ARCFILE")) {
  sprintf(arcfile,"%s",xsh_pfits_get_arcfile(product_pre->data_header));
  arcfile_found=true;
  }
  */
  xsh_clean_header(product_pre->data_header);
  /* update header */
  cpl_frame_set_group( frame, CPL_FRAME_GROUP_PRODUCT);
  check( cpl_dfs_setup_product_header( product_pre->data_header,
    frame, frameset, parameters, recipe_id, instr->pipeline_id,
				       instr->dictionary,NULL));

  if(
     strstr(recipe_id,"xsh_respon") != NULL ||
     strstr(recipe_id,"xsh_scired") != NULL ||
     strstr(recipe_id,"xsh_util_ifu") != NULL ) {
    xsh_dfs_fix_key_start_end(frameset,product_pre->data_header);
  }

    /* PIPE-8857 - compute a TEXPTIME for MERGE1D and MERGE2D products */
//  cpl_error_code error = CPL_ERROR_NONE;
//  cpl_errorstate prestate;
//  prestate = cpl_errorstate_get();
    double exptime = xsh_calculate_exptime(frameset,
                                           xsh_instrument_get_arm(instr));
    if (! isnan(exptime) && exptime > 0.) {
//        xsh_msg_warning("I am attempting a TEXPTIME of %f", exptime) ;
        cpl_propertylist_append_double(product_pre->data_header, "TEXPTIME", exptime) ;
//  } else if (! cpl_errorstate_is_equal(prestate)) {
//      error = cpl_error_get_code();
    }

  /* Save product */
  if (xsh_time_stamp_get() ){
    time( &now );
    date = xsh_sdate_utc(&now);
    sprintf( product_id, "%s%s_%s", XSH_PRODUCT_PREFIX, pro_catg, date);
  }
  else {
    sprintf( product_id, "%s%s", XSH_PRODUCT_PREFIX, pro_catg);
  }
  product_name = xsh_stringcat_any( product_id, ".fits", (void*)NULL);
  xsh_plist_set_extra_keys(product_pre->data_header,"IMAGE","DATA","RMSE",
			   "FLUX","ERRS","QUAL",0);
  xsh_pfits_set_extname( product_pre->errs_header, "ERRS");
  xsh_plist_set_extra_keys(product_pre->errs_header,"IMAGE","DATA","RMSE",
			   "FLUX","ERRS","QUAL",1);
  xsh_pfits_set_extname( product_pre->qual_header, "QUAL");
  xsh_plist_set_extra_keys(product_pre->qual_header,"IMAGE","DATA","RMSE",
			   "FLUX","ERRS","QUAL",2);

  check( product_frame = xsh_pre_save( product_pre, product_name, pro_catg,0));


  check(plist=cpl_propertylist_duplicate(product_pre->data_header));

/*
  if(arcfile_found) {

  check(cpl_propertylist_append_string(plist,"ARCFILE",arcfile));
  check(cpl_propertylist_set_comment(plist,"ARCFILE","Archive File Name"));

  }
*/
  /* Add the new frame into the frameset */
  cpl_frame_set_type( product_frame, CPL_FRAME_TYPE_IMAGE);
  cpl_frame_set_group( product_frame, CPL_FRAME_GROUP_PRODUCT);
  cpl_frame_set_level( product_frame, CPL_FRAME_LEVEL_FINAL);
  cpl_frame_set_tag( product_frame, pro_catg);
  cpl_frameset_insert( frameset, product_frame);
  xsh_add_product_file(product_name);

  cleanup:
    if (cpl_error_get_code () != CPL_ERROR_NONE) {
      xsh_free_frame( &product_frame);
      product_frame = NULL;
    }
    XSH_FREE( date);
    xsh_pre_free( &product_pre);
    xsh_free_propertylist(&plist);
    XSH_FREE( product_name);
    /* XSH_FREE( paf_name); */
    return;
}

/*---------------------------------------------------------------------------*/
/**
  @brief 
    Add 3d product frame
  @param frame The product frame
  @param frameset The recipe frameset.
  @param parameters The recipe parameter list
  @param recipe_id The recipe name
  @param instr The instrument settings  

*/

/*---------------------------------------------------------------------------*/
void 
xsh_add_product_pre_3d( cpl_frame * frame, 
			cpl_frameset * frameset,
			const cpl_parameterlist *parameters,
			const char *recipe_id,
			xsh_instrument* instr) 
{
  const char * pro_catg = "";
  xsh_pre_3d * product_pre = NULL;
  cpl_frame * product_frame = NULL;
  char product_id[256];
  char * product_name = NULL;
  /* char * paf_name = NULL; */
  time_t now ;
  char * date = NULL;

  /* Check entries */
  XSH_ASSURE_NOT_NULL( frame);
  XSH_ASSURE_NOT_NULL( frameset);
  XSH_ASSURE_NOT_NULL( parameters);
  XSH_ASSURE_NOT_NULL( recipe_id);
  XSH_ASSURE_NOT_NULL( instr);
 
  check( pro_catg = cpl_frame_get_tag (frame));

  assure( pro_catg != NULL, CPL_ERROR_NULL_INPUT,
	  "Frame tag has not been set");

  /* Load PRE */
  check( product_pre = xsh_pre_3d_load( frame));

  /* update header */
  xsh_clean_header(product_pre->data_header);
  cpl_frame_set_group( frame, CPL_FRAME_GROUP_PRODUCT);
  check( cpl_dfs_setup_product_header( product_pre->data_header,
				       frame, frameset, parameters,
				       recipe_id, instr->pipeline_id,
				       instr->dictionary,NULL));

  /* Save product */
  if (xsh_time_stamp_get() ){
    time( &now );
    date = xsh_sdate_utc(&now);
    sprintf( product_id, "%s%s_%s", XSH_PRODUCT_PREFIX, pro_catg, date);
  }
  else {
    sprintf( product_id, "%s%s", XSH_PRODUCT_PREFIX, pro_catg );
  }
  product_name = xsh_stringcat_any( product_id, ".fits", (void*)NULL);
  check( product_frame = xsh_pre_3d_save( product_pre, product_name, 0));

  /* Save PAF 
  paf_name = xsh_stringcat_any( product_id, ".paf", (void*)NULL);
  XSH_ASSURE_NOT_NULL( paf_name);
  check_msg( xsh_paf_save( instr, recipe_id,
			   product_pre->data_header, paf_name,
			   pro_catg ),
	     "Cant save PAF file" ) ;
  */
  /* Add the new frame into the frameset */
  cpl_frame_set_type( product_frame, CPL_FRAME_TYPE_IMAGE);
  cpl_frame_set_group( product_frame, CPL_FRAME_GROUP_PRODUCT);
  cpl_frame_set_level( product_frame, CPL_FRAME_LEVEL_FINAL);
  cpl_frame_set_tag( product_frame, pro_catg);
  cpl_frameset_insert( frameset, product_frame);
  xsh_add_product_file(product_name);

  cleanup:
    if (cpl_error_get_code () != CPL_ERROR_NONE) {
      xsh_free_frame( &product_frame);
      product_frame = NULL;
    }
    XSH_FREE( date);
    xsh_pre_3d_free( &product_pre);
    XSH_FREE( product_name);
    /* XSH_FREE( paf_name); */
    return;
}

/** 
 * Save BadPixelMap product
 * 
 * @param frame Product Frame
 * @param frameset Input Frameset
 * @param parameters Parameters list
 * @param recipe_id Recipe Identification String
 * @param instrument Instrument structure
 * @param final_prefix Final file name
 */
void 
xsh_add_product_bpmap( cpl_frame *frame, 
		       cpl_frameset * frameset,
		       const cpl_parameterlist * parameters,
		       const char *recipe_id,
		       xsh_instrument* instrument,
		       const char *final_prefix ) 
{
  cpl_propertylist *primary_header = NULL;
  const char* pro_catg=NULL;
  cpl_frame* product_frame = NULL;
  cpl_image *image = NULL ;
  const char *fname = NULL;
  char *final_name = NULL ;
  char* date = NULL ;
  /* char *paf_name = NULL ; */


  /* Check input parameters */
  XSH_ASSURE_NOT_NULL(frame);
  XSH_ASSURE_NOT_NULL(frameset);
  XSH_ASSURE_NOT_NULL(parameters);
  XSH_ASSURE_NOT_NULL(recipe_id);
  XSH_ASSURE_NOT_NULL(instrument);
  //XSH_ASSURE_NOT_NULL(final_prefix);

  /* set the procatg */
  pro_catg=xsh_create_final_tag(final_prefix,instrument,frame);

  //check(pro_catg = cpl_frame_get_tag (frame));
  XSH_ASSURE_NOT_NULL(pro_catg);

  /* Load header and image of bpmap frame */
  check(fname = cpl_frame_get_filename( frame ));
  check(primary_header = cpl_propertylist_load( fname, 0 ));
  check(image = cpl_image_load( fname, CPL_TYPE_INT, 0, 0 ));
  xsh_clean_header(primary_header);
  /* update header */
  check( cpl_frame_set_group( frame, CPL_FRAME_GROUP_PRODUCT));
  check_msg (cpl_dfs_setup_product_header ( primary_header,
					    frame,frameset,parameters,
					    recipe_id,
					    instrument->pipeline_id,
					    instrument->dictionary,NULL),
	     "Problem in the product DFS-compliance");


  /* Create final name */
  final_name=xsh_create_final_name(pro_catg);
  xsh_msg_dbg_low( "Final product name: %s", final_name ) ;

  /* Now save file with updated header */
  cpl_image_save( image, final_name, CPL_BPP_32_SIGNED, primary_header,
		  CPL_IO_DEFAULT ) ;

  /*
    Save PAF
  
  paf_name = xsh_stringcat_any( final_prefix, ".paf", (void*)NULL ) ;
  XSH_ASSURE_NOT_NULL( paf_name ) ;
  check_msg( xsh_paf_save( instrument, recipe_id,
			   primary_header, paf_name, pro_catg ),
	     "Cant save PAF file" ) ;
  */
  /* Create product frame */
  check(product_frame=xsh_frame_product(final_name,pro_catg,
					CPL_FRAME_TYPE_IMAGE,
					CPL_FRAME_GROUP_PRODUCT,
					CPL_FRAME_LEVEL_FINAL));

  /*
  XSH_NEW_FRAME(product_frame);

  check(cpl_frame_set_filename (product_frame, final_name));
  check(cpl_frame_set_type (product_frame, CPL_FRAME_TYPE_IMAGE));

  // Add the new frame into the frameset 
  check(cpl_frame_set_group (product_frame, CPL_FRAME_GROUP_PRODUCT));
  check(cpl_frame_set_level (product_frame, CPL_FRAME_LEVEL_FINAL));
  check(cpl_frame_set_tag (product_frame, pro_catg));
  */

  check(cpl_frameset_insert(frameset, product_frame));
  xsh_add_product_file(final_name);

 cleanup:
  XSH_FREE(date);  
  xsh_free_propertylist(&primary_header);
  xsh_free_image( &image ) ;
  XSH_FREE( final_name ) ;
  if(final_prefix!=NULL) {
    xsh_free(pro_catg);
  }
  /* XSH_FREE( paf_name ) ; */
  return;
}

/*****************************************************************************/
/** 
 * Save Image product
 * 
 * @param frame Product Frame
 * @param frameset Input Frameset
 * @param parameters Parameters list
 * @param recipe_id Recipe Identification String
 * @param instrument Instrument structure
 * @param final_prefix Final file name
 */
/*****************************************************************************/
void 
xsh_add_product_imagelist( cpl_frame *frame, 
			   cpl_frameset *frameset,
			   const cpl_parameterlist *parameters, 
			   const char *recipe_id,
			   xsh_instrument *instrument, 
			   const char *final_prefix)
{
  cpl_propertylist *primary_header = NULL;
  const char *pro_catg = NULL;
  cpl_frame* product_frame = NULL;
  const char *fname = NULL;
  char *final_name = NULL ;
  char* date = NULL ;
  int nbext=0;
  int i=0;
  char cmd[256];
  //char arcfile[256];

  //bool arcfile_found=false;
  int extension =0;
  cpl_imagelist* ext_iml=NULL;
  cpl_propertylist* ext_header=NULL;

  /* char *paf_name = NULL ; */

  /* Check input parameters */
  XSH_ASSURE_NOT_NULL(frame);
  XSH_ASSURE_NOT_NULL(frameset);
  XSH_ASSURE_NOT_NULL(parameters);
  XSH_ASSURE_NOT_NULL(recipe_id);
  XSH_ASSURE_NOT_NULL(instrument);
 
  /* set the procatg */
  pro_catg=xsh_create_final_tag(final_prefix,instrument,frame);
  
  /* Load header and imagelist of bpmap frame */
  check(fname = cpl_frame_get_filename( frame ));
  nbext = cpl_frame_get_nextensions( frame);
  check(primary_header = cpl_propertylist_load( fname, 0 ));
  check(ext_iml = cpl_imagelist_load( fname, CPL_TYPE_FLOAT, 0 ));
  /*
  if(cpl_propertylist_has(primary_header,"ARCFILE")) {
    sprintf(arcfile,"%s",xsh_pfits_get_arcfile(primary_header));
    arcfile_found=true;
  }
  */
  xsh_clean_header(primary_header);
  /* update header */
  check( cpl_frame_set_group( frame, CPL_FRAME_GROUP_PRODUCT));
  check_msg ( cpl_dfs_setup_product_header ( primary_header,
					    frame,frameset,parameters,
					    recipe_id,
					    instrument->pipeline_id,
					    instrument->dictionary,NULL),
	     "Problem in the product DFS-compliance");

  /* Create final name */
  final_name=xsh_create_final_name(pro_catg);
  xsh_msg( "Final product name: %s", final_name ) ;

  if(strcmp(fname,final_name) == 0) {
    sprintf(cmd,"mv  %s tmp_ima.fits",fname);
    system(cmd);
    fname="tmp_ima.fits";
    xsh_add_temporary_file("tmp_ima.fits");
  }
 
  /* Now save file with updated header */
  xsh_pfits_set_pcatg(primary_header,pro_catg);
  check(cpl_imagelist_save(ext_iml, final_name, CPL_BPP_IEEE_FLOAT,
				 primary_header,CPL_IO_DEFAULT));

  for( i = 0 ; i<=nbext ; i++ ) {
    xsh_free_imagelist( &ext_iml) ;
    xsh_free_propertylist( &ext_header) ;
    check(ext_iml = cpl_imagelist_load( fname, CPL_TYPE_FLOAT, i ));
    check(ext_header = cpl_propertylist_load( fname ,i));

    if ( i == 0 ) {
      extension = CPL_IO_DEFAULT ;
      check(cpl_imagelist_save(ext_iml, final_name, CPL_BPP_IEEE_FLOAT,
			       primary_header,extension));
    }
    else {
      extension = CPL_IO_EXTEND ;
	check(cpl_imagelist_save(ext_iml, final_name, CPL_BPP_IEEE_FLOAT,
				 ext_header,extension));
    }
  }
  /*
  if(arcfile_found) {
    check(cpl_propertylist_append_string(primary_header,"ARCFILE",arcfile));
    check(cpl_propertylist_set_comment(primary_header,"ARCFILE",
				     "Archive File Name"));
  }
  */
  /* Create product frame */
  check(product_frame=xsh_frame_product(final_name,pro_catg,
					CPL_FRAME_TYPE_IMAGE,
					CPL_FRAME_GROUP_PRODUCT,
					CPL_FRAME_LEVEL_FINAL));

  if(
     strstr(recipe_id,"xsh_respon") != NULL ||
     strstr(recipe_id,"xsh_scired") != NULL ||
     strstr(recipe_id,"xsh_util_ifu") != NULL ) {
    xsh_dfs_fix_key_start_end(frameset,primary_header);
  }

  check(cpl_frameset_insert(frameset, product_frame));
  xsh_add_product_file(final_name);

 cleanup:
  xsh_free_imagelist( &ext_iml) ;
  xsh_free_propertylist( &ext_header) ;

  if(final_prefix!=NULL) {
     xsh_free(pro_catg);
  }
  XSH_FREE(date);  
  xsh_free_propertylist(&primary_header);
  xsh_free_imagelist( &ext_iml ) ;
  XSH_FREE( final_name ) ;

  return;
}
/*****************************************************************************/
/*****************************************************************************/
/** 
 * Save Image product
 * 
 * @param frame Product Frame
 * @param frameset Input Frameset
 * @param parameters Parameters list
 * @param recipe_id Recipe Identification String
 * @param instrument Instrument structure
 * @param final_prefix Final file name
 */
/*****************************************************************************/
void 
xsh_add_product_image( cpl_frame *frame, 
		       cpl_frameset *frameset,
		       const cpl_parameterlist *parameters,
		       const char *recipe_id,
		       xsh_instrument *instrument,
		       const char *final_prefix)
{
  cpl_propertylist *primary_header = NULL;
  const char *pro_catg = NULL;
  cpl_frame* product_frame = NULL;
  cpl_image *image = NULL ;
  const char *fname = NULL;
  char *final_name = NULL ;
  /* char *paf_name = NULL ; */
  int i=0;
  int nbext=0;
  //char arcfile[256];
  char cmd[256];
  //bool arcfile_found=false;

  /* Check input parameters */
  XSH_ASSURE_NOT_NULL(frame);
  XSH_ASSURE_NOT_NULL(frameset);
  XSH_ASSURE_NOT_NULL(parameters);
  XSH_ASSURE_NOT_NULL(recipe_id);
  XSH_ASSURE_NOT_NULL(instrument);
 
  /* set the procatg */
  pro_catg=xsh_create_final_tag(final_prefix,instrument,frame);

  /* Load header and image of bpmap frame */
  check( fname = cpl_frame_get_filename( frame));
  nbext = cpl_frame_get_nextensions( frame);
  //xsh_msg("fname=%s",fname);
  check( primary_header = cpl_propertylist_load( fname, 0));
  check( image = cpl_image_load( fname, CPL_TYPE_FLOAT, 0, 0));
  /*
  if(cpl_propertylist_has(primary_header,"ARCFILE")) {
    sprintf(arcfile,"%s",xsh_pfits_get_arcfile(primary_header));
    arcfile_found=true;
  }
  */

  /* update header */
  check( cpl_frame_set_group( frame, CPL_FRAME_GROUP_PRODUCT));
  check_msg (cpl_dfs_setup_product_header ( primary_header,
					    frame,frameset,parameters,
					    recipe_id,
					    instrument->pipeline_id,
					    instrument->dictionary,NULL),
	     "Problem in the product DFS-compliance");

  xsh_msg("recipe_id=%s",recipe_id);
  if(
     strstr(recipe_id,"xsh_respon") != NULL ||
     strstr(recipe_id,"xsh_scired") != NULL ||
     strstr(recipe_id,"xsh_util_ifu") != NULL ) {
    xsh_dfs_fix_key_start_end(frameset,primary_header);
  }

    /* PIPE-8857 - compute a TEXPTIME for MERGE1D and MERGE2D products */
//  cpl_error_code error = CPL_ERROR_NONE;
//  cpl_errorstate prestate;
//  prestate = cpl_errorstate_get();
    double exptime = xsh_calculate_exptime(frameset,
                                           xsh_instrument_get_arm(instrument));
    if (! isnan(exptime) && exptime > 0.) {
        xsh_msg_warning("I am attempting a TEXPTIME of %f", exptime) ;
        cpl_propertylist_append_double(primary_header, "TEXPTIME", exptime) ;
//  } else if (! cpl_errorstate_is_equal(prestate)) {
//      error = cpl_error_get_code();
    }

  /* Create final name */
  final_name=xsh_create_final_name(pro_catg);
  xsh_msg( "Final product name: %s", final_name ) ;

  if(strcmp(fname,final_name) == 0) {
    sprintf(cmd,"mv  %s tmp_ima.fits",fname);
    system(cmd);
    fname="tmp_ima.fits";
    xsh_add_temporary_file("tmp_ima.fits");
  }
  /* Now save file with updated header */
  xsh_pfits_set_pcatg(primary_header,pro_catg);
  xsh_plist_set_extra_keys(primary_header,"IMAGE","DATA","RMSE",
			   "FLUX","ERRS","QUAL",0);
  xsh_clean_header(primary_header);
  check(cpl_image_save( image, final_name, CPL_BPP_IEEE_FLOAT, primary_header,
			CPL_IO_DEFAULT )) ;
 


  for( i = 0 ; i<=nbext ; i++ ) {
    int extension ;
    cpl_image* ext_img=NULL;
    cpl_propertylist* ext_header=NULL;

    check( ext_img = cpl_image_load( fname, CPL_TYPE_FLOAT,0, i));
    check( ext_header = cpl_propertylist_load( fname ,i));


    if ( i == 0 ) {
       extension = CPL_IO_DEFAULT ;
       xsh_pfits_set_pcatg(ext_header,pro_catg);
     }
    else {
        extension = CPL_IO_EXTEND ;
	check(xsh_plist_set_extra_keys(ext_header,"IMAGE","DATA","RMSE",
				       "FLUX","ERRS","QUAL",i));
        check(cpl_propertylist_erase_regexp(ext_header,
              "^(ARCFILE|ORIGFILE|CHECKSUM|DATASUM|COMMENT)$", CPL_FALSE)); 
        check(cpl_image_save( ext_img, final_name, CPL_BPP_IEEE_FLOAT,ext_header,
			  extension));
    }
    xsh_free_image( &ext_img) ;
    xsh_free_propertylist( &ext_header) ;
  }
  /* Save PAF
  paf_name = xsh_stringcat_any( final_prefix, ".paf", (void*)NULL);
  XSH_ASSURE_NOT_NULL( paf_name);
  */
  /*
  if(arcfile_found) {
    check(cpl_propertylist_append_string(primary_header,"ARCFILE",arcfile));
    check(cpl_propertylist_set_comment(primary_header,"ARCFILE",
				     "Archive File Name"));
  }
  */
  /*
  check_msg( xsh_paf_save( instrument, recipe_id,
			   primary_header, paf_name, pro_catg ),
	     "Cant save PAF file" ) ;
  */
  /* Create product frame */
  check( product_frame = xsh_frame_product( final_name,pro_catg,
					CPL_FRAME_TYPE_IMAGE,
					CPL_FRAME_GROUP_PRODUCT,
					CPL_FRAME_LEVEL_FINAL));
  
  check(cpl_frameset_insert(frameset, product_frame));
  xsh_add_product_file(final_name);

  cleanup:
    if(final_prefix!=NULL) {
       xsh_free(pro_catg);
    }

    xsh_free_propertylist( &primary_header);
    xsh_free_image( &image);
    XSH_FREE( final_name);
    /* XSH_FREE( paf_name); */
    return;
}
/*****************************************************************************/

/*****************************************************************************/
/** 
  @brief
  Save Table product (input frame has several extensions, 1 table per extension)
  @param frame Product Frame
  @param frameset Input Frameset
  @param parameters Parameters list
  @param recipe_id Recipe Identification String
  @param instrument Instrument structure
 */
/*****************************************************************************/
void 
xsh_add_product_table( cpl_frame *frame, 
			     cpl_frameset *frameset,
			     const cpl_parameterlist * parameters,
			     const char *recipe_id,
			     xsh_instrument* instrument,
                             const char *final_prefix)
{
  cpl_propertylist *primary_header = NULL;
  cpl_propertylist *tbl_header = NULL;
  const char *pro_catg =NULL;
  cpl_frame* product_frame = NULL;
  cpl_table * table = NULL ;
  const char *fname = NULL;
  char *product_id = NULL;
  char *product_name = NULL ;
  char *tmp_name = NULL ;
  char* date = NULL ;
  /* char *paf_name = NULL ; */
  int nbext, i ;

  /* Check input parameters */
  XSH_ASSURE_NOT_NULL(frame);
  XSH_ASSURE_NOT_NULL(frameset);
  XSH_ASSURE_NOT_NULL(parameters);
  XSH_ASSURE_NOT_NULL(recipe_id);
  XSH_ASSURE_NOT_NULL(instrument);

  /* set the procatg */
  pro_catg=xsh_create_final_tag(final_prefix,instrument,frame);


  /* Load header and image of table frame */
  check( fname = cpl_frame_get_filename( frame));
  check( primary_header = cpl_propertylist_load( fname, 0));
  XSH_ASSURE_NOT_NULL( primary_header);
  check( tbl_header = cpl_propertylist_load( fname, 1));
  XSH_ASSURE_NOT_NULL( tbl_header);
  nbext = cpl_frame_get_nextensions( frame);
  xsh_clean_header(primary_header);
  /* update header */
  check( cpl_frame_set_group (frame, CPL_FRAME_GROUP_PRODUCT));
  check( cpl_dfs_setup_product_header ( primary_header,
    frame, frameset, parameters, recipe_id, instrument->pipeline_id,
					instrument->dictionary,NULL));

 
  if(
     strstr(recipe_id,"xsh_respon") != NULL ||
     strstr(recipe_id,"xsh_scired") != NULL ||
     strstr(recipe_id,"xsh_util_ifu") != NULL ) {
    xsh_dfs_fix_key_start_end(frameset,primary_header);
  }
 
  /* Create final name */
  product_name=xsh_create_final_name(pro_catg);

  /* Now save file with updated header */
  tmp_name=xsh_stringcat_any( "tmp_",product_name, (void*)NULL );
  for( i = 0 ; i<nbext ; i++ ) {
    int extension ;
    cpl_table *tbl_ext = NULL;
    cpl_propertylist *tbl_ext_header = NULL;
    /* Load table
       save table
    */
    check( tbl_ext = cpl_table_load( fname, i+1, 0));
    check( tbl_ext_header = cpl_propertylist_load( fname, i+1));

    if ( i == 0 ) extension = CPL_IO_DEFAULT ;
    else extension = CPL_IO_EXTEND ;
    check(cpl_table_save( tbl_ext, primary_header, tbl_ext_header,
			  tmp_name, extension));
    xsh_free_table( &tbl_ext);
    xsh_free_propertylist( &tbl_ext_header);
  }

  xsh_fileutils_move( tmp_name,product_name );
 
 
  /* Create product frame */
  check(product_frame=xsh_frame_product(product_name,pro_catg,
					CPL_FRAME_TYPE_TABLE,
					CPL_FRAME_GROUP_PRODUCT,
					CPL_FRAME_LEVEL_FINAL));

  cpl_frameset_insert(frameset, product_frame);


  cleanup:
    if(final_prefix!=NULL) {
       xsh_free(pro_catg);
    }
    xsh_free_propertylist(&primary_header);
    xsh_free_propertylist(&tbl_header);
    XSH_TABLE_FREE( table) ;
    XSH_FREE(product_id);
    XSH_FREE(tmp_name);
    XSH_FREE(product_name);
    XSH_FREE(date);

   return;
}
/*****************************************************************************/

/*---------------------------------------------------------------------------*/
/**
   @brief Find standard star frame
   @param frames The input frameset
   @return Pointer to first standard star frame, or NULL on error.

   The function sets an error if no standard star frame is present.

*/
/*---------------------------------------------------------------------------*/

cpl_frame *
xsh_find_std_flux (cpl_frameset * frames)
{
  const char *tags[] = { 
                         XSH_STD_FLUX_SLIT (XSH_ARM_UVB),
			 XSH_STD_FLUX_SLIT (XSH_ARM_VIS),
			 XSH_STD_FLUX_SLIT (XSH_ARM_NIR),
                         XSH_STD_TELL_SLIT (XSH_ARM_UVB),
			 XSH_STD_TELL_SLIT (XSH_ARM_VIS),
			 XSH_STD_TELL_SLIT (XSH_ARM_NIR),
			 XSH_STD_FLUX_OFFSET (XSH_ARM_UVB),
			 XSH_STD_FLUX_OFFSET (XSH_ARM_VIS),
			 XSH_STD_FLUX_OFFSET (XSH_ARM_NIR),
			 XSH_STD_TELL_OFFSET (XSH_ARM_UVB),
			 XSH_STD_TELL_OFFSET (XSH_ARM_VIS),
			 XSH_STD_TELL_OFFSET (XSH_ARM_NIR),
			 NULL
  };

  return xsh_find_frame (frames, tags);
}
/*---------------------------------------------------------------------------*/
/**
   @brief Find standard standard star flux frame
   @param frames The input frameset
   @return Pointer to first standard star frame, or NULL on error.

   The function sets an error if no standard star frame is present.

*/
/*---------------------------------------------------------------------------*/

cpl_frame *
xsh_find_std_star_flux (cpl_frameset * frames)
{
  const char *tags[] = { XSH_STD_STAR_FLUX (XSH_ARM_UVB),
			 XSH_STD_STAR_FLUX (XSH_ARM_VIS),
			 XSH_STD_STAR_FLUX (XSH_ARM_NIR),
			 NULL
  };

  return xsh_find_frame (frames, tags);
}

/*---------------------------------------------------------------------------*/
/**
   @brief Find master bias frame
   @param frames The input frameset
   @param instr the settings of instrument

   @return Pointer to first standard star frame, or NULL on error.

   The function sets an error if no standard star frame is present.

*/
/*---------------------------------------------------------------------------*/

cpl_frame* 
xsh_find_master_bias (cpl_frameset * frames, xsh_instrument* instr)
{
  const char *tags[2] ={NULL,NULL};
  cpl_frame* result = NULL;

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_MASTER_BIAS, instr);

  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  return result;
}

/*---------------------------------------------------------------------------*/
/**
   @brief Find frame with a given tag
   @param frames The input frameset
   @param tag    The frame tag
   @param instr the settings of instrument

   @return Pointer to first standard star frame, or NULL on error.
    
   The function sets an error if no standard star frame is present.
  
*/
/*---------------------------------------------------------------------------*/
  
cpl_frame* 
xsh_find_frame_with_tag (cpl_frameset * frames, 
			 const char* tag,  
			 xsh_instrument* instr)
{
  char *tags[2];
  cpl_frame* result = NULL;

  tags[0] = xsh_get_tag_from_arm( tag,  instr);
  tags[1] = NULL;
  xsh_msg_dbg_high("search for tag %s",tags[0]);
  result = xsh_find_frame (frames,(const char**) tags);
  cpl_free( tags[0]);
  return result;
}


/*---------------------------------------------------------------------------*/
/**
   @brief Find arm specific tag from base and instrument setting 
   @param tag    The frame tag
   @param instr the settings of instrument

   @return string composed tag
   
*/
/*---------------------------------------------------------------------------*/

char* xsh_get_tag_from_arm(const char* tag, xsh_instrument* instr){
   const char* arm=xsh_instrument_arm_tostring(instr);
   char* composed_tag=NULL;

   int len = strlen(tag);

   if(tag[len-1]=='_') {
      composed_tag=cpl_sprintf("%s%s",tag,arm);
   } else {
      composed_tag=cpl_sprintf("%s%s%s",tag,"_",arm);
   }
   xsh_msg_dbg_high("composed tag='%s'",composed_tag);

   return composed_tag;
}


/*---------------------------------------------------------------------------*/
/**
   @brief Find master dark frame
   @param frames The input frameset
   @param instr the settings of instrument

   @return Pointer to first standard star frame, or NULL on error.
    
   The function sets an error if no standard star frame is present.
  
*/
/*---------------------------------------------------------------------------*/
  
cpl_frame* xsh_find_master_dark (cpl_frameset * frames, xsh_instrument* instr)
{
  const char *tags[2];
  
  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_MASTER_DARK,  instr);
  tags[1] = NULL;

  return xsh_find_frame (frames, tags);
}

/*---------------------------------------------------------------------------*/
/**
   @brief Find master flat frame
   @param frames The input frameset
   @param instr the settings of instrument

   @return Pointer to first standard star frame, or NULL on error.

   The function sets an error if no master flat frame is present.

*/
/*---------------------------------------------------------------------------*/
cpl_frame* xsh_find_master_flat (cpl_frameset * frames, xsh_instrument* instr)
{
  const char *tags[2];

  tags[0] = XSH_GET_TAG_FROM_MODE ( XSH_MASTER_FLAT, instr);
  tags[1] = NULL;

  return xsh_find_frame (frames, tags);
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find a theoretical tab signle pinhole in SOF 
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *xsh_find_theo_tab_sing( cpl_frameset *frames, xsh_instrument* instr)
{
  const char* tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);
  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_THEO_TAB_SING, instr);
  check(result = xsh_find_frame (frames, tags));
  
  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find a theoretical tab multi pinhole in SOF 
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *xsh_find_theo_tab_mult( cpl_frameset *frames, xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);
  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_THEO_TAB_MULT, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}
/*---------------------------------------------------------------------------*/
/**
  @brief Find a theoretical tab IFU or SINg depending of MODE in SOF 
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *xsh_find_theo_tab_mode( cpl_frameset *frames, xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  if ( instr->mode == XSH_MODE_IFU){
    tags[0] = XSH_GET_TAG_FROM_ARM( XSH_THEO_TAB_IFU, instr);
  }
  else{
    tags[0] = XSH_GET_TAG_FROM_ARM( XSH_THEO_TAB_SING, instr);
  }
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find an order tab RECOV
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_order_tab_recov( cpl_frameset *frames, xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_ORDER_TAB_RECOV, instr);
  check( result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find an order tab GUESS 
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_order_tab_guess( cpl_frameset *frames, xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_ORDER_TAB_GUESS, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find an order tab CENTR
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_order_tab_centr( cpl_frameset *frames, xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_ORDER_TAB_CENTR, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find an order tab EDGES
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_order_tab_edges( cpl_frameset *frames, xsh_instrument* instr)
{
  const char *tags[3] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_MODE( XSH_ORDER_TAB_AFC, instr);
  tags[1] = XSH_GET_TAG_FROM_LAMP( XSH_ORDER_TAB_EDGES, instr);

  check(result = xsh_find_frame (frames, tags));

  xsh_msg_dbg_medium( "ORDER_TAB => %s", cpl_frame_get_filename( result));
  xsh_msg( "Use order tab: %s", cpl_frame_get_tag( result));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find a wave tab guess
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return  Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_wave_tab_guess( cpl_frameset *frames, xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_GUESS, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find a wave tab 2D
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return  Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_wave_tab_2d( cpl_frameset *frames,  xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_2D, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find a slit map 
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return  Pointer to the search frame or exception if don't find
*/
cpl_frame *xsh_find_slitmap( cpl_frameset *frames,
			     xsh_instrument* instr)
{
  const char *tags[3] = {NULL, NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_SLIT_MAP, instr);
  tags[1] = XSH_GET_TAG_FROM_ARM( XSH_IFU_MAP, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find a wave tab 2D or a wave tab ARC
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return  Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *xsh_find_wave_tab( cpl_frameset *frames,
  xsh_instrument* instr)
{
  const char *tags[4] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_AFC, instr);
  tags[1] = XSH_GET_TAG_FROM_MODE( XSH_WAVE_TAB_ARC, instr);
  tags[2] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_2D, instr);
  check(result = xsh_find_frame (frames, tags));
 
  cleanup:
    return result;
}


/*---------------------------------------------------------------------------*/
/**
  @brief Find a model config
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return  Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_model_config( cpl_frameset *frames,  xsh_instrument* instr)
{
  const char *tags[4] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_MOD_CFG_OPT_AFC, instr);
  tags[1] = XSH_GET_TAG_FROM_ARM( XSH_MOD_CFG_OPT_2D, instr);
  tags[2] = XSH_GET_TAG_FROM_ARM( XSH_MOD_CFG_TAB, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find wave tab ARC (for IFU 3 frames)
  @param frames The input frameset where we do the search
  @param instrument The instrument
  
  @return  Pointer to the frame set containing the 3 wave tab arc frames
    or exception if not founf
*/
/*---------------------------------------------------------------------------*/
cpl_frameset * 
xsh_find_wave_tab_ifu( cpl_frameset *frames, xsh_instrument* instrument)
{
  const char * tags[3] = { NULL, NULL, NULL} ;
  cpl_frameset * result = NULL;
  cpl_frame * resframe = NULL ;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instrument);

  /* Create frameset */
  check( result = cpl_frameset_new() ) ;

  /*
    If only one wave solution "XSH_WAVE_TAB_ARC", duplicat the frame 3
     times and set the correct tags for each of them
     else fail if the 3 wave solutions are not avaiable
  */
  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_AFC, instrument);
  tags[1] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_2D, instrument);
  resframe = xsh_find_frame (frames, tags) ;
  if (resframe != NULL ) {
    cpl_frame * down = NULL, * cen = NULL , * up = NULL ;

    xsh_msg_warning( "Only one Wave Solution Frame %s, use it for the 3 slitlets",
      cpl_frame_get_filename( resframe)) ;
    check( down = cpl_frame_duplicate( resframe ) ) ;
    tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_ARC_DOWN_IFU, instrument ) ;
    check( cpl_frame_set_tag( down, tags[0] ) ) ;
    check( cpl_frameset_insert( result, down ) ) ;

    check( cen = cpl_frame_duplicate( resframe ) ) ;
    tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_ARC_CEN_IFU, instrument ) ;
    check( cpl_frame_set_tag( cen, tags[0] ) ) ;
    check( cpl_frameset_insert( result, cen ) ) ;

    check( up = cpl_frame_duplicate( resframe ) ) ;
    tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_ARC_UP_IFU, instrument ) ;
    check( cpl_frame_set_tag( up, tags[0] ) ) ;
    check( cpl_frameset_insert( result, up ) ) ;
  }
  else {
    xsh_msg( "Three wave solution found" ) ;

    tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_ARC_DOWN_IFU, instrument ) ;
    check(resframe = xsh_find_frame (frames, tags));
    check( cpl_frameset_insert( result, resframe ) ) ;

    tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_ARC_CEN_IFU, instrument ) ;
    check(resframe = xsh_find_frame (frames, tags));
    check( cpl_frameset_insert( result, resframe ) ) ;

    tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_TAB_ARC_UP_IFU, instrument ) ;
    check(resframe = xsh_find_frame (frames, tags));
    check( cpl_frameset_insert( result, resframe ) ) ;
  }

  cleanup:
  if ( cpl_error_get_code() != CPL_ERROR_NONE ) {
    cpl_frameset_delete( result ) ;
    return NULL ;
  }
  else return result;
}
/*---------------------------------------------------------------------------*/

/*---------------------------------------------------------------------------*/
/**
  @brief Find offset tab (One for each slitlet)
  @param frames The input frameset where we do the search
  @param instrument The instrument
  
  @return  Pointer to the frame set containing the 3 offset tab frames
    or exception if not found
*/
/*---------------------------------------------------------------------------*/
cpl_frameset *
xsh_find_offset_tab_ifu( cpl_frameset *frames, xsh_instrument* instr)
{
  cpl_frameset *result = NULL;
  const char *tags[2] = {NULL, NULL};
  cpl_frame *down = NULL;
  cpl_frame *cen = NULL;
  cpl_frame *up = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  /* Create frameset */
  check( result = cpl_frameset_new());

  /* search down */
  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_OFFSET_DOWN_IFU, instr);
  check( down = xsh_find_frame (frames, tags));
  check( cpl_frameset_insert( result, cpl_frame_duplicate(down)));

  /* search cen */
  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_OFFSET_CEN_IFU, instr);
  check( cen = xsh_find_frame (frames, tags));
  check( cpl_frameset_insert( result, cpl_frame_duplicate(cen)));

  /* search up */
  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_OFFSET_UP_IFU, instr);
  check( up = xsh_find_frame (frames, tags));
  check( cpl_frameset_insert( result, cpl_frame_duplicate(up)));

  cleanup:
  if ( cpl_error_get_code() != CPL_ERROR_NONE ) {
    xsh_msg_warning( "No complete OFFSET_TAB dataset is found." \
    " The rectified spectra will not be straightened and the resulting" \
    " datacube may not be aligned.");
    xsh_free_frameset( &result);
  }
  return result;
}
/*---------------------------------------------------------------------------*/

/*---------------------------------------------------------------------------*/
/**
  @brief Find an arc lines list clean frame
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return  Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_arc_line_list_clean( cpl_frameset *frames,  xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_ARC_LINE_LIST, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}


/*---------------------------------------------------------------------------*/
/**
  @brief Find an arc line list frame
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return  Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_arc_line_list( cpl_frameset *frames,  xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_ARC_LINE_LIST, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}
/*---------------------------------------------------------------------------*/
/**
  @brief Find a user guess line positions table frame
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return  Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_usr_lines_guess_tab( cpl_frameset *frames,  xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_GUESS_LINES_POS, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find a model configuration table frame
  @param frames The input frameset where we do the search
  @param instr The instrument
  
  @return  Pointer to the search frame or exception if don't find
*/
/*---------------------------------------------------------------------------*/
cpl_frame *
xsh_find_model_config_tab( cpl_frameset *frames,  xsh_instrument* instr)
{
  const char *tags[2] = {NULL, NULL};
  cpl_frame* result = NULL;

  XSH_ASSURE_NOT_NULL( frames);
  XSH_ASSURE_NOT_NULL( instr);

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_MOD_CFG_TAB, instr);
  check(result = xsh_find_frame (frames, tags));

  cleanup:
    return result;
}

/**
   @brief Find Wave Map frame. The frame returned should not be free by
   the caller.

   @param frames The input frameset
   @param instr the instrument

   @return Pointer to wavemap frame

*/
/*---------------------------------------------------------------------------*/
cpl_frame * xsh_find_wavemap(cpl_frameset *frames,
			    xsh_instrument* instr)
{
  const char *tags[2] ={NULL,NULL};
  cpl_frame* result = NULL;

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_WAVE_MAP, instr);
  check(result = xsh_find_frame (frames,(const char**) tags));
  
  cleanup:
    return result;
}

/**
   @brief Find orderdef raw frame for UVB or VIS
   @param frames The input frameset
    
   @return Pointer to order table frame
    
*/
/*---------------------------------------------------------------------------*/

cpl_frame * xsh_find_raw_orderdef_vis_uvb ( cpl_frameset * frames )
{
  char *tags[4] ={NULL,NULL, NULL,NULL};
  cpl_frame* result = NULL;
  const char* tag=NULL;
  int nraw=0;
  check(tags[0] = xsh_stringcat_any( XSH_ORDERDEF_D2_UVB, (void*)NULL )) ;
  check(tags[1] = xsh_stringcat_any( XSH_ORDERDEF_QTH_UVB, (void*)NULL )) ;
  check(tags[2] = xsh_stringcat_any( XSH_ORDERDEF_VIS, (void*)NULL )) ;

  check(result = xsh_find_frame (frames,(const char**) tags));
  tag=cpl_frame_get_tag(result);
  nraw=cpl_frameset_get_size(frames);
  if(nraw>1){
    /* this can happen only in UVB */
           if(strcmp(tag,XSH_ORDERDEF_D2_UVB)==0) {
      cpl_frameset_erase(frames,XSH_ORDERDEF_QTH_UVB );
    } else if(strcmp(tag,XSH_ORDERDEF_QTH_UVB)==0){
      cpl_frameset_erase(frames,XSH_ORDERDEF_D2_UVB );
    }
  }
  xsh_msg("Use orderdef frame %s",tag);
 cleanup:
  cpl_free( tags[0]);
  cpl_free( tags[1]);
  cpl_free( tags[2]);
  return result;
}

/**
   @brief Find orderdef raw frame for NIR
   @param frames The input frameset
    
   @return Pointer to order table frame
    
*/
/*---------------------------------------------------------------------------*/

cpl_frame * xsh_find_raw_orderdef_nir( cpl_frameset * frames )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  check(tags[0] = xsh_stringcat_any( XSH_ORDERDEF_NIR, (void*)NULL ) );
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}

/*---------------------------------------------------------------------------*/
/**
 *  @brief
 *    Find Dispersol tab frame. The frame returned should not be free
 *    by the caller.
 *  @param frames The input frameset
 *  @param instr  The instrument
 *  @return Pointer to wavemap frame
 */
/*---------------------------------------------------------------------------*/
cpl_frame* xsh_find_disp_tab( cpl_frameset *frames,
			      xsh_instrument* instr)
{
  const char *tags[3] ={NULL,NULL};
  cpl_frame* result = NULL;

  tags[0] = XSH_GET_TAG_FROM_ARM( XSH_DISP_TAB_AFC, instr);
  tags[1] = XSH_GET_TAG_FROM_ARM( XSH_DISP_TAB, instr);

  check( result = xsh_find_frame( frames,(const char**) tags));

  if (result == NULL){
    xsh_msg( "No DISP TAB frame found !!");
  } else {
     xsh_msg( "Use DISP TAB %s",cpl_frame_get_tag(result));
  }

  cleanup:
    return result;
}
/*---------------------------------------------------------------------------*/


/**
   @brief Find orderdef raw frame for NIR OFF
   @param frames The input frameset
    
   @return Pointer to order table frame
    
*/
/*---------------------------------------------------------------------------*/

cpl_frame * xsh_find_raw_orderdef_nir_off( cpl_frameset * frames )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  check(tags[0] = xsh_stringcat_any( XSH_ORDERDEF_OFF, (void*)NULL ) ) ;
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}

/**
   @brief Find raw frame for Slit UVB/VIS
   @param frames The input frameset
   @param arm The ARM (UVB or VIS)
   @return Pointer to raw frame
    
*/
cpl_frame * xsh_find_raw_arc_slit_uvb_vis( cpl_frameset * frames,
					   XSH_ARM arm )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  if ( arm == XSH_ARM_UVB )
    check( tags[0] = xsh_stringcat_any( XSH_ARC_SLIT_UVB, (void*)NULL ) ) ;
  else if ( arm == XSH_ARM_VIS )
    check( tags[0] = xsh_stringcat_any( XSH_ARC_SLIT_VIS, (void*)NULL ) ) ;
  else goto cleanup ;

  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}

/**
   @brief Find raw frame for Slit NIR ON
   @param frames The input frameset
    
   @return Pointer to raw frame
    
*/
cpl_frame * xsh_find_raw_arc_slit_nir_on( cpl_frameset * frames )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  check(tags[0] = xsh_stringcat_any( XSH_ARC_SLIT_NIR, (void*)NULL ) ) ;
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}

/**
   @brief Find raw frame for Slit NIR OFF
   @param frames The input frameset
    
   @return Pointer to raw frame
    
*/
cpl_frame * xsh_find_raw_arc_slit_nir_off( cpl_frameset * frames )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  check(tags[0] = xsh_stringcat_any( XSH_ARC_SLIT_OFF, (void*)NULL ) ) ;
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}


/**
   @brief Find model config frame 
   @param frames The input frameset
   @param instr the instrument arm setting 
   @return Pointer to raw frame
    
*/

cpl_frame * xsh_find_calpro_model_config( cpl_frameset * frames,
				      xsh_instrument * instr )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  check(tags[0] = xsh_stringcat_any( XSH_MOD_CFG,
				     xsh_instrument_arm_tostring(instr),
				     (void*)NULL ) ) ;
  xsh_msg_debug("tag=%s",tags[0]);
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}


/**
   @brief Find model config frame 
   @param frames The input frameset
   @param instr the instrument arm setting 
    
   @return Pointer to raw frame
    
*/

cpl_frame * xsh_find_model_config_open( cpl_frameset * frames,
				      xsh_instrument * instr )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  check(tags[0] = xsh_stringcat_any( XSH_MOD_CFG_OPEN,
				     xsh_instrument_arm_tostring(instr),
				     (void*)NULL ) ) ;
  xsh_msg_debug("tag=%s",tags[0]);
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}


/**
   @brief Find model config frame 
   @param frames The input frameset
   @param instr the instrument arm setting 
    
   @return Pointer to raw frame
    
*/

cpl_frame * xsh_find_calpro_model_meas_coord( cpl_frameset * frames,
				      xsh_instrument * instr )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  check(tags[0] = xsh_stringcat_any( XSH_MEASCOORD,
				     xsh_instrument_arm_tostring(instr),
				     (void*)NULL ) ) ;
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}

/**
   @brief Find model wavelength list frame 
   @param frames The input frameset
   @param instr the instrument arm setting 
    
   @return Pointer to raw frame
    
*/

cpl_frame * xsh_find_model_wavelist( cpl_frameset * frames,
				      xsh_instrument * instr )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  check(tags[0] = xsh_stringcat_any( XSH_MODEL_WAVE_LIST,
				     xsh_instrument_arm_tostring(instr),
				     (void*)NULL ) ) ;
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}



/**
   @brief Find model test parameter list 
   @param frames The input frameset
   @param instr the instrument arm setting 
    
   @return Pointer to raw frame
    
*/

cpl_frame * xsh_find_model_testpar( cpl_frameset * frames,
				      xsh_instrument * instr )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;

  check(tags[0] = xsh_stringcat_any( XSH_MODEL_TEST_PAR,
				     xsh_instrument_arm_tostring(instr),
				     (void*)NULL ) ) ;
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}


/**
   @brief Find spectral format frame 
   @param frames The input frameset
   @param instr the instrument arm setting 
    
   @return Pointer to raw frame
    
*/

cpl_frame * xsh_find_spectral_format( cpl_frameset * frames,
				      xsh_instrument * instr )
{
  char *tags[] ={NULL,NULL};
  cpl_frame* result = NULL;
  if(instr->arm == XSH_ARM_NIR) {
    if((result=cpl_frameset_find(frames,XSH_SPECTRAL_FORMAT_JH_NIR)) != NULL){
      return result;
    }
  }
  check(tags[0] = xsh_stringcat_any( XSH_SPECTRAL_FORMAT,
				     xsh_instrument_arm_tostring(instr),
				     (void*)NULL ) ) ;
  check(result = xsh_find_frame (frames,(const char**) tags));

 cleanup:
  cpl_free(tags[0]);
  return result;
}

/*---------------------------------------------------------------------------*/
/**
  @brief Find a frame
  @param frames The input frameset
  @param tags Null-terminated array of tags to search for
  
  @return Pointer to first standard star frame, or NULL on error.

   The function sets an error if no standard star frame is present.
*/
/*---------------------------------------------------------------------------*/
static cpl_frame * 
xsh_find_frame( cpl_frameset *frames, const char *tags[])
{
  cpl_frame *frame = NULL;
  bool found = false;
  char *tags_string = NULL;	/* Used for error message, only */
  char *temp = NULL;
  int i;

  assure (frames != NULL, CPL_ERROR_NULL_INPUT, "Null frameset");
  assure (tags != NULL, CPL_ERROR_NULL_INPUT, "Null tags");
 
  tags_string = xsh_stringdup ("");	/* Message used for empty frame set */

  for (i = 0; !found && tags[i] != NULL; i++) {
    /* Concatenate name to 'tags_string' */
    cpl_free (temp);
    temp = NULL;
    temp = xsh_stringdup (tags_string);

    if (i == 0) {
      cpl_free (tags_string);
      tags_string = NULL;
      check (tags_string = xsh_stringdup (tags[i]));
    }
    else {
      cpl_free (tags_string);
      tags_string = NULL;
      check (tags_string = xsh_stringcat_3 (temp, ", ", tags[i]));
    }

    /* Search for frame */
    frame = cpl_frameset_find (frames, tags[i]);

    if (frame != NULL) {
      found = true;
    }
  }
  if(!found) {
    /*
    xsh_msg_warning("%d, Frameset does not contain any %s frame(s)", 
           CPL_ERROR_DATA_NOT_FOUND,tags_string);
    */
  }
 cleanup:
  cpl_free (tags_string);
  cpl_free (temp);

  return frame;
}

cpl_propertylist*
xsh_frame_head_extract_qc(cpl_frame* frm) {

  cpl_propertylist* qc = NULL;
  const char* name = NULL;
  name = cpl_frame_get_filename(frm);
  qc = cpl_propertylist_load_regexp(name, 0, "^ESO QC *", 0);
  return qc;
}

cpl_boolean
xsh_mode_is_physmod(cpl_frameset* set,xsh_instrument* instrument)
{
  cpl_boolean found;
  cpl_frame* frm1=0;
  cpl_frame* frm2=0;
  cpl_frame* frm3=0;
  cpl_frame* frm4=0;

  frm1=xsh_find_frame_with_tag( set, XSH_MOD_CFG_TAB,instrument);
  frm2=xsh_find_frame_with_tag( set, XSH_MOD_CFG_OPT_FMT,instrument);
  frm3=xsh_find_frame_with_tag( set, XSH_MOD_CFG_OPT_2D,instrument);
  frm4=xsh_find_frame_with_tag( set, XSH_MOD_CFG_OPT_AFC,instrument);

  if( 
    (frm1!=NULL) || 
    (frm2!=NULL) || 
    (frm3!=NULL) || 
    (frm4!=NULL)
      ) {
    found=CPL_TRUE;
  } else {
    found=CPL_FALSE;
  }
  return found;
}

cpl_error_code
xsh_dfs_check_binning(cpl_frameset* set,cpl_frameset* calib)
{

   cpl_frame* ref=NULL;
   cpl_frame* frm=NULL;
   const char* namer=NULL;
   const char* namef=NULL;
   const char* tagr=NULL;
   const char* tagf=NULL;


   cpl_propertylist* href=NULL;
   cpl_propertylist* head=NULL;

   int ref_binx=0;
   int ref_biny=0;
   //int ref_naxis=0;

   int frm_binx=0;
   int frm_biny=0;
   int frm_naxis=0;

   int i=0;
   int ncal=0;

   XSH_ASSURE_NOT_NULL_MSG(set,"Null input raw framest");
   XSH_ASSURE_NOT_NULL_MSG(calib,"Null input cal framest");

   check(ref=cpl_frameset_get_frame(set,0));
   namer=cpl_frame_get_filename(ref);
   tagr=cpl_frame_get_tag(ref);

   href=cpl_propertylist_load(namer,0);

   ref_binx=xsh_pfits_get_binx(href);
   ref_biny=xsh_pfits_get_biny(href);
   //ref_naxis=xsh_pfits_get_naxis(href);

   ncal=cpl_frameset_get_size(calib);

   for(i=0;i<ncal;i++) {

      frm=cpl_frameset_get_frame(calib,i);
      namef=cpl_frame_get_filename(frm);
      head=cpl_propertylist_load(namef,0);
      frm_naxis=xsh_pfits_get_naxis(head);

      if(frm_naxis == 2) {
         /* if the input frame is not a tab we do the check */
          frm_binx=xsh_pfits_get_binx(head);
         frm_biny=xsh_pfits_get_biny(head);

         if(frm_binx != ref_binx || 
            frm_biny != ref_biny ) 
         {
            tagf=cpl_frame_get_tag(frm);
            xsh_msg_error("Calib frame %s (tag=%s, bin=%d,%d)",
                          namef,tagf,frm_binx,frm_biny);
            xsh_msg_error("mismatch raw frame's bin %s (tag=%s, bin=%d,%d).",
                          namer,tagr,ref_binx,ref_biny);
            cpl_error_set(cpl_func,CPL_ERROR_ILLEGAL_INPUT);
         } 
      }
      xsh_free_propertylist(&head);

   }
  cleanup:

   xsh_free_propertylist(&href);
   xsh_free_propertylist(&head);
   return cpl_error_get_code();
}



static cpl_frame*
xsh_frame_pre_subsample(cpl_frame* frm_i, const int binx, const int biny,
		const int rescale,xsh_instrument* inst)
{

  const char* name=NULL;
  xsh_pre* pre_i=NULL;
  xsh_pre* pre_o=NULL;

  cpl_frame* frm_o=NULL;
  const char* tag=NULL;

  const char* basename=NULL;
  char new_name[256];
  cpl_propertylist* plist=NULL;
  check(name=cpl_frame_get_filename(frm_i));
  check(tag=cpl_frame_get_tag(frm_i));

  check(basename=xsh_get_basename(name));

  sprintf(new_name,"fctx%d_fcty%d_%s",binx,biny,basename);
  pre_i=xsh_pre_load(frm_i,inst);
  xsh_msg("new_name=%s",new_name);
  plist=pre_i->data_header;
  xsh_plist_div_by_fct(&plist,binx,biny);
  pre_o=xsh_pre_subsample (pre_i, binx, biny, rescale,inst);
  xsh_free_propertylist(&(pre_o->data_header));
  xsh_free_propertylist(&(pre_o->errs_header));
  xsh_free_propertylist(&(pre_o->qual_header));
  pre_o->data_header=cpl_propertylist_duplicate(pre_i->data_header);
  pre_o->errs_header=cpl_propertylist_duplicate(pre_i->errs_header);
  pre_o->qual_header=cpl_propertylist_duplicate(pre_i->qual_header);

  frm_o=xsh_pre_save(pre_o,new_name,tag,1);
  cpl_frame_set_filename(frm_o,new_name);
 cleanup:

   xsh_pre_free(&pre_o);
   xsh_pre_free(&pre_i);

  return frm_o;
}




static cpl_frameset*
xsh_correct_frameset_calib_bin(cpl_frameset* input, const int ref_binx,
		const int ref_biny,xsh_instrument* inst)
{
  cpl_frameset* correct=NULL;
  cpl_frame* frm=NULL;
  cpl_frame* frm_new=NULL;
  cpl_propertylist* plist=NULL;

  const char* name=NULL;
  const char* tag=NULL;
  int inp_binx=1;
  int inp_biny=1;
  int i=0;
  int sz=0;
  int fctx=0;
  int fcty=0;

  sz=cpl_frameset_get_size(input);
  correct=cpl_frameset_new();
  for(i=0;i<sz;i++) {
    frm=cpl_frameset_get_frame(input,i);
    name=cpl_frame_get_filename(frm);
    tag=cpl_frame_get_tag(frm);
    if(strstr(tag,"MASTER") != NULL) {
      plist=cpl_propertylist_load(name,0);
      inp_binx=xsh_pfits_get_binx(plist);
      inp_biny=xsh_pfits_get_biny(plist);

      if(inp_binx < ref_binx || inp_biny < ref_biny) {
        xsh_msg("rescaling calib frame %s",cpl_frame_get_tag(frm));
        fctx=ref_binx/inp_binx;
        fcty=ref_biny/inp_biny;
        frm_new=xsh_frame_pre_subsample(frm,fctx,fcty,1,inst);
        check(cpl_frameset_insert(correct,frm_new));
      } else {
        /* input of proper binning */
        check(cpl_frameset_insert(correct,cpl_frame_duplicate(frm)));
      }
    } else {
      check(cpl_frameset_insert(correct,cpl_frame_duplicate(frm)));
    }
    xsh_free_propertylist(&plist);

  }

  cleanup:
  return correct;
}



static cpl_frameset*
xsh_correct_frameset_raws_bin(cpl_frameset* input, const int ref_binx,
		const int ref_biny,xsh_instrument* inst)
{
  cpl_frameset* correct=NULL;
  cpl_frame* frm=NULL;
  cpl_frame* frm_new=NULL;
  cpl_propertylist* plist=NULL;

  const char* name=NULL;
  int inp_binx=1;
  int inp_biny=1;
  int i=0;
  int sz=0;
  int fctx=0;
  int fcty=0;

  sz=cpl_frameset_get_size(input);
  correct=cpl_frameset_new();
  for(i=0;i<sz;i++) {
    frm=cpl_frameset_get_frame(input,i);
    name=cpl_frame_get_filename(frm);

    plist = cpl_propertylist_load(name, 0);
    inp_binx = xsh_pfits_get_binx(plist);
    inp_biny = xsh_pfits_get_biny(plist);


    xsh_msg("rescaling raw frame %s", cpl_frame_get_tag(frm));

    fctx = ref_binx / inp_binx;
    fcty = ref_biny / inp_biny;

    /* rescale flux */
    frm_new=xsh_frame_pre_subsample(frm,fctx,fcty,0,inst);
    check(cpl_frameset_insert(correct,frm_new));

    xsh_free_propertylist(&plist);

  }

  cleanup:
  return correct;
}
/* in case the input master flat/bias do not match in bin size with the raw data,
   * correct the binning so that :
   *
   * 1x1 std 2x2 mflat,mbias --> correct bin of std
   * 2x2 std 1x1 mflat,mbias --> correct bin of mflat,mbias
   *
   */

cpl_error_code
xsh_frameset_uniform_bin(cpl_frameset** raws, cpl_frameset** calib,
		xsh_instrument* instrument)
{

  if((*raws != NULL) && (*calib != NULL) &&
		  (xsh_instrument_get_arm(instrument) != XSH_ARM_NIR)) {
    int raw_binx=0;
    int raw_biny=0;
    int cal_binx=0;
    int cal_biny=0;
    const char* name=NULL;
    cpl_propertylist* plist=NULL;
    //cpl_frameset_dump(*calib,stdout);
    //cpl_frameset_dump(*raws,stdout);
    //check(*calib=xsh_correct_calib(*raws,*calib));
    cpl_frame* raw_frm=NULL;
    cpl_frame* mflat=NULL;
    raw_frm=cpl_frameset_get_frame(*raws,0);

    name=cpl_frame_get_filename(raw_frm);
    plist=cpl_propertylist_load(name,0);
    raw_binx=xsh_pfits_get_binx(plist);
    raw_biny=xsh_pfits_get_biny(plist);
    xsh_free_propertylist(&plist);
    //cpl_frameset_dump(*calib,stdout);
    if( (mflat = xsh_find_frame_with_tag(*calib,XSH_MASTER_FLAT_SLIT,instrument)) == NULL) {
      xsh_msg_error("Missing required input %s",XSH_GET_TAG_FROM_MODE ( XSH_MASTER_FLAT, instrument));
      cpl_error_set(cpl_func, CPL_ERROR_FILE_NOT_FOUND);
      goto cleanup;
    }

    name=cpl_frame_get_filename(mflat);
    plist=cpl_propertylist_load(name,0);
    cal_binx=xsh_pfits_get_binx(plist);
    cal_biny=xsh_pfits_get_biny(plist);
    xsh_free_propertylist(&plist);
    /*
    xsh_msg("raw frame %s %s",cpl_frame_get_filename(raw_frm),cpl_frame_get_tag(raw_frm));
    xsh_msg("cal frame %s %s",cpl_frame_get_filename(cal_frm),cpl_frame_get_tag(cal_frm));
    xsh_msg("raw bin: %d %d",raw_binx,raw_biny);
    xsh_msg("cal bin: %d %d",cal_binx,cal_biny);
    */
    if ( raw_binx == cal_binx && raw_biny == cal_biny) {
    } else if ( raw_binx > cal_binx || raw_biny > cal_biny) {
      check(*calib=xsh_correct_frameset_calib_bin(*calib,raw_binx,raw_biny,instrument));
    } else {

       //xsh_msg("cal bin=%d %d",cal_binx,cal_biny);
      check(*raws=xsh_correct_frameset_raws_bin(*raws,cal_binx,cal_biny,instrument));
      xsh_instrument_set_binx(instrument,cal_binx);
      xsh_instrument_set_biny(instrument,cal_biny);

    }
    //check(xsh_dfs_check_binning(*raws,*calib));
  }

  cleanup:

  return cpl_error_get_code();

}


cpl_frameset*
xsh_correct_calib(cpl_frameset* raws, cpl_frameset* calib){
	int raw_binx=1;
	int raw_biny=1;
	int cal_binx=1;
	int cal_biny=1;
	int fctx=0;
	int fcty=0;

	cpl_propertylist* plist=NULL;
	const char* name=NULL;
	cpl_frame* frm=NULL;
	cpl_frame* frm_new=NULL;
	int i=0;
	int sz=0;
	const char* tag=NULL;
	cpl_frameset* calib_new=NULL;

	check(frm=cpl_frameset_get_frame(raws,0));
	name=cpl_frame_get_filename(frm);
	plist=cpl_propertylist_load(name,0);
	raw_binx=xsh_pfits_get_binx(plist);
	raw_biny=xsh_pfits_get_biny(plist);
	xsh_free_propertylist(&plist);
	sz=cpl_frameset_get_size(calib);

	calib_new=cpl_frameset_new();
	for(i=0;i<sz;i++) {
		frm=cpl_frameset_get_frame(calib,i);
		name=cpl_frame_get_filename(frm);
		tag=cpl_frame_get_tag(frm);
		if(strstr(tag,"MASTER") != NULL) {
			plist=cpl_propertylist_load(name,0);
			cal_binx=xsh_pfits_get_binx(plist);
			cal_biny=xsh_pfits_get_biny(plist);

			if(cal_binx > raw_binx || cal_biny > raw_biny) {
				xsh_msg("rescaling cal frame %s",cpl_frame_get_tag(frm));
				fctx=cal_binx/raw_binx;
				fcty=cal_biny/raw_biny;
				frm_new=xsh_frame_image_mult_by_fct(frm,fctx,fcty);
				cpl_frameset_insert(calib_new,frm_new);
			} else if(cal_binx < raw_binx || cal_biny < raw_biny) {
				xsh_msg("rescaling cal frame %s",cpl_frame_get_tag(frm));
				fctx=raw_binx/cal_binx;
				fcty=raw_biny/cal_biny;
				frm_new=xsh_frame_image_div_by_fct(frm,fctx,fcty);
				check(cpl_frameset_insert(calib_new,frm_new));
			} else {
				/* input of proper binning */
				check(cpl_frameset_insert(calib_new,cpl_frame_duplicate(frm)));
			}
		} else {
			check(cpl_frameset_insert(calib_new,cpl_frame_duplicate(frm)));
		}
		xsh_free_propertylist(&plist);

	}

	cleanup:
	xsh_free_propertylist(&plist);
	xsh_free_frameset(&calib);

	return calib_new;

}

static cpl_error_code
xsh_frame_nir_tab_chop_Kband(cpl_frame* frame, const int absordmin,
		const char* colname)
{

 cpl_table* tab=NULL;
 cpl_table* ext=NULL;
 const char* name=NULL;
 const char* basename=NULL;
 char new_name[256];
 cpl_propertylist* head=NULL;
 cpl_propertylist* hext=NULL;
 int next=0;
 int i=0;

 name=cpl_frame_get_filename(frame);
 basename=xsh_get_basename(name);
 sprintf(new_name,"cut_nir_HJ_%s",basename);
 next=cpl_frame_get_nextensions(frame);

 head=cpl_propertylist_load(name,0);
 for(i=1;i<=next;i++) {
   tab=cpl_table_load(name,i,0);
   hext=cpl_propertylist_load(name,i);
   cpl_table_and_selected_int(tab,colname,CPL_GREATER_THAN,absordmin-1);
   ext=cpl_table_extract_selected(tab);
   if(i==1) {
     check(cpl_table_save(ext,head,hext,new_name,CPL_IO_DEFAULT));
   } else {
     check(cpl_table_save(ext,head,hext,new_name,CPL_IO_EXTEND));
   }
   xsh_free_propertylist(&hext);
   xsh_free_table(&tab);
   xsh_free_table(&ext);
 }
 cpl_frame_set_filename(frame,new_name);
 xsh_add_temporary_file(new_name);

 cleanup:
 xsh_free_propertylist(&head);
 xsh_free_propertylist(&hext);
 xsh_free_table(&tab);
 xsh_free_table(&ext);

 return cpl_error_get_code();

}



static cpl_error_code
xsh_calib_nir_predict_corr_if_JH(cpl_frameset* calib,xsh_instrument* instr)
{
  XSH_ASSURE_NOT_NULL_MSG(calib,"Null input calib par");
  XSH_ASSURE_NOT_NULL_MSG(instr,"Null input instr par");

 cleanup:
  return cpl_error_get_code();

}

static cpl_error_code
xsh_calib_nir_orderpos_corr_if_JH(cpl_frameset* calib,xsh_instrument* instr)
{
  int absordmin=instr->config->order_min;
  cpl_frame*  order_tab_guess=NULL;
  XSH_ASSURE_NOT_NULL_MSG(calib,"Null input calib par");
  XSH_ASSURE_NOT_NULL_MSG(instr,"Null input instr par");

  if(NULL!= (order_tab_guess = xsh_find_frame_with_tag(calib,
						       XSH_ORDER_TAB_GUESS,
						       instr)) ) {
    xsh_frame_nir_tab_chop_Kband( order_tab_guess,absordmin,"ABSORDER");
  }


 cleanup:
  return cpl_error_get_code();

}



static cpl_error_code
xsh_calib_nir_mflat_corr_if_JH(cpl_frameset* calib,xsh_instrument* instr)
{
 cpl_frame* cen_order_tab_frame = NULL;
 int absordmin=instr->config->order_min;

 XSH_ASSURE_NOT_NULL_MSG(calib,"Null input calib par");
 XSH_ASSURE_NOT_NULL_MSG(instr,"Null input instr par");

 check( cen_order_tab_frame = xsh_find_order_tab_centr( calib, instr));

 xsh_frame_nir_tab_chop_Kband( cen_order_tab_frame,absordmin,"ABSORDER");

 cleanup:

 return cpl_error_get_code();

}


static cpl_error_code
xsh_calib_nir_2dmap_corr_if_JH(cpl_frameset* calib,xsh_instrument* instr)
{
 cpl_frame* order_tab_edges = NULL;
 cpl_frame* theo_tab_mult = NULL;
 int absordmin=instr->config->order_min;

 XSH_ASSURE_NOT_NULL_MSG(calib,"Null input calib par");
 XSH_ASSURE_NOT_NULL_MSG(instr,"Null input instr par");

 check(order_tab_edges = xsh_find_order_tab_edges( calib, instr));
 xsh_frame_nir_tab_chop_Kband(order_tab_edges,absordmin,"ABSORDER");
 if(NULL!=(theo_tab_mult = xsh_find_frame_with_tag( calib,XSH_THEO_TAB_MULT, 
						    instr))) {
   xsh_frame_nir_tab_chop_Kband(theo_tab_mult,absordmin,"Order");

 }

 cleanup:

 return cpl_error_get_code();

}



static cpl_error_code
xsh_calib_nir_wavecal_corr_if_JH(cpl_frameset* calib,xsh_instrument* instr)
{
  XSH_ASSURE_NOT_NULL_MSG(calib,"Null input calib par");
  XSH_ASSURE_NOT_NULL_MSG(instr,"Null input instr par");

  cpl_frame* order_tab_edges=NULL;
  cpl_frame* disp_tab_frame=NULL;
  int absordmin=instr->config->order_min;
  XSH_ASSURE_NOT_NULL_MSG(calib,"Null input calib par");
  XSH_ASSURE_NOT_NULL_MSG(instr,"Null input instr par");

  check(order_tab_edges = xsh_find_order_tab_edges( calib, instr));
  xsh_frame_nir_tab_chop_Kband(order_tab_edges,absordmin,"ABSORDER");
  if(NULL != (disp_tab_frame = xsh_find_disp_tab( calib, instr))) {
    xsh_frame_nir_tab_chop_Kband(disp_tab_frame,absordmin,"ORDER"); 
  }


 cleanup:
  return cpl_error_get_code();

}


static cpl_error_code
xsh_calib_nir_scired_corr_if_JH(cpl_frameset* calib,xsh_instrument* instr)
{

  cpl_frame* order_tab_edges=NULL;
  cpl_frame* disp_tab_frame=NULL;
  cpl_frame* wave_tab_frame=NULL;
  int absordmin=instr->config->order_min;
  XSH_ASSURE_NOT_NULL_MSG(calib,"Null input calib par");
  XSH_ASSURE_NOT_NULL_MSG(instr,"Null input instr par");

  check(order_tab_edges = xsh_find_order_tab_edges( calib, instr));
  check(xsh_frame_nir_tab_chop_Kband(order_tab_edges,absordmin,"ABSORDER"));
  if(NULL != (disp_tab_frame = xsh_find_disp_tab( calib, instr))) {
    check(xsh_frame_nir_tab_chop_Kband(disp_tab_frame,absordmin,"ORDER")); 
  }
  if(NULL != (wave_tab_frame = xsh_find_wave_tab( calib, instr))) {
    //check(xsh_frame_nir_tab_chop_Kband(wave_tab_frame,absordmin,"ORDER")); 
  }
 cleanup:
  return cpl_error_get_code();

}


cpl_error_code
xsh_calib_nir_respon_corr_if_JH(cpl_frameset* calib,xsh_instrument* instr)
{
 cpl_frame* edges_order_tab_frame = NULL;
 cpl_frame* spectral_format_frame = NULL;
 cpl_table* tab_edges=NULL;

 const char* fname = NULL;
 double min=0;

 XSH_ASSURE_NOT_NULL_MSG(calib,"Null input calib par");
 XSH_ASSURE_NOT_NULL_MSG(instr,"Null input instr par");

 check( edges_order_tab_frame = xsh_find_order_tab_edges( calib, instr));
 fname=cpl_frame_get_filename(edges_order_tab_frame);
 tab_edges=cpl_table_load(fname,1,0);
 min=cpl_table_get_column_min(tab_edges,"ABSORDER");

 if(min==13) {
   xsh_msg("entrato");
   instr->config->order_min=13;
   instr->config->order_max=26;
   instr->config->orders=14;

   /* correct spectral format table */
   check( spectral_format_frame = xsh_find_spectral_format( calib, instr));
   xsh_frame_nir_tab_chop_Kband( spectral_format_frame,13,"ORDER");

   /* correct other tables */
   check(xsh_calib_nir_scired_corr_if_JH(calib,instr));


 }

 cleanup:
 xsh_free_table(&tab_edges);

 return cpl_error_get_code();

}
cpl_error_code
xsh_calib_nir_corr_if_JH(cpl_frameset* calib,xsh_instrument* instr,
		const char* recid)
{

  XSH_ASSURE_NOT_NULL_MSG(calib,"Null input calib par");
  XSH_ASSURE_NOT_NULL_MSG(instr,"Null input instr par");
  XSH_ASSURE_NOT_NULL_MSG(recid,"Null input recid par");

  if( instr->arm == XSH_ARM_NIR && 
      instr->config->order_min==13 &&
      instr->config->order_max==26 &&
      instr->config->orders==14
      ) {
    /* this can happen only in NIR-JH */

    if(strcmp(recid,"xsh_predict") == 0) {
      check(xsh_calib_nir_predict_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_orderpos") == 0) {
      check(xsh_calib_nir_orderpos_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_mflat") == 0) {
      check(xsh_calib_nir_mflat_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_2dmap") == 0) {
      check(xsh_calib_nir_2dmap_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_wavecal") == 0) {
      check(xsh_calib_nir_wavecal_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_flexcomp") == 0) {
      check(xsh_calib_nir_wavecal_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_respon_slit_stare") == 0) {
      check(xsh_calib_nir_scired_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_respon_slit_offset") == 0) {
      check(xsh_calib_nir_scired_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_respon_slit_nod") == 0) {
      check(xsh_calib_nir_scired_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_scired_slit_stare") == 0) {
      check(xsh_calib_nir_scired_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_scired_slit_offset") == 0) {
      check(xsh_calib_nir_scired_corr_if_JH(calib,instr));
    } else if(strcmp(recid,"xsh_scired_slit_nod") == 0) {
      check(xsh_calib_nir_scired_corr_if_JH(calib,instr));
    }

  }
 cleanup:
  return cpl_error_get_code();

}

cpl_error_code
xsh_dfs_check_mflat_is_proper(xsh_instrument* inst,cpl_frameset** calib)
{

  cpl_frame* frm_mflat=NULL;
  cpl_frame* frm_mflat_new=NULL;
  int ref_binx=0;
  int ref_biny=0;
  int binx=0;
  int biny=0;
  int fctx=1;
  int fcty=1;
  cpl_propertylist* plist=NULL;
  const char* name=NULL;
  char tag[256];


  sprintf(tag,"%s_%s",XSH_MASTER_FLAT_SLIT,xsh_instrument_arm_tostring(inst));
  ref_binx=inst->binx;  
  ref_biny=inst->biny;  
  xsh_msg("tag=%s",tag);
  xsh_msg("binx=%d biny=%d",ref_binx,ref_biny);
  check(frm_mflat=cpl_frameset_find(*calib,tag));
  check(name=cpl_frame_get_filename(frm_mflat));
  plist=cpl_propertylist_load(name,0);
  binx=xsh_pfits_get_binx(plist);
  biny=xsh_pfits_get_biny(plist);

  if(binx > ref_binx ||biny > ref_biny) {
    xsh_msg("compute syntetic frame by division");  
    fctx=binx/ref_binx;
    fcty=biny/ref_biny;
    frm_mflat_new=xsh_frame_image_div_by_fct(frm_mflat,fctx,fcty);
    cpl_frameset_erase_frame(*calib,frm_mflat);
    cpl_frameset_insert(*calib,frm_mflat_new);

  } else if(binx < ref_binx ||biny < ref_biny) {  
    xsh_msg("compute syntetic frame by multiplication");  
    fctx=ref_binx/binx;
    fcty=ref_biny/biny;
    frm_mflat_new=xsh_frame_image_mult_by_fct(frm_mflat,fctx,fcty);
    cpl_frameset_erase_frame(*calib,frm_mflat);
    cpl_frameset_insert(*calib,frm_mflat_new);
  } else {
    xsh_msg("keep same frame binx=%d ref_binx=%d biny=%d ref_biny=%d",
	    binx,ref_binx,biny,ref_biny);
    /* do nothing, frames are proper */
  }


 cleanup:
  xsh_free_propertylist(&plist);
  return cpl_error_get_code();

}


cpl_error_code
xsh_frameset_check_uniform_exptime(cpl_frameset* raws, xsh_instrument* inst)
{
  int i=0;
  int sz=0;
  cpl_frame* frm=NULL;
  cpl_propertylist* plist=NULL;
  const char* name=NULL;
  double ref_exptime=0;
  double tmp_exptime=0;
  XSH_ARM arm;
  arm=xsh_instrument_get_arm(inst);
  const char* info=NULL;
  if(arm==XSH_ARM_NIR) {
    info="DIT";
  } else {
    info="EXPTIME";
  }
  sz=cpl_frameset_get_size(raws);
  for(i=0;i<sz;i++){
    check(frm=cpl_frameset_get_frame(raws,i));
    name=cpl_frame_get_filename(frm);
    plist=cpl_propertylist_load(name,0);

    if(i==0) { 
      if(arm==XSH_ARM_NIR) {
        ref_exptime=xsh_pfits_get_dit(plist);
      } else {
        ref_exptime=xsh_pfits_get_det_win1_uit1(plist);
      }
      tmp_exptime=ref_exptime;
    } else {
      if(arm==XSH_ARM_NIR) {
        tmp_exptime=xsh_pfits_get_dit(plist);
      } else {
        tmp_exptime=xsh_pfits_get_det_win1_uit1(plist);
      }
      if( fabs(tmp_exptime-ref_exptime) > 0.001) {
	      xsh_msg_error("Some dark has %s different from others.",info);
	      xsh_msg("%s(%d)=%g %s(0)=%g",info,i,tmp_exptime,info,ref_exptime);
	      cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_INPUT);
      }
    }   
    xsh_free_propertylist(&plist);
  } 

 cleanup:
  xsh_free_propertylist(&plist);
  return cpl_error_get_code();
}


cpl_error_code
xsh_table_save(cpl_table* t, cpl_propertylist* ph, cpl_propertylist* xh,
		const char* fname, const int ext) {

  if (ext==0) {
    cpl_table_save(t,ph,xh,fname,CPL_IO_DEFAULT);
  } else {
    cpl_table_save(t,ph,xh,fname,CPL_IO_EXTEND);
  }

  return cpl_error_get_code();

}

cpl_error_code
xsh_vector_save(cpl_vector* v, cpl_propertylist* ph, const char* fname,
		const int ext) {

  if (ext==0) {
    cpl_vector_save(v,fname,CPL_BPP_IEEE_FLOAT,ph,CPL_IO_DEFAULT);
  } else {
    cpl_vector_save(v,fname,CPL_BPP_IEEE_FLOAT,ph,CPL_IO_EXTEND);
  }

  return cpl_error_get_code();

}

cpl_error_code
xsh_add_afc_info(cpl_frame* frm_m, cpl_frame* frm_o) {

  double yshift=0;
  double xshift=0;
  cpl_propertylist* head_m=NULL;
  cpl_propertylist* head_o=NULL;
  const char* name_m=NULL;
  const char* name_o=NULL;
  cpl_image* ima=NULL;

  name_m=cpl_frame_get_filename(frm_m);
  name_o=cpl_frame_get_filename(frm_o);
  head_m=cpl_propertylist_load(name_m,0);
  head_o=cpl_propertylist_load(name_o,0);
  ima=cpl_image_load(name_o,XSH_PRE_DATA_TYPE,0,0);

  if(cpl_propertylist_has(head_m,XSH_QC_AFC_XSHIFT)) {
    xshift=cpl_propertylist_get_double(head_m,XSH_QC_AFC_XSHIFT);
    cpl_propertylist_append_double(head_o,XSH_QC_AFC_XSHIFT,xshift);
    cpl_propertylist_set_comment(head_o,XSH_QC_AFC_XSHIFT,XSH_QC_AFC_XSHIFT_C);
  }

  if(cpl_propertylist_has(head_m,XSH_QC_AFC_YSHIFT)) {
    yshift=cpl_propertylist_get_double(head_m,XSH_QC_AFC_YSHIFT);
    cpl_propertylist_append_double(head_o,XSH_QC_AFC_YSHIFT,yshift);
    cpl_propertylist_set_comment(head_o,XSH_QC_AFC_YSHIFT,XSH_QC_AFC_YSHIFT_C);
  }
 

  cpl_image_save(ima,name_o,XSH_PRE_DATA_BPP,head_o,CPL_IO_DEFAULT);
 
  xsh_free_image(&ima);
  xsh_free_propertylist(&head_m);
  xsh_free_propertylist(&head_o);

 return cpl_error_get_code();

}


/**
 * @internal
 * @brief Extracts the aperture from a slit string.
 * @param[in] string  The string containing slit information in the format:
 *      "\<number\>x\<number\>[\<string\>]".
 * @param[out] aperture  the extracted aperture value will be written to the
 *      location pointed to by this parameter.
 * @return @c CPL_TRUE if the value was extracted correctly and @c CPL_FALSE
 *      otherwise.
 */
static cpl_boolean xsh_aperture_string_to_double(const char* string,
                                                 double* aperture)
{
  assert(string != NULL);
  assert(aperture != NULL);
  
  /* Find the 'x' character in the string.
   * Expected format is "%fx%f <optional>". Where <optional> is any string of
   * characters. */
  const char* x = strchr(string, 'x');
  if (x == NULL) return CPL_FALSE;
  int lenx = strlen(x);
  /* Here we assume that what  we need are just the 1st 3 chars of the string
     better would be to use lenx and take all string elements up to lenx-1 */
  char value[10];
  strncpy(value,string,lenx);
  //xsh_msg("value=%s",value);
  //++x;  /* Skip the character 'x'. */
  /* Convert the rest of the string to double. */
  char* endptr = NULL;
  errno = 0;  /* Reset ERANGE. */
  *aperture = strtod(value, &endptr);
  if (endptr == NULL) return CPL_FALSE;
  /* Check that there was a space character after converting the number of the
   * end of line was already reached. */
  if (*endptr != '\0') {
    if (isdigit(*endptr)) return CPL_FALSE;
  }
  /* Check for overflows. */
  if (errno == ERANGE) {
    cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
                          "Value overflowed and is out of range.");
    return CPL_FALSE;
  }
  *aperture /= 3600.;  /* Convert to degrees. */
  
  return CPL_TRUE;
}

/**
 * @internal
 * @brief Tries to identify the units string to used based in BUNIT.
 * @param header  The header containing the BUNIT keyword to read from.
 * @param colname  Name of the column to used in error messages.
 * @return A string containing the nominal units to use or NULL on error.
 */
static const char * xsh_get_column_unit(cpl_propertylist * header,
                                        const char * colname)
{
  cpl_errorstate prestate = cpl_errorstate_get();
  const char* bunit = cpl_propertylist_get_string(header, XSH_BUNIT);
  const char* column_unit = NULL;
  if (bunit != NULL) {
    if (strcasecmp(bunit, "ADU") == 0) {
      column_unit = XSH_SDP_ADU_UNIT;
    } else if (strcasecmp(bunit, "erg/s/cm2/Angstrom") == 0) {
      column_unit = XSH_SDP_FLUX_UNIT;
    } else {
      cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                          "Could not identify the units for the %s.", colname);
    }
  }
  if (! cpl_errorstate_is_equal(prestate)) return NULL;
  return column_unit;
}
/**
 * @internal
 * @brief Calculates number of raw frames.
 *
 * @param frames  The list of used frames to check.
*/
static int xsh_get_nraws(const cpl_frameset* frames)
{
    cpl_frameset_iterator* iter = NULL;
    int counter=0;
    iter = cpl_frameset_iterator_new(frames);
    const cpl_frame* frame = cpl_frameset_iterator_get_const(iter);
    while (frame != NULL) {
        if (cpl_frame_get_group(frame) == CPL_FRAME_GROUP_RAW) {
            counter++;
        }
        cpl_errorstate status = cpl_errorstate_get();
        cpl_frameset_iterator_advance(iter, 1);
        if (cpl_error_get_code() == CPL_ERROR_ACCESS_OUT_OF_RANGE) {
              cpl_errorstate_set(status);
        }
        frame = cpl_frameset_iterator_get_const(iter);
    }
    cpl_frameset_iterator_delete(iter);
    return counter;
}

/**
 * @internal
 * @brief Calculates a value for MJD-END from the list of used frames.
 *
 * The MJD_END value is the taken as the highest MJD-OBS value found in the
 * product frame of list of used frames, plus the exposure time for the last
 * frame.
 *
 * @param product_frame  The product frame to check.
 * @param usedframes  The list of used frames to check.
 * @param arm  The instrument arm being used.
 * @return A value to use for MJD-END or NAN if an error occurred. If an error
 *      did occur then an error code will be set that can be checked with
 *      @c cpl_error_get_code.
 */
static double xsh_calculate_mjd_end(const cpl_frame *product_frame,
                                    const cpl_frameset *usedframes,
                                    XSH_ARM arm)
{
  cpl_propertylist* keywords = NULL;
  cpl_frameset_iterator* iter = NULL;
  double mjdend = NAN;

  /* Calculate MJD-END by finding the largest MJD-OBS value from the raw input
   * files. */
  const char* filename;
  check(filename = cpl_frame_get_filename(product_frame));
  check(keywords = cpl_propertylist_load(filename, 0));
  check(mjdend = cpl_propertylist_get_double(keywords, XSH_MJDOBS));

  iter = cpl_frameset_iterator_new(usedframes);
  const cpl_frame* frame = cpl_frameset_iterator_get_const(iter);
  while (frame != NULL) {
    if (cpl_frame_get_group(frame) == CPL_FRAME_GROUP_RAW) {
      /* Load the primary header keywords from the raw frame. */
      check(filename = cpl_frame_get_filename(frame));
      cpl_propertylist_delete(keywords);
      check(keywords = cpl_propertylist_load(filename, 0));
      /* Extract the MJD-OBS and EXPTIME keywords and update the mjdend
       * candidate. */
      double obsval=0, expval=0, total=0, dit=0;
      double factor=1./(86400.);
      int ndit, nditskip;
      check(obsval = cpl_propertylist_get_double(keywords, XSH_MJDOBS));
      switch (arm) {
        case XSH_ARM_NIR:
          check(dit = cpl_propertylist_get_double(keywords, XSH_DET_DIT));
          check(ndit = cpl_propertylist_get_int(keywords, XSH_DET_NDIT));
          check(nditskip = cpl_propertylist_get_int(keywords,
                                                    XSH_DET_NDITSKIP));
          if (nditskip == 0) {
            expval = dit * ndit;
          } else {
            xsh_msg_warning("Found '%s' with a non zero value. Do not know how"
                            " to handle this case so will over estimate '%s'.",
                            XSH_DET_NDITSKIP, XSH_MJDEND);
          }
          break;
        default:
          check(expval = cpl_propertylist_get_double(keywords, XSH_EXPTIME));
          break;
      }
      total = obsval + expval * factor;
      if (total > mjdend) mjdend = total;

    }
    /* Increment the iterator to the next frame. */
    cpl_errorstate status = cpl_errorstate_get();
    cpl_frameset_iterator_advance(iter, 1);
    if (cpl_error_get_code() == CPL_ERROR_ACCESS_OUT_OF_RANGE) {
        cpl_errorstate_set(status);
    }
    frame = cpl_frameset_iterator_get_const(iter);
  }

cleanup:

  cpl_frameset_iterator_delete(iter);
  cpl_propertylist_delete(keywords);
  return mjdend;
}

/**
 * @internal
 * @brief Finds the earliest value for MJD_OBS in the set of inputs.
 *
 * The earliest value found for MJD_OBS in the list of input frames is returned.
 *
 * @param usedframes  The list of used frames to check.
 * @return the earliest MJD_OBS or NAN if an error occurred. If an error did
 *      occur then an error code will be set that can be checked with
 *      @c cpl_error_get_code.
 */
static double xsh_find_first_mjd_obs(const cpl_frameset *usedframes)
{
  cpl_propertylist* keywords = NULL;
  cpl_frameset_iterator* iter = NULL;
  double mjdobs = NAN;

  iter = cpl_frameset_iterator_new(usedframes);
  const cpl_frame* frame = cpl_frameset_iterator_get_const(iter);
  while (frame != NULL) {
    if (cpl_frame_get_group(frame) == CPL_FRAME_GROUP_RAW) {
      /* Load the primary header keywords from the raw frame. */
      const char* filename;
      check(filename = cpl_frame_get_filename(frame));
      check(keywords = cpl_propertylist_load(filename, 0));
      /* Extract the MJD-OBS keyword and check if its the earliest one. */
      double val;
      check(val = cpl_propertylist_get_double(keywords, XSH_MJDOBS));
      cpl_propertylist_delete(keywords);
      keywords = NULL;
      if (isnan(mjdobs)) {
        mjdobs = val;
      } else if (val < mjdobs) {
        mjdobs = val;
      }
    }
    /* Increment the iterator to the next frame. */
    cpl_errorstate status = cpl_errorstate_get();
    cpl_frameset_iterator_advance(iter, 1);
    if (cpl_error_get_code() == CPL_ERROR_ACCESS_OUT_OF_RANGE) {
        cpl_errorstate_set(status);
    }
    frame = cpl_frameset_iterator_get_const(iter);
  }

cleanup:
  cpl_frameset_iterator_delete(iter);
  cpl_propertylist_delete(keywords);
  return mjdobs;
}

/**
 * @internal
 * @brief Fills SDP spectrum object with PROVi keywords.
 *
 * Fills the spectrum with PROVi keywords corresponding to the raw science data
 * files used for a final SDP product. The PROVi keyword is filled with the
 * content of ARCFILE if this keyword is found in the raw file primary header.
 * Otherwise ORIGFILE is used if ARCFILE is missing. If none of these keywords
 * is found then just the disk file name is used.
 *
 * @param[out] spectrum  The SDP spectrum object to fill with the new keywords.
 * @param[in] usedframes  The list of used frames to add as PROV keywords.
 *
 * If an error occurs then an appropriate error code is set. The caller can
 * check for this with a call to @c cpl_error_get_code().
 */
static void xsh_fill_provenance_keywords(irplib_sdp_spectrum* spectrum,
                                         const cpl_frameset* usedframes)
{
  cpl_propertylist* keywords = NULL;
  cpl_frameset_iterator* iter = NULL;
  int ncombine = 0;
//  xsh_msg_warning("Inside xsh_fill_provenance_keywords");

  iter = cpl_frameset_iterator_new(usedframes);
  const cpl_frame* frame = cpl_frameset_iterator_get_const(iter);
  while (frame != NULL) {
    if (cpl_frame_get_group(frame) == CPL_FRAME_GROUP_RAW) {
      /* Load the keywords from the raw frame. */
      const char* filename;
      check(filename = cpl_frame_get_filename(frame));
      check(keywords = cpl_propertylist_load(filename, 0));

      /* Try set the prov_value to ARCFILE or ORIGFILE or just the filename,
       * whichever is found first in that order. */
      const char* prov_value = NULL;
      if (cpl_propertylist_has(keywords, XSH_ARCFILE)) {
        check(prov_value = cpl_propertylist_get_string(keywords, XSH_ARCFILE));
      } else if (cpl_propertylist_has(keywords, XSH_ORIGFILE)) {
        check(prov_value = cpl_propertylist_get_string(keywords, XSH_ORIGFILE));
      } else {
        prov_value = filename;
      }
      /* Add the next PROVi keyword. */
      /* PIPE-9314: Check the DPR TYPE of the incoming file
       * Knock SKY frames out of contention */
      const char* dpr_type = cpl_propertylist_get_string(keywords, XSH_DPR_TYPE);
      int is_a_sky = strcmp(dpr_type, "SKY");
//      xsh_msg_warning("xsh_fill_provenance_keywords: is_a_sky = %d, dpr_type = %s", is_a_sky, dpr_type);
//      int is_a_sky = 0;
      if (is_a_sky == 0) {
          xsh_msg_warning("xsh_fill_provenance_keywords: Disallowing a SKY input from being tracked as PROV: %s", prov_value);
      } else {
          ++ncombine;
//          xsh_msg_warning("xsh_fill_provenance_keywords: Use irplib_sdp_spectrum_set_prov as follows:");
//          xsh_msg_warning("ncombine = %d, prov_value = %s", ncombine, prov_value);
          check(irplib_sdp_spectrum_set_prov(spectrum, ncombine, prov_value));
      }
      cpl_propertylist_delete(keywords);
      keywords = NULL;
    }
    /* Increment the iterator to the next frame. */
    cpl_errorstate status = cpl_errorstate_get();
    cpl_frameset_iterator_advance(iter, 1);
    if (cpl_error_get_code() == CPL_ERROR_ACCESS_OUT_OF_RANGE) {
        cpl_errorstate_set(status);
    }
    frame = cpl_frameset_iterator_get_const(iter);
  }

  /* Finally add the NCOMBINE keyword. */
  check(irplib_sdp_spectrum_set_ncombine(spectrum, ncombine));

cleanup:
  cpl_frameset_iterator_delete(iter);
  cpl_propertylist_delete(keywords);
}


/*
 * This is a row record structure used in the lookup tables implemented in the
 * xsh_sdp_spectrum_create function.
 */
struct _xsh_column_info {
    const char* name;
    cpl_type    type;
    const char* unit;
    const char* format;
    const char* tutyp;
    const char* tucd;
};


/**
 * @brief Converts data into Science Data Product 1D spectrum format.
 *
 * @param[out] sdp_spectrum The SDP output spectrum object the will be filled.
 * @param[in] usedframes List of frames used to generate the output spectrum.
 * @param[in] sourcekeys The list of FITS keywords from the source product file
 *  being converted to SDP format.
 * @param[in] instrument The X-Shooter instrument configuration structure.
 * @param[in] spectrum The loaded flux calibrated spectrum in X-Shooter format.
 * @param[in] uncal_spectrum The loaded uncalibrated spectrum in X-Shooter
 *  format.
 *
 * @note If the @a table and @a props objects are not empty, then the spectrum
 *  data and keywords will be appended to the existing values in those objects
 *  instead.
 */
static cpl_error_code xsh_sdp_spectrum_create(
                                    irplib_sdp_spectrum    * sdp_spectrum,
                                    const cpl_frameset     * usedframes,
                                    const cpl_propertylist * sourcekeys,
                                    xsh_instrument         * instrument,
                                    xsh_spectrum           * spectrum,
                                    xsh_spectrum           * uncal_spectrum)
{
  cpl_errorstate prestate;
  cpl_error_code error = CPL_ERROR_NONE;

  cpl_ensure_code(sdp_spectrum != NULL, CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(usedframes != NULL,   CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(sourcekeys != NULL,   CPL_ERROR_NULL_INPUT);
  cpl_ensure_code(instrument != NULL,   CPL_ERROR_NULL_INPUT);

  assert( !(spectrum == NULL && uncal_spectrum == NULL) );

  /* From here we start filling the spectrum data. If we only have the
   * uncalibrated spectrum then pretend that it is the flux calibrated one
   * during this data copy. */
  if (spectrum == NULL) {
    spectrum = uncal_spectrum;
    uncal_spectrum = NULL;
  }

  cpl_size nelem = (cpl_size) xsh_spectrum_get_size(spectrum);
  /* The spectra must be the same size if both are provided. */
  if (uncal_spectrum != NULL) {
    cpl_size uncal_size = (cpl_size) xsh_spectrum_get_size(uncal_spectrum);
    if (nelem != uncal_size) {
      return cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
                                "Both input spectra must have the same size.");
    }
  }

  prestate = cpl_errorstate_get();
  double wavemin = xsh_spectrum_get_lambda_min(spectrum);
  double wavemax = xsh_spectrum_get_lambda_max(spectrum);
  double wavestep = xsh_spectrum_get_lambda_step(spectrum);
  if (! cpl_errorstate_is_equal(prestate)) {
    return cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                            "Failed to find required wavelength information.");
  }

  /* Set default values for various SDP keywords. */
  error |= irplib_sdp_spectrum_set_prodcatg(sdp_spectrum, XSH_SCIENCE_SPECTRUM);
  error |= irplib_sdp_spectrum_set_mepoch(sdp_spectrum, CPL_FALSE);
  error |= irplib_sdp_spectrum_set_contnorm(sdp_spectrum, CPL_FALSE);
  error |= irplib_sdp_spectrum_set_fluxerr(sdp_spectrum,
                                           XSH_SDP_KEYWORD_FLUXERR_VALUE);
  error |= irplib_sdp_spectrum_set_referenc(sdp_spectrum,
                                            XSH_SDP_KEYWORD_REFERENC_VALUE);
  error |= irplib_sdp_spectrum_set_voclass(sdp_spectrum,
                                           XSH_SDP_KEYWORD_VOCLASS_VALUE);
  error |= irplib_sdp_spectrum_set_vopub(sdp_spectrum,
                                         XSH_SDP_KEYWORD_VOPUB_VALUE);

  /* Take the PRODLVL, ORIGIN and SPECSYS keywords from the source list or
   * hardcode their values. */
  if (cpl_propertylist_has(sourcekeys, XSH_SDP_KEYWORD_PRODLVL)) {
    error |= irplib_sdp_spectrum_copy_prodlvl(sdp_spectrum, sourcekeys,
                                              XSH_SDP_KEYWORD_PRODLVL);
  } else {
    error |= irplib_sdp_spectrum_set_prodlvl(sdp_spectrum,
                                             XSH_SDP_KEYWORD_PRODLVL_VALUE);
  }
  if (cpl_propertylist_has(sourcekeys, XSH_SDP_KEYWORD_ORIGIN)) {
    error |= irplib_sdp_spectrum_copy_origin(sdp_spectrum, sourcekeys,
                                             XSH_SDP_KEYWORD_ORIGIN);
  } else {
    error |= irplib_sdp_spectrum_set_origin(sdp_spectrum,
                                            XSH_SDP_KEYWORD_ORIGIN_VALUE);
  }
  if (cpl_propertylist_has(sourcekeys, XSH_SDP_KEYWORD_SPECSYS)) {
    error |= irplib_sdp_spectrum_copy_specsys(sdp_spectrum, sourcekeys,
                                              XSH_SDP_KEYWORD_SPECSYS);
  } else {
    error |= irplib_sdp_spectrum_set_specsys(sdp_spectrum,
                                             XSH_SDP_KEYWORD_SPECSYS_VALUE);
  }

  /* Copy ESO.PRO.REC1.PIPE.ID to PROCSOFT if it is available. */
  if (cpl_propertylist_has(sourcekeys, XSH_PRO_REC1_PIPE_ID)) {
    error |= irplib_sdp_spectrum_copy_procsoft(sdp_spectrum, sourcekeys,
                                               XSH_PRO_REC1_PIPE_ID);
  }

  /* Set the DISPELEM based on the X-Shooter arm. */
  const char* dispelem;
  switch (xsh_instrument_get_arm(instrument)) {
    case XSH_ARM_UVB:
    case XSH_ARM_VIS:
    case XSH_ARM_NIR:
      dispelem = xsh_arm_tostring(xsh_instrument_get_arm(instrument));
      break;
    default:
      dispelem = NULL;
      break;
  }
  if (dispelem != NULL) {
    error |= irplib_sdp_spectrum_set_dispelem(sdp_spectrum, dispelem);
  } else {
    error = cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                          "Could not identify the correct ARM value to be used"
                          " for '%s'.", XSH_SDP_KEYWORD_DISPELEM);
  }

  /* Set PROG_ID from ESO.OBS.PROG.ID */
  error |= irplib_sdp_spectrum_copy_progid(sdp_spectrum, sourcekeys,
                                           XSH_OBS_PROG_ID);

  /* Set OBID1 from ESO.OBS.ID */
  error |= irplib_sdp_spectrum_copy_obid(sdp_spectrum, 1,
                                         sourcekeys, XSH_OBS_ID);

  /* Set OBSTECH from ESO.PRO.TECH */
  error |= irplib_sdp_spectrum_copy_obstech(sdp_spectrum, sourcekeys,
                                            XSH_PRO_TECH);

  /* Set the FLUXCAL keyword based on the content of ESO.PRO.CATG. If the result
   * is flux calibrated then the ESO.PRO.CATG keyword will contain a name that
   * contains the "_FLUX_" substring. */
  const char* procatg = cpl_propertylist_get_string(sourcekeys,
                                                    CPL_DFS_PRO_CATG);
  if (procatg != NULL) {
    const char* fluxcal = "UNCALIBRATED";
    if (strstr(procatg, "_FLUX_") != NULL) {
      fluxcal = "ABSOLUTE";
    }
    error |= irplib_sdp_spectrum_set_fluxcal(sdp_spectrum, fluxcal);
  } else {
    error = cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                          "Could not set '%s' since the '%s' keyword was not"
                          " found.", XSH_SDP_KEYWORD_FLUXCAL, CPL_DFS_PRO_CATG);
  }

  /* Setup the WAVELMIN, WAVELMAX and SPEC_BIN keywords from WCS information. */
  prestate = cpl_errorstate_get();
  double crpix1 = cpl_propertylist_get_double(sourcekeys, XSH_CRPIX1);
  double cdelt1 = cpl_propertylist_get_double(sourcekeys, XSH_CDELT1);
  double crval1 = cpl_propertylist_get_double(sourcekeys, XSH_CRVAL1);
  long naxis1 = cpl_propertylist_get_long(sourcekeys, XSH_NAXIS1);
  if (cpl_errorstate_is_equal(prestate)) {
    double wavelmin = (1 - crpix1) * cdelt1 + crval1;
    double wavelmax = (naxis1 - crpix1) * cdelt1 + crval1;
    double specbin = cdelt1;
    error |= irplib_sdp_spectrum_set_wavelmin(sdp_spectrum, wavelmin);
    error |= irplib_sdp_spectrum_set_wavelmax(sdp_spectrum, wavelmax);
    error |= irplib_sdp_spectrum_set_specbin(sdp_spectrum, specbin);
  } else {
    error = cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                                  "Could not find WCS information.");
  }

  /* Reassign the OBJECT keyword to use the ESO.OBS.TARG.NAME value.
   * Also get the TITLE from the same OBJECT keyword value. */
  const char* object = cpl_propertylist_get_string(sourcekeys,
                                                   XSH_OBS_TARG_NAME);
  if (object != NULL) {
    error |= irplib_sdp_spectrum_set_object(sdp_spectrum, object);
    char* objstr = cpl_strdup(object);
    /* Find second occurrence of ',' in objstr and set it to NULL to trim off
     * anything after that comma. Then generate the title and limit it to 68
     * characters. */
    char* c = strchr(objstr, ',');
    if (c != NULL) {
      c = strchr(c+1, ',');
      if (c != NULL) *c = '\0';
    }
    char* title = cpl_sprintf("%.68s", objstr);
    error |= irplib_sdp_spectrum_set_title(sdp_spectrum, title);
    cpl_free(title);
    cpl_free(objstr);
  } else {
    error = cpl_error_set_message(cpl_func, cpl_error_get_code(),
                  "Could not assign '%s' or '%s' since the '%s' keyword could"
                  " not be found.", XSH_SDP_KEYWORD_OBJECT,
                  XSH_SDP_KEYWORD_TITLE, XSH_OBS_TARG_NAME);
  }

  error |= irplib_sdp_spectrum_copy_ra(sdp_spectrum, sourcekeys, XSH_RA);
  error |= irplib_sdp_spectrum_copy_dec(sdp_spectrum, sourcekeys, XSH_DEC);

  /* Calculate and set the EXPTIME and TEXPTIME (must be identical). */
  prestate = cpl_errorstate_get();
  double exptime = xsh_calculate_exptime(usedframes,
                                         xsh_instrument_get_arm(instrument));
  if (! isnan(exptime)) {
    error |= irplib_sdp_spectrum_set_exptime(sdp_spectrum, exptime);
    error |= irplib_sdp_spectrum_set_texptime(sdp_spectrum, exptime);
  } else if (! cpl_errorstate_is_equal(prestate)) {
    error = cpl_error_get_code();
  }

  /* Copy the MJD-OBS and MJD-END keywords and store their values, which will be
   * used later. */
  prestate = cpl_errorstate_get();
  double mjdobs = cpl_propertylist_get_double(sourcekeys, XSH_MJDOBS);
  double mjdend = cpl_propertylist_get_double(sourcekeys, XSH_MJDEND);

  if (cpl_errorstate_is_equal(prestate)) {
    error |= irplib_sdp_spectrum_set_mjdobs(sdp_spectrum, mjdobs);
    error |= irplib_sdp_spectrum_set_mjdend(sdp_spectrum, mjdend);
  } else {
    mjdobs = mjdend = NAN;
  }

  /* Copy the SNR keyword from the ESO.QC.FLUX.SN keyword. */
  if (cpl_propertylist_has(sourcekeys, XSH_QC_FLUX_SN)) {
    error |= irplib_sdp_spectrum_copy_snr(sdp_spectrum, sourcekeys,
                                          XSH_QC_FLUX_SN);
  }

  /* Get nominal values for LAMNLIN, LAMRMS and SPEC_RES from lookup tables */
  int lamnlin = -1;
  double lamrms = -1;
  double specres = -1;
                     /* UVB, VIS, NIR */
  int lamnlin_lut[3] = {280, 310, 140};
  double lamrms_lut[3][2] = {
      /*    Before           After
       * 1st Jan 2012    1st Jan 2012    ARM */
      {     0.013,          0.003},   /* UVB */
      {     0.013,          0.002},   /* VIS */
      {     0.060,          0.006}    /* NIR */
    };
  double specres_lut[14][3] = {
      /* MCW 200831 (PIPE-9214) - values updated */
      /*  Slit         UVB      VIS      NIR */
      /* 0.4x11 */ { -1     ,  18340 ,  11424 },
      /* 0.5x11 */ {   9861 , -1     , -1     },
      /* 0.6x11 */ { -1     , -1     ,   8031 },
      /* 0.7x11 */ { -1     ,  11333 , -1     },
      /* 0.8x11 */ {   6655 , -1     , -1     },
      /* 0.9x11 */ { -1     ,   8935 ,   5573 },
      /* 1.0x11 */ {   5453 , -1     , -1     },
      /* 1.2x11 */ { -1     ,   6505 ,   4287 },
      /* 1.3x11 */ {   4112 , -1     , -1     },
      /* 1.5x11 */ { -1     ,   5040 ,   3416 },
      /* 1.6x11 */ {   3251 , -1     , -1     },
      /* 5.0x11 */ {   1040 ,   1512 ,   1029 },
      /* MCW 200831 (PIPE-9214) - Add K-blocked slits */
      /* 0.6JHx11 */ { -1   , -1     ,   8014 },
      /* 0.9JHx11 */ { -1   , -1     ,   5567 }
    };

  int usedarm;
  const char* used_keyword;
  switch (xsh_instrument_get_arm(instrument)) {
    case XSH_ARM_UVB: usedarm = 0;  used_keyword = XSH_SLIT_UVB; break;
    case XSH_ARM_VIS: usedarm = 1;  used_keyword = XSH_SLIT_VIS; break;
    case XSH_ARM_NIR: usedarm = 2;  used_keyword = XSH_SLIT_NIR; break;
    default:          usedarm = -1; used_keyword = NULL;         break;
  }

  /* Figure out the date epoch of the raw data. We check if the date range
   * overlaps the epoch threshold. If the data does then we dont try figure out
   * which epoch to choose LAMRMS for. */
  double date_threshold = 55927.0; /* Julian Date for 1/1/2012 */
  int softepoch = -1; /* epoch of the software used. 0 = before 1/1/2012 and
                                                     1 = after 1/1/2012. */
  prestate = cpl_errorstate_get();
  double first_mjdobs = xsh_find_first_mjd_obs(usedframes);
  if (cpl_errorstate_is_equal(prestate)) {
    if (! (first_mjdobs < date_threshold && date_threshold < mjdend)) {
      if (first_mjdobs < date_threshold) {
        softepoch = 0;
      } else {
        softepoch = 1;
      }
    }
  } else {
    error = cpl_error_get_code();
  }

  /* Identify the lookup entry for the slit that was used. */
  int usedslit = -1;
  const char* lengthstr = cpl_propertylist_get_string(sourcekeys, used_keyword);
  if (lengthstr != NULL) {
    if (strstr(lengthstr, "0.4x11") == lengthstr) {
      usedslit = 0;
    } else if (strstr(lengthstr, "0.5x11") == lengthstr) {
      usedslit = 1;
    } else if (strstr(lengthstr, "0.6x11") == lengthstr) {
      usedslit = 2;
    } else if (strstr(lengthstr, "0.7x11") == lengthstr) {
      usedslit = 3;
    } else if (strstr(lengthstr, "0.8x11") == lengthstr) {
      usedslit = 4;
    } else if (strstr(lengthstr, "0.9x11") == lengthstr) {
      usedslit = 5;
    } else if (strstr(lengthstr, "1.0x11") == lengthstr) {
      usedslit = 6;
    } else if (strstr(lengthstr, "1.2x11") == lengthstr) {
      usedslit = 7;
    } else if (strstr(lengthstr, "1.3x11") == lengthstr) {
      usedslit = 8;
    } else if (strstr(lengthstr, "1.5x11") == lengthstr) {
      usedslit = 9;
    } else if (strstr(lengthstr, "1.6x11") == lengthstr) {
      usedslit = 10;
    } else if (strstr(lengthstr, "5.0x11") == lengthstr) {
      usedslit = 11;
    } else if (strstr(lengthstr, "0.6JHx11") == lengthstr) {
      usedslit = 12;
    } else if (strstr(lengthstr, "0.9JHx11") == lengthstr) {
      usedslit = 13;
    }
  } else {
    error = cpl_error_get_code();
  }

  /* Copy the LAMNLIN, LAMRMS and SPEC_RES keywords from the source keywords
   * if they already exist, otherwise set them from the lookup table. */
  if (cpl_propertylist_has(sourcekeys, XSH_SDP_KEYWORD_LAMNLIN)) {
    prestate = cpl_errorstate_get();
    int val = cpl_propertylist_get_int(sourcekeys, XSH_SDP_KEYWORD_LAMNLIN);
    if (cpl_errorstate_is_equal(prestate)) {
      lamnlin = val;
    } else {
      error = cpl_error_get_code();
    }
  } else {
    if (usedarm != -1) {
      lamnlin = lamnlin_lut[usedarm];
    }
  }
  if (cpl_propertylist_has(sourcekeys, XSH_SDP_KEYWORD_LAMRMS)) {
    prestate = cpl_errorstate_get();
    double val = cpl_propertylist_get_double(sourcekeys,
                                             XSH_SDP_KEYWORD_LAMRMS);
    if (cpl_errorstate_is_equal(prestate)) {
      lamrms = val;
    } else {
      error = cpl_error_get_code();
    }
  } else {
    if (usedarm != -1 && softepoch != -1) {
      lamrms = lamrms_lut[usedarm][softepoch];
    }
  }
  if (cpl_propertylist_has(sourcekeys, XSH_SDP_KEYWORD_SPEC_RES)) {
    prestate = cpl_errorstate_get();
    double val = cpl_propertylist_get_double(sourcekeys,
                                             XSH_SDP_KEYWORD_SPEC_RES);
    if (cpl_errorstate_is_equal(prestate)) {
      specres = val;
    } else {
      error = cpl_error_get_code();
    }
  } else {
    if (usedslit != -1 && usedarm != -1) {
      specres = specres_lut[usedslit][usedarm];
    }
  }

  /* Set the LAMNLIN, LAMRMS and SPEC_RES keywords if they were actually
   * calculated. */
  if (lamnlin != -1) {
    error |= irplib_sdp_spectrum_set_lamnlin(sdp_spectrum, lamnlin);
  }
  if (lamrms != -1) {
    error |= irplib_sdp_spectrum_set_lamrms(sdp_spectrum, lamrms);
  }
  if (specres != -1) {
    error |= irplib_sdp_spectrum_set_specres(sdp_spectrum, specres);
  }

  /* Calculate the SPEC_ERR keyword if it is not already in the source keywords.
   * Otherwise we just copy it to the primary header. If we could not calculate
   * the keyword then do not set it. */
  if (cpl_propertylist_has(sourcekeys, XSH_SDP_KEYWORD_SPEC_ERR)) {
    prestate = cpl_errorstate_get();
    double val = cpl_propertylist_get_double(sourcekeys,
                                             XSH_SDP_KEYWORD_SPEC_ERR);
    if (cpl_errorstate_is_equal(prestate)) {
      error |= irplib_sdp_spectrum_set_specerr(sdp_spectrum, val);
    } else {
      error = cpl_error_get_code();
    }
  } else if (lamnlin > 0) {
    double specerr = -1;
    if (cpl_propertylist_has(sourcekeys, XSH_CRDER1)) {
      prestate = cpl_errorstate_get();
      double crder1 = cpl_propertylist_get_double(sourcekeys, XSH_CRDER1);
      if (cpl_errorstate_is_equal(prestate) && crder1 != 0) {
        specerr = crder1 / sqrt(lamnlin);
      } else {
        error = cpl_error_get_code();
      }
    }
    if (specerr == -1 && lamrms != -1) {
      specerr = lamrms / sqrt(lamnlin);
    }
    if (specerr != -1) {
      error |= irplib_sdp_spectrum_set_specerr(sdp_spectrum, specerr);
    }
  }

  /* Calculate the SPEC_SYE keyword if it is not already in the source keywords.
   * Otherwise we just copy it to the primary header. If we could not calculate
   * the keyword then do not set it. */
  if (cpl_propertylist_has(sourcekeys, XSH_SDP_KEYWORD_SPEC_SYE)) {
    error |= irplib_sdp_spectrum_copy_specsye(sdp_spectrum, sourcekeys,
                                              XSH_SDP_KEYWORD_SPEC_SYE);
  } else if (lamnlin > 0) {
    double specsye = NAN;
    if (cpl_propertylist_has(sourcekeys, XSH_CSYER1)) {
      prestate = cpl_errorstate_get();
      double csyer1 = cpl_propertylist_get_double(sourcekeys, XSH_CSYER1);
      if (cpl_errorstate_is_equal(prestate)) {
        specsye = csyer1 / sqrt(lamnlin);
      } else {
        error = cpl_error_get_code();
      }
    }
    if (! isnan(specsye)) {
      error |= irplib_sdp_spectrum_set_specsye(sdp_spectrum, specsye);
    }
  }

  prestate = cpl_errorstate_get();
  double gainvalue = NAN;
  double detron = NAN;
  double dit = NAN;
  switch (xsh_instrument_get_arm(instrument)) {
    case XSH_ARM_NIR:
      /* Hardcode the gain for NIR. */
      gainvalue = 1./2.12;
      /* Hardcode the RON for NIR. */
      dit = xsh_pfits_get_dit(sourcekeys);
      detron = xsh_compute_ron_nir(dit);
      if (! cpl_errorstate_is_equal(prestate)) {
        error = cpl_error_get_code();
      }
      break;
    default:
      /* Update the GAIN from ESO.DET.OUT1.CONAD */
      gainvalue = cpl_propertylist_get_double(sourcekeys, XSH_CONAD);
      if (! cpl_errorstate_is_equal(prestate)) {
        error = cpl_error_set_message(cpl_func, cpl_error_get_code(),
                      "Could not assign '%s' since the '%s' keyword was"
                      " not found.", XSH_SDP_KEYWORD_GAIN, XSH_CONAD);
      }
      /* Update DETRON and EFFRON from ESO.DET.OUT1.RON */
      detron = cpl_propertylist_get_double(sourcekeys, XSH_RON);
      if (! cpl_errorstate_is_equal(prestate)) {
        error = cpl_error_set_message(cpl_func, cpl_error_get_code(),
                      "Could not assign '%s' and '%s' since the '%s' keyword"
                      " was not found.", XSH_SDP_KEYWORD_DETRON,
                      XSH_SDP_KEYWORD_EFFRON, XSH_RON);
      }
      break;
  }
  if (! isnan(gainvalue)) {
    error |= irplib_sdp_spectrum_set_gain(sdp_spectrum, gainvalue);
  }
  if (! isnan(detron)) {
    error |= irplib_sdp_spectrum_set_detron(sdp_spectrum, detron);
    error |= irplib_sdp_spectrum_set_effron(sdp_spectrum, detron);
  }

  /* Set the TOT_FLUX keyword to true if the ESO.INS.OPTIi.NAME keyword
   * contains "5.0x<Length>" where <Length> can be any number.
   * Also setup the APERTURE keyword from the ESO.INS.OPTIi.NAME keyword. */
  if (lengthstr != NULL) {
    double aperture;
    cpl_boolean totflux = CPL_FALSE;
    if (strstr(lengthstr, "5.0x") == lengthstr) totflux = CPL_TRUE;
    error |= irplib_sdp_spectrum_set_totflux(sdp_spectrum, totflux);
    if (xsh_aperture_string_to_double(lengthstr, &aperture)) {
      error |= irplib_sdp_spectrum_set_aperture(sdp_spectrum, aperture);
    } else {
      error = cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
                    "The '%s' keyword contains an invalid value '%s'."
                    " An example of the expected format is '0.9x11'.",
                    used_keyword, lengthstr);
    }
  } else {
    error = cpl_error_set_message(cpl_func, cpl_error_get_code(),
                  "Could not assign '%s' or '%s' since one could not read the"
                  " '%s' keyword.", XSH_SDP_KEYWORD_TOT_FLUX,
                  XSH_SDP_KEYWORD_APERTURE, used_keyword);
  }

  /* Calculate the TELAPSE and TMID keywords from MJD-OBS and MJD-END. */
  if (! isnan(mjdobs) && ! isnan(mjdend)) {
      int nframes=xsh_get_nraws(usedframes);
      if(nframes==1) {
          /* this is a special case for which to prevent rounding errors due to
           * the very small difference MJDEND - MJDSTART, and using the fact that
           * MJDEND - MJDSTART= EXPTIME (or DIT*NDIT) we compute TELAPSE as
           * TELAPSE=EXPTIME (UVB,VIS) or TELAPSE=DIT*NDIT
           */
          double telapse=0;
          if( xsh_instrument_get_arm(instrument) == XSH_ARM_NIR ) {
              double dit = cpl_propertylist_get_double(sourcekeys, XSH_DET_DIT);
              int ndit = cpl_propertylist_get_int(sourcekeys, XSH_DET_NDIT);
              int nditskip = cpl_propertylist_get_int(sourcekeys,XSH_DET_NDITSKIP);
              if (nditskip == 0) {
                  telapse = dit * ndit;
              } else {
                  xsh_msg_warning("Found '%s' with a non zero value. Do not know how"
                                  " to handle this case so will over estimate '%s'.",
                                  XSH_DET_NDITSKIP, XSH_MJDEND);
              }
          } else {
              telapse = cpl_propertylist_get_double(sourcekeys, XSH_EXPTIME);
          }
          error |= irplib_sdp_spectrum_set_telapse(sdp_spectrum,telapse);
      } else {
          error |= irplib_sdp_spectrum_set_telapse(sdp_spectrum,
                          (mjdend - mjdobs) * 86400.);
      }
    error |= irplib_sdp_spectrum_set_tmid(sdp_spectrum,
                                          (mjdend + mjdobs) * 0.5);
  } else {
    error = cpl_error_set_message(cpl_func, cpl_error_get_code(),
                  "Could not assign '%s' nor '%s' since one could not read"
                  " either the '%s' or '%s' keyword.", XSH_SDP_KEYWORD_TELAPSE,
                  XSH_SDP_KEYWORD_TMID, XSH_MJDOBS, XSH_MJDEND);
  }

  /* Setup the TDMIN and TDMAX keywords from wavelength minimum and maximum. */
  error |= irplib_sdp_spectrum_set_tdmin(sdp_spectrum, wavemin);
  error |= irplib_sdp_spectrum_set_tdmax(sdp_spectrum, wavemax);

  /* Setup the SPEC_VAL and SPEC_BW keywords from the spectrum wavelength
   * information. */
  error |= irplib_sdp_spectrum_set_specval(sdp_spectrum,
                                           (wavemax + wavemin)*0.5);
  error |= irplib_sdp_spectrum_set_specbw(sdp_spectrum, wavemax - wavemin);

  error |= irplib_sdp_spectrum_set_nelem(sdp_spectrum, nelem);
  error |= irplib_sdp_spectrum_set_extname(sdp_spectrum,
                                           XSH_SDP_KEYWORD_EXTNAME_VALUE);
  error |= irplib_sdp_spectrum_set_inherit(sdp_spectrum,
                                           XSH_SDP_KEYWORD_INHERIT_VALUE);

  /* Check the error state and stop at this point (cleaning up memory) if there
   * have been any errors. */
  if (error) {
    return cpl_error_set_message(cpl_func, cpl_error_get_code(),
                  "Failed to initialise keyword list for the SDP spectrum.");
  }

  /* Figure out the units to use for FLUX and ERR table columns. */
  const char* column_flux_unit = xsh_get_column_unit(spectrum->flux_header,
                                                     "flux");
  const char* column_errs_unit = xsh_get_column_unit(spectrum->errs_header,
                                                     "flux error");
  if (column_flux_unit == NULL || column_errs_unit == NULL) {
    return cpl_error_get_code();
  }

  /* The following constructs a list of columns that we should setup in the
   * spectrum table. */
  struct _xsh_column_info columns[] = {
      {XSH_SDP_COLUMN_WAVE, CPL_TYPE_DOUBLE, XSH_SDP_COLUMN_WAVE_UNIT,
       XSH_SDP_COLUMN_WAVE_FORMAT, XSH_SDP_COLUMN_WAVE_TYPE,
       XSH_SDP_COLUMN_WAVE_UCD},
      {XSH_SDP_COLUMN_FLUX, CPL_TYPE_DOUBLE, column_flux_unit,
       XSH_SDP_COLUMN_FLUX_FORMAT, XSH_SDP_COLUMN_FLUX_TYPE,
       XSH_SDP_COLUMN_FLUX_UCD},
      {XSH_SDP_COLUMN_ERR, CPL_TYPE_DOUBLE, column_errs_unit,
       XSH_SDP_COLUMN_ERR_FORMAT, XSH_SDP_COLUMN_ERR_TYPE,
       XSH_SDP_COLUMN_ERR_UCD},
      {XSH_SDP_COLUMN_QUAL, CPL_TYPE_INT, XSH_SDP_COLUMN_QUAL_UNIT,
       XSH_SDP_COLUMN_QUAL_FORMAT, XSH_SDP_COLUMN_QUAL_TYPE,
       XSH_SDP_COLUMN_QUAL_UCD},
      {XSH_SDP_COLUMN_SNR, CPL_TYPE_DOUBLE, XSH_SDP_COLUMN_SNR_UNIT,
       XSH_SDP_COLUMN_SNR_FORMAT, XSH_SDP_COLUMN_SNR_TYPE,
       XSH_SDP_COLUMN_SNR_UCD},
      {NULL, CPL_TYPE_INVALID, NULL, NULL, NULL, NULL}
    };
  struct _xsh_column_info* column;

  /* Add the spectrum columns to the table. */
  for (column = columns; column->name != NULL; ++column) {
    error = irplib_sdp_spectrum_add_column(sdp_spectrum, column->name,
                                    column->type, column->unit, column->format,
                                    column->tutyp, column->tucd, NULL);
    if (error) {
      return cpl_error_set_message(cpl_func, cpl_error_get_code(),
                              "Failed to setup the '%s' column.", column->name);
    }
  }
  error = irplib_sdp_spectrum_replace_column_comment(sdp_spectrum, XSH_SDP_COLUMN_WAVE,
		  "TUCD", "Air wavelength");

  /* Add the columns for the uncalibrated data if we got any. */
  if (uncal_spectrum != NULL) {

    /* Figure out the units to use for FLUX_REDUCED and ERR_REDUCED columns. */
    column_flux_unit = xsh_get_column_unit(uncal_spectrum->flux_header,
                                           "uncalibrated flux");
    column_errs_unit = xsh_get_column_unit(uncal_spectrum->errs_header,
                                           "uncalibrated flux error");
    if (column_flux_unit == NULL || column_errs_unit == NULL) {
      return cpl_error_get_code();
    }

    /* The following constructs a list of columns for the uncalibrated data that
     * we should setup in the spectrum table. */
    struct _xsh_column_info uncalib_columns[] = {
        {XSH_SDP_COLUMN_FLUX_REDUCED, CPL_TYPE_DOUBLE, column_flux_unit,
         XSH_SDP_COLUMN_FLUX_REDUCED_FORMAT, XSH_SDP_COLUMN_FLUX_REDUCED_TYPE,
         XSH_SDP_COLUMN_FLUX_REDUCED_UCD},
        {XSH_SDP_COLUMN_ERR_REDUCED, CPL_TYPE_DOUBLE, column_errs_unit,
         XSH_SDP_COLUMN_ERR_REDUCED_FORMAT, XSH_SDP_COLUMN_ERR_REDUCED_TYPE,
         XSH_SDP_COLUMN_ERR_REDUCED_UCD},
        {NULL, CPL_TYPE_INVALID, NULL, NULL, NULL, NULL}
      };

    /* Add the columns for the uncalibrated data to the table. */
    for (column = uncalib_columns; column->name != NULL; ++column) {
      error = irplib_sdp_spectrum_add_column(sdp_spectrum, column->name,
                                    column->type, column->unit, column->format,
                                    column->tutyp, column->tucd, NULL);


      if (error) {
        return cpl_error_set_message(cpl_func, cpl_error_get_code(),
                              "Failed to setup the '%s' column.", column->name);
      }
    }
  }

  /* Finally copy the table data. */
  double* specflux = xsh_spectrum_get_flux(spectrum);
  double* specerrs = xsh_spectrum_get_errs(spectrum);
  int* specqual = xsh_spectrum_get_qual(spectrum);
  if (specflux != NULL && specerrs != NULL && specqual != NULL) {
    /* Prepare the wavelength array and set it. */
    double* data = cpl_malloc(nelem * sizeof(double));
    cpl_array* array = cpl_array_wrap_double(data, nelem);
    if (data != NULL) {
      cpl_size i;
      for (i = 0; i < nelem; ++i) {
        data[i] = wavemin + i * wavestep;
      }
    } else {
      error |= cpl_error_get_code();
    }
    error |= irplib_sdp_spectrum_set_column_data(sdp_spectrum,
                                                 XSH_SDP_COLUMN_WAVE, array);
    cpl_array_unwrap(array);
    cpl_free(data);

    /* Prepare the other data arrays and assign them. */
    array = cpl_array_wrap_double(specflux, nelem);
    error |= irplib_sdp_spectrum_set_column_data(sdp_spectrum,
                                                 XSH_SDP_COLUMN_FLUX, array);
    cpl_array_unwrap(array);
    array = cpl_array_wrap_double(specerrs, nelem);
    error |= irplib_sdp_spectrum_set_column_data(sdp_spectrum,
                                                 XSH_SDP_COLUMN_ERR, array);
    cpl_array_unwrap(array);
    array = cpl_array_wrap_int(specqual, nelem);
    error |= irplib_sdp_spectrum_set_column_data(sdp_spectrum,
                                                 XSH_SDP_COLUMN_QUAL, array);
    cpl_array_unwrap(array);

    /* Prepare the signal to noise column data. */
    data = cpl_malloc(nelem * sizeof(double));
    array = cpl_array_wrap_double(data, nelem);
    if (data != NULL) {
      cpl_size i;
      for (i = 0; i < nelem; ++i) {
        double denom = fabs(specerrs[i]);
        data[i] = denom != 0 ? fabs(specflux[i]) / denom : 0;
      }
    } else {
      error |= cpl_error_get_code();
    }
    error |= irplib_sdp_spectrum_set_column_data(sdp_spectrum,
                                                 XSH_SDP_COLUMN_SNR, array);
    cpl_array_unwrap(array);
    cpl_free(data);

  } else {
    error = cpl_error_get_code();
  }

  /* Copy the uncalibrated data if available. */
  if (uncal_spectrum != NULL) {
    specflux = xsh_spectrum_get_flux(uncal_spectrum);
    specerrs = xsh_spectrum_get_errs(uncal_spectrum);
    if (specflux != NULL && specerrs != NULL) {
      cpl_array* array = cpl_array_wrap_double(specflux, nelem);
      error |= irplib_sdp_spectrum_set_column_data(sdp_spectrum,
                                        XSH_SDP_COLUMN_FLUX_REDUCED, array);
      cpl_array_unwrap(array);
      array = cpl_array_wrap_double(specerrs, nelem);
      error |= irplib_sdp_spectrum_set_column_data(sdp_spectrum,
                                        XSH_SDP_COLUMN_ERR_REDUCED, array);
      cpl_array_unwrap(array);
    } else {
      error = cpl_error_get_code();
    }
  }

  if (error) {
    return cpl_error_set_message(cpl_func, cpl_error_get_code(),
                                 "Failed to copy spectrum data to table.");
  }
  return CPL_ERROR_NONE;
}

/**
 * @brief Creates a 1D spectrum product in the Science Data Product format.
 *
 * This function converts a 1D spectrum written to a fits files in the X-Shooter
 * native format to the Science Data Product (SDP) format. The spectrum data is
 * loaded from the @a flux_cal_frame and @c uncal_frame, converted to the SDP
 * format and written to a new file with the same name as the original product,
 * but with the "SDP_" prefix added. Either the flux calibrated frame or the
 * uncalibrated frame must be provided or both.
 * The caller should check the value of @c cpl_error_get_code() to see if an
 * error occurred during the conversion.
 *
 * @param flux_cal_frame  The flux calibrated 1D spectrum frame that we convert
 *      to SDP format. Can be NULL if none is available, but only if the
 *      @c uncal_frame is not NULL.
 * @param uncal_frame  The uncalibrated 1D spectrum that we also use in the
 *      conversion. Can be NULL if none is available, but only if the
 *      @c flux_cal_frame is not NULL.
 * @param frameset  The list of all frames to which we add the newly generated
 *      frame.
 * @param usedframes  A frame set containing a list of all frames used to
 *      product the spectrum in the flux_cal_frame.
 * @param parameters  The parameters passed to the recipe by esorex.
 * @param recipe_id  The ID string of the recipe.
 * @param instrument  The X-Shooter instrument structure containing
 *      configuration information about the instrument.
 */
void xsh_add_sdp_product_spectrum(const cpl_frame *flux_cal_frame,
                                  const cpl_frame *uncal_frame,
                                  cpl_frameset *frameset,
                                  const cpl_frameset *usedframes,
                                  const cpl_parameterlist *parameters,
                                  const char *recipe_id,
                                  xsh_instrument* instrument)
{
  cpl_table* table = cpl_table_new(0);
  cpl_propertylist* tablekeys = cpl_propertylist_new();
  cpl_propertylist* primarykeys = cpl_propertylist_new();
  cpl_propertylist* sourcekeys = NULL;
  char* output_procatg = NULL;
  char* filename = NULL;
  xsh_spectrum* spectrum = NULL;
  xsh_spectrum* uncal_spectrum = NULL;
  irplib_sdp_spectrum* sdp_spectrum = irplib_sdp_spectrum_new();
  
  XSH_ASSURE_NOT_NULL(frameset);
  XSH_ASSURE_NOT_NULL(usedframes);
  XSH_ASSURE_NOT_NULL(parameters);
  XSH_ASSURE_NOT_NULL(recipe_id);
  XSH_ASSURE_NOT_NULL(instrument);
  
  if (flux_cal_frame == NULL && uncal_frame == NULL) {
    cpl_error_set_message(cpl_func, CPL_ERROR_NULL_INPUT,
                          "Cannot have both the flux calibrated and"
                          " uncalibrated frames set to NULL.");
    xsh_error_msg("%s", cpl_error_get_message());
    goto cleanup;
  }

  const cpl_frame* product_frame = flux_cal_frame != NULL ? flux_cal_frame
                                                          : uncal_frame;
  const char* fname = cpl_frame_get_filename(product_frame);
  filename = cpl_sprintf("SDP_%s", fname);
  
  check(sourcekeys = cpl_propertylist_load(fname, 0));
  
  /* Copy all existing QC keywords from the product we are converting. */
  check(cpl_propertylist_copy_property_regexp(primarykeys, sourcekeys,
                                              "^ESO QC ", CPL_FALSE));
  
  /* Need to copy the ESO.QC.FLUX.SN keyword from uncal_frame. */
  if (uncal_frame != NULL) {
    if (! cpl_propertylist_has(sourcekeys, XSH_QC_FLUX_SN)) {
      cpl_propertylist* tmpkeys;
      tmpkeys = cpl_propertylist_load(cpl_frame_get_filename(uncal_frame), 0);
      assure(tmpkeys != NULL, cpl_error_get_code(),
             "%s", cpl_error_get_message());
      if (cpl_propertylist_has(tmpkeys, XSH_QC_FLUX_SN)) {
        cpl_propertylist_copy_property(sourcekeys, tmpkeys, XSH_QC_FLUX_SN);
      }
      /* Again copy all QC keywords from the non-flux calibrated product. */
      cpl_propertylist_copy_property_regexp(primarykeys, tmpkeys,
                                            "^ESO QC ", CPL_FALSE);
      cpl_propertylist_delete(tmpkeys);
      assure(cpl_error_get_code() == CPL_ERROR_NONE, cpl_error_get_code(),
             "%s", cpl_error_get_message());
    }
  }

  /* Force the INSTRUME keyword to be "XSHOOTER" since old data can have a
   * different value for this keyword. */
  check(cpl_propertylist_update_string(primarykeys, XSH_INSTRUME,
                                       XSH_INSTRUME_VALUE));
  const char* inst_comment = cpl_propertylist_get_comment(primarykeys,
                                                          XSH_INSTRUME);
  if (inst_comment == NULL || strcmp(inst_comment, "") == 0) {
    check(cpl_propertylist_set_comment(primarykeys, XSH_INSTRUME,
                                       "Instrument used."));
  }

  /* Set the ESO.PRO.CATG keyword based on the instrument arm. */
  const char* armtag;
  switch (xsh_instrument_get_arm(instrument)) {
    case XSH_ARM_UVB:
    case XSH_ARM_VIS:
    case XSH_ARM_NIR:
      armtag = xsh_arm_tostring(xsh_instrument_get_arm(instrument));
      break;
    default:
      armtag = NULL;
  }
  // PIPE-9157 - search the usedframes for DRP TYPES, and choose one accordingly
  const char* producttype ;
  const char* dprtype ;
  cpl_frameset_iterator* iter_new = cpl_frameset_iterator_new(usedframes);
  const cpl_frame* testframe = cpl_frameset_iterator_get_const(iter_new);
  cpl_propertylist* proptest;
  while (testframe != NULL) {
      proptest = cpl_propertylist_load(cpl_frame_get_filename(testframe), 0);
      if (cpl_propertylist_has(proptest, XSH_DPR_TYPE)) {
          dprtype = cpl_propertylist_get_string(proptest, XSH_DPR_TYPE);
          if (strcmp(dprtype, "OBJECT") == 0) {
//              xsh_msg_warning("Have dprtype %s, setting IDP product to SCI", dprtype);
              producttype = "SCI" ;
              testframe = NULL ;
              break ;
          } else if (strcmp(dprtype, "STD,TELLURIC") == 0) {
//              xsh_msg_warning("Have dprtype %s, setting IDP product to TELL (unless OBJECT found later)", dprtype);
              producttype = "TELL" ;
          }
      }
      cpl_frameset_iterator_advance(iter_new, 1);
      testframe = cpl_frameset_iterator_get_const(iter_new);
      cpl_propertylist_delete(proptest);
  }
  cpl_frameset_iterator_delete(iter_new);

  if (producttype == NULL) {
      cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                            "Could not identify the correct product type value to be used"
                            " for '%s'.", CPL_DFS_PRO_CATG);
      goto cleanup;
  }
  if (armtag != NULL) {
    output_procatg = cpl_sprintf("%s_SLIT_FLUX_IDP_%s", producttype, armtag);
    check(cpl_propertylist_update_string(primarykeys, CPL_DFS_PRO_CATG,
                                         output_procatg));
  } else {
    cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
                          "Could not identify the correct ARM value to be used"
                          " for '%s'.", CPL_DFS_PRO_CATG);
    xsh_error_msg("%s", cpl_error_get_message());
    goto cleanup;
  }

  /* Calculate MJD-END by finding the largest MJD-OBS value from the raw input
   * files. */
  double mjdend;
  check(mjdend = xsh_calculate_mjd_end(product_frame, usedframes,
                                       xsh_instrument_get_arm(instrument)));
  check(cpl_propertylist_update_double(sourcekeys, XSH_MJDEND, mjdend));

  /* Load the raw spectra and fill the SDP spectrum object. */
  if (flux_cal_frame != NULL) {
    check(spectrum = xsh_spectrum_load((cpl_frame*)flux_cal_frame));
  }
  if (uncal_frame != NULL) {
    check(uncal_spectrum = xsh_spectrum_load((cpl_frame*)uncal_frame));
  }
  cpl_errorstate prestate = cpl_errorstate_get();
  xsh_sdp_spectrum_create(sdp_spectrum, usedframes, sourcekeys, instrument,
                          spectrum, uncal_spectrum);
  if (! cpl_errorstate_is_equal(prestate)) {
    xsh_error_msg("%s", cpl_error_get_message());
    goto cleanup;
  }

  check(xsh_fill_provenance_keywords(sdp_spectrum, usedframes));

  /* Create dummy association keywords. */
  int assoc_count;
  check(assoc_count = xsh_parameters_get_int(parameters, recipe_id,
                                             "dummy-association-keys"));
  int assoi;
  for (assoi = 1; assoi <= assoc_count; ++assoi) {
    check(irplib_sdp_spectrum_set_asson(sdp_spectrum, assoi, " "));
    check(irplib_sdp_spectrum_set_assoc(sdp_spectrum, assoi, " "));
    check(irplib_sdp_spectrum_set_assom(sdp_spectrum, assoi, " "));
  }

  cpl_msg_info(cpl_func, "Writing SDP spectrum as FITS table product(%s): %s",
               output_procatg, filename);
//  printf("Press ENTER to continue\n");
//  getchar();

  /* Save the filled SDP spectrum to file, but strip the checksum keywords. */
  const char* remregexp = "^(CHECKSUM|DATASUM)$";
  check(irplib_dfs_save_spectrum(
                  frameset, NULL, parameters, usedframes, product_frame,
                  sdp_spectrum, recipe_id, primarykeys, NULL, remregexp,
                  instrument->pipeline_id, instrument->dictionary, filename));

  /* Only update the checksums if the CPL version is new enough so that exorex
   * will not break the CHECKSUM of the primary header when it updates the
   * DATAMD5 in the cpl_dfs_update_product_header() function call. */
  if (cpl_version_get_binary_version() >= CPL_VERSION(6, 4, 2)) {
    check(irplib_fits_update_checksums(filename));
  }

  xsh_add_product_file(filename);

cleanup:
  irplib_sdp_spectrum_delete(sdp_spectrum);
  xsh_spectrum_free(&uncal_spectrum);
  xsh_spectrum_free(&spectrum);
  cpl_free(filename);
  cpl_free(output_procatg);
  cpl_propertylist_delete(sourcekeys);
  cpl_propertylist_delete(primarykeys);
  cpl_propertylist_delete(tablekeys);
  cpl_table_delete(table);
}

/**@}*/
